gitk-git/gitk

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 # Copyright © 2005-2014 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 vinlinediff
 160     global worddiff git_version
 161
 162     set vdatemode($n) 0
 163     set vmergeonly($n) 0
 164     set vinlinediff($n) 0
 165     set glflags {}
 166     set diffargs {}
 167     set nextisval 0
 168     set revargs {}
 169     set origargs $arglist
 170     set allknown 1
 171     set filtered 0
 172     set i -1
 173     foreach arg $arglist {
 174         incr i
 175         if {$nextisval} {
 176             lappend glflags $arg
 177             set nextisval 0
 178             continue
 179         }
 180         switch -glob -- $arg {
 181             "-d" -
 182             "--date-order" {
 183                 set vdatemode($n) 1
 184                 # remove from origargs in case we hit an unknown option
 185                 set origargs [lreplace $origargs $i $i]
 186                 incr i -1
 187             }
 188             "-[puabwcrRBMC]" -
 189             "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
 190             "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
 191             "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
 192             "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
 193             "--ignore-space-change" - "-U*" - "--unified=*" {
 194                 # These request or affect diff output, which we don't want.
 195                 # Some could be used to set our defaults for diff display.
 196                 lappend diffargs $arg
 197             }
 198             "--raw" - "--patch-with-raw" - "--patch-with-stat" -
 199             "--name-only" - "--name-status" - "--color" -
 200             "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
 201             "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
 202             "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
 203             "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
 204             "--objects" - "--objects-edge" - "--reverse" {
 205                 # These cause our parsing of git log's output to fail, or else
 206                 # they're options we want to set ourselves, so ignore them.
 207             }
 208             "--color-words*" - "--word-diff=color" {
 209                 # These trigger a word diff in the console interface,
 210                 # so help the user by enabling our own support
 211                 if {[package vcompare $git_version "1.7.2"] >= 0} {
 212                     set worddiff [mc "Color words"]
 213                 }
 214             }
 215             "--word-diff*" {
 216                 if {[package vcompare $git_version "1.7.2"] >= 0} {
 217                     set worddiff [mc "Markup words"]
 218                 }
 219             }
 220             "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
 221             "--check" - "--exit-code" - "--quiet" - "--topo-order" -
 222             "--full-history" - "--dense" - "--sparse" -
 223             "--follow" - "--left-right" - "--encoding=*" {
 224                 # These are harmless, and some are even useful
 225                 lappend glflags $arg
 226             }
 227             "--diff-filter=*" - "--no-merges" - "--unpacked" -
 228             "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
 229             "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
 230             "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
 231             "--remove-empty" - "--first-parent" - "--cherry-pick" -
 232             "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
 233             "--simplify-by-decoration" {
 234                 # These mean that we get a subset of the commits
 235                 set filtered 1
 236                 lappend glflags $arg
 237             }
 238             "-L*" {
 239                 # Line-log with 'stuck' argument (unstuck form is
 240                 # not supported)
 241                 set filtered 1
 242                 set vinlinediff($n) 1
 243                 set allknown 0
 244                 lappend glflags $arg
 245             }
 246             "-n" {
 247                 # This appears to be the only one that has a value as a
 248                 # separate word following it
 249                 set filtered 1
 250                 set nextisval 1
 251                 lappend glflags $arg
 252             }
 253             "--not" - "--all" {
 254                 lappend revargs $arg
 255             }
 256             "--merge" {
 257                 set vmergeonly($n) 1
 258                 # git rev-parse doesn't understand --merge
 259                 lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
 260             }
 261             "--no-replace-objects" {
 262                 set env(GIT_NO_REPLACE_OBJECTS) "1"
 263             }
 264             "-*" {
 265                 # Other flag arguments including -<n>
 266                 if {[string is digit -strict [string range $arg 1 end]]} {
 267                     set filtered 1
 268                 } else {
 269                     # a flag argument that we don't recognize;
 270                     # that means we can't optimize
 271                     set allknown 0
 272                 }
 273                 lappend glflags $arg
 274             }
 275             default {
 276                 # Non-flag arguments specify commits or ranges of commits
 277                 if {[string match "*...*" $arg]} {
 278                     lappend revargs --gitk-symmetric-diff-marker
 279                 }
 280                 lappend revargs $arg
 281             }
 282         }
 283     }
 284     set vdflags($n) $diffargs
 285     set vflags($n) $glflags
 286     set vrevs($n) $revargs
 287     set vfiltered($n) $filtered
 288     set vorigargs($n) $origargs
 289     return $allknown
 290 }
 291
 292 proc parseviewrevs {view revs} {
 293     global vposids vnegids
 294
 295     if {$revs eq {}} {
 296         set revs HEAD
 297     } elseif {[lsearch -exact $revs --all] >= 0} {
 298         lappend revs HEAD
 299     }
 300     if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
 301         # we get stdout followed by stderr in $err
 302         # for an unknown rev, git rev-parse echoes it and then errors out
 303         set errlines [split $err "\n"]
 304         set badrev {}
 305         for {set l 0} {$l < [llength $errlines]} {incr l} {
 306             set line [lindex $errlines $l]
 307             if {!([string length $line] == 40 && [string is xdigit $line])} {
 308                 if {[string match "fatal:*" $line]} {
 309                     if {[string match "fatal: ambiguous argument*" $line]
 310                         && $badrev ne {}} {
 311                         if {[llength $badrev] == 1} {
 312                             set err "unknown revision $badrev"
 313                         } else {
 314                             set err "unknown revisions: [join $badrev ", "]"
 315                         }
 316                     } else {
 317                         set err [join [lrange $errlines $l end] "\n"]
 318                     }
 319                     break
 320                 }
 321                 lappend badrev $line
 322             }
 323         }
 324         error_popup "[mc "Error parsing revisions:"] $err"
 325         return {}
 326     }
 327     set ret {}
 328     set pos {}
 329     set neg {}
 330     set sdm 0
 331     foreach id [split $ids "\n"] {
 332         if {$id eq "--gitk-symmetric-diff-marker"} {
 333             set sdm 4
 334         } elseif {[string match "^*" $id]} {
 335             if {$sdm != 1} {
 336                 lappend ret $id
 337                 if {$sdm == 3} {
 338                     set sdm 0
 339                 }
 340             }
 341             lappend neg [string range $id 1 end]
 342         } else {
 343             if {$sdm != 2} {
 344                 lappend ret $id
 345             } else {
 346                 lset ret end $id...[lindex $ret end]
 347             }
 348             lappend pos $id
 349         }
 350         incr sdm -1
 351     }
 352     set vposids($view) $pos
 353     set vnegids($view) $neg
 354     return $ret
 355 }
 356
 357 # Start off a git log process and arrange to read its output
 358 proc start_rev_list {view} {
 359     global startmsecs commitidx viewcomplete curview
 360     global tclencoding
 361     global viewargs viewargscmd viewfiles vfilelimit
 362     global showlocalchanges
 363     global viewactive viewinstances vmergeonly
 364     global mainheadid viewmainheadid viewmainheadid_orig
 365     global vcanopt vflags vrevs vorigargs
 366     global show_notes
 367
 368     set startmsecs [clock clicks -milliseconds]
 369     set commitidx($view) 0
 370     # these are set this way for the error exits
 371     set viewcomplete($view) 1
 372     set viewactive($view) 0
 373     varcinit $view
 374
 375     set args $viewargs($view)
 376     if {$viewargscmd($view) ne {}} {
 377         if {[catch {
 378             set str [exec sh -c $viewargscmd($view)]
 379         } err]} {
 380             error_popup "[mc "Error executing --argscmd command:"] $err"
 381             return 0
 382         }
 383         set args [concat $args [split $str "\n"]]
 384     }
 385     set vcanopt($view) [parseviewargs $view $args]
 386
 387     set files $viewfiles($view)
 388     if {$vmergeonly($view)} {
 389         set files [unmerged_files $files]
 390         if {$files eq {}} {
 391             global nr_unmerged
 392             if {$nr_unmerged == 0} {
 393                 error_popup [mc "No files selected: --merge specified but\
 394                              no files are unmerged."]
 395             } else {
 396                 error_popup [mc "No files selected: --merge specified but\
 397                              no unmerged files are within file limit."]
 398             }
 399             return 0
 400         }
 401     }
 402     set vfilelimit($view) $files
 403
 404     if {$vcanopt($view)} {
 405         set revs [parseviewrevs $view $vrevs($view)]
 406         if {$revs eq {}} {
 407             return 0
 408         }
 409         set args [concat $vflags($view) $revs]
 410     } else {
 411         set args $vorigargs($view)
 412     }
 413
 414     if {[catch {
 415         set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 416                         --parents --boundary $args "--" $files] r]
 417     } err]} {
 418         error_popup "[mc "Error executing git log:"] $err"
 419         return 0
 420     }
 421     set i [reg_instance $fd]
 422     set viewinstances($view) [list $i]
 423     set viewmainheadid($view) $mainheadid
 424     set viewmainheadid_orig($view) $mainheadid
 425     if {$files ne {} && $mainheadid ne {}} {
 426         get_viewmainhead $view
 427     }
 428     if {$showlocalchanges && $viewmainheadid($view) ne {}} {
 429         interestedin $viewmainheadid($view) dodiffindex
 430     }
 431     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 432     if {$tclencoding != {}} {
 433         fconfigure $fd -encoding $tclencoding
 434     }
 435     filerun $fd [list getcommitlines $fd $i $view 0]
 436     nowbusy $view [mc "Reading"]
 437     set viewcomplete($view) 0
 438     set viewactive($view) 1
 439     return 1
 440 }
 441
 442 proc stop_instance {inst} {
 443     global commfd leftover
 444
 445     set fd $commfd($inst)
 446     catch {
 447         set pid [pid $fd]
 448
 449         if {$::tcl_platform(platform) eq {windows}} {
 450             exec taskkill /pid $pid
 451         } else {
 452             exec kill $pid
 453         }
 454     }
 455     catch {close $fd}
 456     nukefile $fd
 457     unset commfd($inst)
 458     unset leftover($inst)
 459 }
 460
 461 proc stop_backends {} {
 462     global commfd
 463
 464     foreach inst [array names commfd] {
 465         stop_instance $inst
 466     }
 467 }
 468
 469 proc stop_rev_list {view} {
 470     global viewinstances
 471
 472     foreach inst $viewinstances($view) {
 473         stop_instance $inst
 474     }
 475     set viewinstances($view) {}
 476 }
 477
 478 proc reset_pending_select {selid} {
 479     global pending_select mainheadid selectheadid
 480
 481     if {$selid ne {}} {
 482         set pending_select $selid
 483     } elseif {$selectheadid ne {}} {
 484         set pending_select $selectheadid
 485     } else {
 486         set pending_select $mainheadid
 487     }
 488 }
 489
 490 proc getcommits {selid} {
 491     global canv curview need_redisplay viewactive
 492
 493     initlayout
 494     if {[start_rev_list $curview]} {
 495         reset_pending_select $selid
 496         show_status [mc "Reading commits..."]
 497         set need_redisplay 1
 498     } else {
 499         show_status [mc "No commits selected"]
 500     }
 501 }
 502
 503 proc updatecommits {} {
 504     global curview vcanopt vorigargs vfilelimit viewinstances
 505     global viewactive viewcomplete tclencoding
 506     global startmsecs showneartags showlocalchanges
 507     global mainheadid viewmainheadid viewmainheadid_orig pending_select
 508     global hasworktree
 509     global varcid vposids vnegids vflags vrevs
 510     global show_notes
 511
 512     set hasworktree [hasworktree]
 513     rereadrefs
 514     set view $curview
 515     if {$mainheadid ne $viewmainheadid_orig($view)} {
 516         if {$showlocalchanges} {
 517             dohidelocalchanges
 518         }
 519         set viewmainheadid($view) $mainheadid
 520         set viewmainheadid_orig($view) $mainheadid
 521         if {$vfilelimit($view) ne {}} {
 522             get_viewmainhead $view
 523         }
 524     }
 525     if {$showlocalchanges} {
 526         doshowlocalchanges
 527     }
 528     if {$vcanopt($view)} {
 529         set oldpos $vposids($view)
 530         set oldneg $vnegids($view)
 531         set revs [parseviewrevs $view $vrevs($view)]
 532         if {$revs eq {}} {
 533             return
 534         }
 535         # note: getting the delta when negative refs change is hard,
 536         # and could require multiple git log invocations, so in that
 537         # case we ask git log for all the commits (not just the delta)
 538         if {$oldneg eq $vnegids($view)} {
 539             set newrevs {}
 540             set npos 0
 541             # take out positive refs that we asked for before or
 542             # that we have already seen
 543             foreach rev $revs {
 544                 if {[string length $rev] == 40} {
 545                     if {[lsearch -exact $oldpos $rev] < 0
 546                         && ![info exists varcid($view,$rev)]} {
 547                         lappend newrevs $rev
 548                         incr npos
 549                     }
 550                 } else {
 551                     lappend $newrevs $rev
 552                 }
 553             }
 554             if {$npos == 0} return
 555             set revs $newrevs
 556             set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
 557         }
 558         set args [concat $vflags($view) $revs --not $oldpos]
 559     } else {
 560         set args $vorigargs($view)
 561     }
 562     if {[catch {
 563         set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 564                         --parents --boundary $args "--" $vfilelimit($view)] r]
 565     } err]} {
 566         error_popup "[mc "Error executing git log:"] $err"
 567         return
 568     }
 569     if {$viewactive($view) == 0} {
 570         set startmsecs [clock clicks -milliseconds]
 571     }
 572     set i [reg_instance $fd]
 573     lappend viewinstances($view) $i
 574     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 575     if {$tclencoding != {}} {
 576         fconfigure $fd -encoding $tclencoding
 577     }
 578     filerun $fd [list getcommitlines $fd $i $view 1]
 579     incr viewactive($view)
 580     set viewcomplete($view) 0
 581     reset_pending_select {}
 582     nowbusy $view [mc "Reading"]
 583     if {$showneartags} {
 584         getallcommits
 585     }
 586 }
 587
 588 proc reloadcommits {} {
 589     global curview viewcomplete selectedline currentid thickerline
 590     global showneartags treediffs commitinterest cached_commitrow
 591     global targetid
 592
 593     set selid {}
 594     if {$selectedline ne {}} {
 595         set selid $currentid
 596     }
 597
 598     if {!$viewcomplete($curview)} {
 599         stop_rev_list $curview
 600     }
 601     resetvarcs $curview
 602     set selectedline {}
 603     catch {unset currentid}
 604     catch {unset thickerline}
 605     catch {unset treediffs}
 606     readrefs
 607     changedrefs
 608     if {$showneartags} {
 609         getallcommits
 610     }
 611     clear_display
 612     catch {unset commitinterest}
 613     catch {unset cached_commitrow}
 614     catch {unset targetid}
 615     setcanvscroll
 616     getcommits $selid
 617     return 0
 618 }
 619
 620 # This makes a string representation of a positive integer which
 621 # sorts as a string in numerical order
 622 proc strrep {n} {
 623     if {$n < 16} {
 624         return [format "%x" $n]
 625     } elseif {$n < 256} {
 626         return [format "x%.2x" $n]
 627     } elseif {$n < 65536} {
 628         return [format "y%.4x" $n]
 629     }
 630     return [format "z%.8x" $n]
 631 }
 632
 633 # Procedures used in reordering commits from git log (without
 634 # --topo-order) into the order for display.
 635
 636 proc varcinit {view} {
 637     global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
 638     global vtokmod varcmod vrowmod varcix vlastins
 639
 640     set varcstart($view) {{}}
 641     set vupptr($view) {0}
 642     set vdownptr($view) {0}
 643     set vleftptr($view) {0}
 644     set vbackptr($view) {0}
 645     set varctok($view) {{}}
 646     set varcrow($view) {{}}
 647     set vtokmod($view) {}
 648     set varcmod($view) 0
 649     set vrowmod($view) 0
 650     set varcix($view) {{}}
 651     set vlastins($view) {0}
 652 }
 653
 654 proc resetvarcs {view} {
 655     global varcid varccommits parents children vseedcount ordertok
 656     global vshortids
 657
 658     foreach vid [array names varcid $view,*] {
 659         unset varcid($vid)
 660         unset children($vid)
 661         unset parents($vid)
 662     }
 663     foreach vid [array names vshortids $view,*] {
 664         unset vshortids($vid)
 665     }
 666     # some commits might have children but haven't been seen yet
 667     foreach vid [array names children $view,*] {
 668         unset children($vid)
 669     }
 670     foreach va [array names varccommits $view,*] {
 671         unset varccommits($va)
 672     }
 673     foreach vd [array names vseedcount $view,*] {
 674         unset vseedcount($vd)
 675     }
 676     catch {unset ordertok}
 677 }
 678
 679 # returns a list of the commits with no children
 680 proc seeds {v} {
 681     global vdownptr vleftptr varcstart
 682
 683     set ret {}
 684     set a [lindex $vdownptr($v) 0]
 685     while {$a != 0} {
 686         lappend ret [lindex $varcstart($v) $a]
 687         set a [lindex $vleftptr($v) $a]
 688     }
 689     return $ret
 690 }
 691
 692 proc newvarc {view id} {
 693     global varcid varctok parents children vdatemode
 694     global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
 695     global commitdata commitinfo vseedcount varccommits vlastins
 696
 697     set a [llength $varctok($view)]
 698     set vid $view,$id
 699     if {[llength $children($vid)] == 0 || $vdatemode($view)} {
 700         if {![info exists commitinfo($id)]} {
 701             parsecommit $id $commitdata($id) 1
 702         }
 703         set cdate [lindex [lindex $commitinfo($id) 4] 0]
 704         if {![string is integer -strict $cdate]} {
 705             set cdate 0
 706         }
 707         if {![info exists vseedcount($view,$cdate)]} {
 708             set vseedcount($view,$cdate) -1
 709         }
 710         set c [incr vseedcount($view,$cdate)]
 711         set cdate [expr {$cdate ^ 0xffffffff}]
 712         set tok "s[strrep $cdate][strrep $c]"
 713     } else {
 714         set tok {}
 715     }
 716     set ka 0
 717     if {[llength $children($vid)] > 0} {
 718         set kid [lindex $children($vid) end]
 719         set k $varcid($view,$kid)
 720         if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
 721             set ki $kid
 722             set ka $k
 723             set tok [lindex $varctok($view) $k]
 724         }
 725     }
 726     if {$ka != 0} {
 727         set i [lsearch -exact $parents($view,$ki) $id]
 728         set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 729         append tok [strrep $j]
 730     }
 731     set c [lindex $vlastins($view) $ka]
 732     if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
 733         set c $ka
 734         set b [lindex $vdownptr($view) $ka]
 735     } else {
 736         set b [lindex $vleftptr($view) $c]
 737     }
 738     while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 739         set c $b
 740         set b [lindex $vleftptr($view) $c]
 741     }
 742     if {$c == $ka} {
 743         lset vdownptr($view) $ka $a
 744         lappend vbackptr($view) 0
 745     } else {
 746         lset vleftptr($view) $c $a
 747         lappend vbackptr($view) $c
 748     }
 749     lset vlastins($view) $ka $a
 750     lappend vupptr($view) $ka
 751     lappend vleftptr($view) $b
 752     if {$b != 0} {
 753         lset vbackptr($view) $b $a
 754     }
 755     lappend varctok($view) $tok
 756     lappend varcstart($view) $id
 757     lappend vdownptr($view) 0
 758     lappend varcrow($view) {}
 759     lappend varcix($view) {}
 760     set varccommits($view,$a) {}
 761     lappend vlastins($view) 0
 762     return $a
 763 }
 764
 765 proc splitvarc {p v} {
 766     global varcid varcstart varccommits varctok vtokmod
 767     global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
 768
 769     set oa $varcid($v,$p)
 770     set otok [lindex $varctok($v) $oa]
 771     set ac $varccommits($v,$oa)
 772     set i [lsearch -exact $varccommits($v,$oa) $p]
 773     if {$i <= 0} return
 774     set na [llength $varctok($v)]
 775     # "%" sorts before "0"...
 776     set tok "$otok%[strrep $i]"
 777     lappend varctok($v) $tok
 778     lappend varcrow($v) {}
 779     lappend varcix($v) {}
 780     set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 781     set varccommits($v,$na) [lrange $ac $i end]
 782     lappend varcstart($v) $p
 783     foreach id $varccommits($v,$na) {
 784         set varcid($v,$id) $na
 785     }
 786     lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 787     lappend vlastins($v) [lindex $vlastins($v) $oa]
 788     lset vdownptr($v) $oa $na
 789     lset vlastins($v) $oa 0
 790     lappend vupptr($v) $oa
 791     lappend vleftptr($v) 0
 792     lappend vbackptr($v) 0
 793     for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 794         lset vupptr($v) $b $na
 795     }
 796     if {[string compare $otok $vtokmod($v)] <= 0} {
 797         modify_arc $v $oa
 798     }
 799 }
 800
 801 proc renumbervarc {a v} {
 802     global parents children varctok varcstart varccommits
 803     global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
 804
 805     set t1 [clock clicks -milliseconds]
 806     set todo {}
 807     set isrelated($a) 1
 808     set kidchanged($a) 1
 809     set ntot 0
 810     while {$a != 0} {
 811         if {[info exists isrelated($a)]} {
 812             lappend todo $a
 813             set id [lindex $varccommits($v,$a) end]
 814             foreach p $parents($v,$id) {
 815                 if {[info exists varcid($v,$p)]} {
 816                     set isrelated($varcid($v,$p)) 1
 817                 }
 818             }
 819         }
 820         incr ntot
 821         set b [lindex $vdownptr($v) $a]
 822         if {$b == 0} {
 823             while {$a != 0} {
 824                 set b [lindex $vleftptr($v) $a]
 825                 if {$b != 0} break
 826                 set a [lindex $vupptr($v) $a]
 827             }
 828         }
 829         set a $b
 830     }
 831     foreach a $todo {
 832         if {![info exists kidchanged($a)]} continue
 833         set id [lindex $varcstart($v) $a]
 834         if {[llength $children($v,$id)] > 1} {
 835             set children($v,$id) [lsort -command [list vtokcmp $v] \
 836                                       $children($v,$id)]
 837         }
 838         set oldtok [lindex $varctok($v) $a]
 839         if {!$vdatemode($v)} {
 840             set tok {}
 841         } else {
 842             set tok $oldtok
 843         }
 844         set ka 0
 845         set kid [last_real_child $v,$id]
 846         if {$kid ne {}} {
 847             set k $varcid($v,$kid)
 848             if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
 849                 set ki $kid
 850                 set ka $k
 851                 set tok [lindex $varctok($v) $k]
 852             }
 853         }
 854         if {$ka != 0} {
 855             set i [lsearch -exact $parents($v,$ki) $id]
 856             set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 857             append tok [strrep $j]
 858         }
 859         if {$tok eq $oldtok} {
 860             continue
 861         }
 862         set id [lindex $varccommits($v,$a) end]
 863         foreach p $parents($v,$id) {
 864             if {[info exists varcid($v,$p)]} {
 865                 set kidchanged($varcid($v,$p)) 1
 866             } else {
 867                 set sortkids($p) 1
 868             }
 869         }
 870         lset varctok($v) $a $tok
 871         set b [lindex $vupptr($v) $a]
 872         if {$b != $ka} {
 873             if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
 874                 modify_arc $v $ka
 875             }
 876             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 877                 modify_arc $v $b
 878             }
 879             set c [lindex $vbackptr($v) $a]
 880             set d [lindex $vleftptr($v) $a]
 881             if {$c == 0} {
 882                 lset vdownptr($v) $b $d
 883             } else {
 884                 lset vleftptr($v) $c $d
 885             }
 886             if {$d != 0} {
 887                 lset vbackptr($v) $d $c
 888             }
 889             if {[lindex $vlastins($v) $b] == $a} {
 890                 lset vlastins($v) $b $c
 891             }
 892             lset vupptr($v) $a $ka
 893             set c [lindex $vlastins($v) $ka]
 894             if {$c == 0 || \
 895                     [string compare $tok [lindex $varctok($v) $c]] < 0} {
 896                 set c $ka
 897                 set b [lindex $vdownptr($v) $ka]
 898             } else {
 899                 set b [lindex $vleftptr($v) $c]
 900             }
 901             while {$b != 0 && \
 902                       [string compare $tok [lindex $varctok($v) $b]] >= 0} {
 903                 set c $b
 904                 set b [lindex $vleftptr($v) $c]
 905             }
 906             if {$c == $ka} {
 907                 lset vdownptr($v) $ka $a
 908                 lset vbackptr($v) $a 0
 909             } else {
 910                 lset vleftptr($v) $c $a
 911                 lset vbackptr($v) $a $c
 912             }
 913             lset vleftptr($v) $a $b
 914             if {$b != 0} {
 915                 lset vbackptr($v) $b $a
 916             }
 917             lset vlastins($v) $ka $a
 918         }
 919     }
 920     foreach id [array names sortkids] {
 921         if {[llength $children($v,$id)] > 1} {
 922             set children($v,$id) [lsort -command [list vtokcmp $v] \
 923                                       $children($v,$id)]
 924         }
 925     }
 926     set t2 [clock clicks -milliseconds]
 927     #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 928 }
 929
 930 # Fix up the graph after we have found out that in view $v,
 931 # $p (a commit that we have already seen) is actually the parent
 932 # of the last commit in arc $a.
 933 proc fix_reversal {p a v} {
 934     global varcid varcstart varctok vupptr
 935
 936     set pa $varcid($v,$p)
 937     if {$p ne [lindex $varcstart($v) $pa]} {
 938         splitvarc $p $v
 939         set pa $varcid($v,$p)
 940     }
 941     # seeds always need to be renumbered
 942     if {[lindex $vupptr($v) $pa] == 0 ||
 943         [string compare [lindex $varctok($v) $a] \
 944              [lindex $varctok($v) $pa]] > 0} {
 945         renumbervarc $pa $v
 946     }
 947 }
 948
 949 proc insertrow {id p v} {
 950     global cmitlisted children parents varcid varctok vtokmod
 951     global varccommits ordertok commitidx numcommits curview
 952     global targetid targetrow vshortids
 953
 954     readcommit $id
 955     set vid $v,$id
 956     set cmitlisted($vid) 1
 957     set children($vid) {}
 958     set parents($vid) [list $p]
 959     set a [newvarc $v $id]
 960     set varcid($vid) $a
 961     lappend vshortids($v,[string range $id 0 3]) $id
 962     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
 963         modify_arc $v $a
 964     }
 965     lappend varccommits($v,$a) $id
 966     set vp $v,$p
 967     if {[llength [lappend children($vp) $id]] > 1} {
 968         set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
 969         catch {unset ordertok}
 970     }
 971     fix_reversal $p $a $v
 972     incr commitidx($v)
 973     if {$v == $curview} {
 974         set numcommits $commitidx($v)
 975         setcanvscroll
 976         if {[info exists targetid]} {
 977             if {![comes_before $targetid $p]} {
 978                 incr targetrow
 979             }
 980         }
 981     }
 982 }
 983
 984 proc insertfakerow {id p} {
 985     global varcid varccommits parents children cmitlisted
 986     global commitidx varctok vtokmod targetid targetrow curview numcommits
 987
 988     set v $curview
 989     set a $varcid($v,$p)
 990     set i [lsearch -exact $varccommits($v,$a) $p]
 991     if {$i < 0} {
 992         puts "oops: insertfakerow can't find [shortids $p] on arc $a"
 993         return
 994     }
 995     set children($v,$id) {}
 996     set parents($v,$id) [list $p]
 997     set varcid($v,$id) $a
 998     lappend children($v,$p) $id
 999     set cmitlisted($v,$id) 1
1000     set numcommits [incr commitidx($v)]
1001     # note we deliberately don't update varcstart($v) even if $i == 0
1002     set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
1003     modify_arc $v $a $i
1004     if {[info exists targetid]} {
1005         if {![comes_before $targetid $p]} {
1006             incr targetrow
1007         }
1008     }
1009     setcanvscroll
1010     drawvisible
1011 }
1012
1013 proc removefakerow {id} {
1014     global varcid varccommits parents children commitidx
1015     global varctok vtokmod cmitlisted currentid selectedline
1016     global targetid curview numcommits
1017
1018     set v $curview
1019     if {[llength $parents($v,$id)] != 1} {
1020         puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1021         return
1022     }
1023     set p [lindex $parents($v,$id) 0]
1024     set a $varcid($v,$id)
1025     set i [lsearch -exact $varccommits($v,$a) $id]
1026     if {$i < 0} {
1027         puts "oops: removefakerow can't find [shortids $id] on arc $a"
1028         return
1029     }
1030     unset varcid($v,$id)
1031     set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1032     unset parents($v,$id)
1033     unset children($v,$id)
1034     unset cmitlisted($v,$id)
1035     set numcommits [incr commitidx($v) -1]
1036     set j [lsearch -exact $children($v,$p) $id]
1037     if {$j >= 0} {
1038         set children($v,$p) [lreplace $children($v,$p) $j $j]
1039     }
1040     modify_arc $v $a $i
1041     if {[info exist currentid] && $id eq $currentid} {
1042         unset currentid
1043         set selectedline {}
1044     }
1045     if {[info exists targetid] && $targetid eq $id} {
1046         set targetid $p
1047     }
1048     setcanvscroll
1049     drawvisible
1050 }
1051
1052 proc real_children {vp} {
1053     global children nullid nullid2
1054
1055     set kids {}
1056     foreach id $children($vp) {
1057         if {$id ne $nullid && $id ne $nullid2} {
1058             lappend kids $id
1059         }
1060     }
1061     return $kids
1062 }
1063
1064 proc first_real_child {vp} {
1065     global children nullid nullid2
1066
1067     foreach id $children($vp) {
1068         if {$id ne $nullid && $id ne $nullid2} {
1069             return $id
1070         }
1071     }
1072     return {}
1073 }
1074
1075 proc last_real_child {vp} {
1076     global children nullid nullid2
1077
1078     set kids $children($vp)
1079     for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1080         set id [lindex $kids $i]
1081         if {$id ne $nullid && $id ne $nullid2} {
1082             return $id
1083         }
1084     }
1085     return {}
1086 }
1087
1088 proc vtokcmp {v a b} {
1089     global varctok varcid
1090
1091     return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1092                 [lindex $varctok($v) $varcid($v,$b)]]
1093 }
1094
1095 # This assumes that if lim is not given, the caller has checked that
1096 # arc a's token is less than $vtokmod($v)
1097 proc modify_arc {v a {lim {}}} {
1098     global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1099
1100     if {$lim ne {}} {
1101         set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1102         if {$c > 0} return
1103         if {$c == 0} {
1104             set r [lindex $varcrow($v) $a]
1105             if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1106         }
1107     }
1108     set vtokmod($v) [lindex $varctok($v) $a]
1109     set varcmod($v) $a
1110     if {$v == $curview} {
1111         while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1112             set a [lindex $vupptr($v) $a]
1113             set lim {}
1114         }
1115         set r 0
1116         if {$a != 0} {
1117             if {$lim eq {}} {
1118                 set lim [llength $varccommits($v,$a)]
1119             }
1120             set r [expr {[lindex $varcrow($v) $a] + $lim}]
1121         }
1122         set vrowmod($v) $r
1123         undolayout $r
1124     }
1125 }
1126
1127 proc update_arcrows {v} {
1128     global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1129     global varcid vrownum varcorder varcix varccommits
1130     global vupptr vdownptr vleftptr varctok
1131     global displayorder parentlist curview cached_commitrow
1132
1133     if {$vrowmod($v) == $commitidx($v)} return
1134     if {$v == $curview} {
1135         if {[llength $displayorder] > $vrowmod($v)} {
1136             set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1137             set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1138         }
1139         catch {unset cached_commitrow}
1140     }
1141     set narctot [expr {[llength $varctok($v)] - 1}]
1142     set a $varcmod($v)
1143     while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1144         # go up the tree until we find something that has a row number,
1145         # or we get to a seed
1146         set a [lindex $vupptr($v) $a]
1147     }
1148     if {$a == 0} {
1149         set a [lindex $vdownptr($v) 0]
1150         if {$a == 0} return
1151         set vrownum($v) {0}
1152         set varcorder($v) [list $a]
1153         lset varcix($v) $a 0
1154         lset varcrow($v) $a 0
1155         set arcn 0
1156         set row 0
1157     } else {
1158         set arcn [lindex $varcix($v) $a]
1159         if {[llength $vrownum($v)] > $arcn + 1} {
1160             set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1161             set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1162         }
1163         set row [lindex $varcrow($v) $a]
1164     }
1165     while {1} {
1166         set p $a
1167         incr row [llength $varccommits($v,$a)]
1168         # go down if possible
1169         set b [lindex $vdownptr($v) $a]
1170         if {$b == 0} {
1171             # if not, go left, or go up until we can go left
1172             while {$a != 0} {
1173                 set b [lindex $vleftptr($v) $a]
1174                 if {$b != 0} break
1175                 set a [lindex $vupptr($v) $a]
1176             }
1177             if {$a == 0} break
1178         }
1179         set a $b
1180         incr arcn
1181         lappend vrownum($v) $row
1182         lappend varcorder($v) $a
1183         lset varcix($v) $a $arcn
1184         lset varcrow($v) $a $row
1185     }
1186     set vtokmod($v) [lindex $varctok($v) $p]
1187     set varcmod($v) $p
1188     set vrowmod($v) $row
1189     if {[info exists currentid]} {
1190         set selectedline [rowofcommit $currentid]
1191     }
1192 }
1193
1194 # Test whether view $v contains commit $id
1195 proc commitinview {id v} {
1196     global varcid
1197
1198     return [info exists varcid($v,$id)]
1199 }
1200
1201 # Return the row number for commit $id in the current view
1202 proc rowofcommit {id} {
1203     global varcid varccommits varcrow curview cached_commitrow
1204     global varctok vtokmod
1205
1206     set v $curview
1207     if {![info exists varcid($v,$id)]} {
1208         puts "oops rowofcommit no arc for [shortids $id]"
1209         return {}
1210     }
1211     set a $varcid($v,$id)
1212     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1213         update_arcrows $v
1214     }
1215     if {[info exists cached_commitrow($id)]} {
1216         return $cached_commitrow($id)
1217     }
1218     set i [lsearch -exact $varccommits($v,$a) $id]
1219     if {$i < 0} {
1220         puts "oops didn't find commit [shortids $id] in arc $a"
1221         return {}
1222     }
1223     incr i [lindex $varcrow($v) $a]
1224     set cached_commitrow($id) $i
1225     return $i
1226 }
1227
1228 # Returns 1 if a is on an earlier row than b, otherwise 0
1229 proc comes_before {a b} {
1230     global varcid varctok curview
1231
1232     set v $curview
1233     if {$a eq $b || ![info exists varcid($v,$a)] || \
1234             ![info exists varcid($v,$b)]} {
1235         return 0
1236     }
1237     if {$varcid($v,$a) != $varcid($v,$b)} {
1238         return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1239                            [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1240     }
1241     return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1242 }
1243
1244 proc bsearch {l elt} {
1245     if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1246         return 0
1247     }
1248     set lo 0
1249     set hi [llength $l]
1250     while {$hi - $lo > 1} {
1251         set mid [expr {int(($lo + $hi) / 2)}]
1252         set t [lindex $l $mid]
1253         if {$elt < $t} {
1254             set hi $mid
1255         } elseif {$elt > $t} {
1256             set lo $mid
1257         } else {
1258             return $mid
1259         }
1260     }
1261     return $lo
1262 }
1263
1264 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
1265 proc make_disporder {start end} {
1266     global vrownum curview commitidx displayorder parentlist
1267     global varccommits varcorder parents vrowmod varcrow
1268     global d_valid_start d_valid_end
1269
1270     if {$end > $vrowmod($curview)} {
1271         update_arcrows $curview
1272     }
1273     set ai [bsearch $vrownum($curview) $start]
1274     set start [lindex $vrownum($curview) $ai]
1275     set narc [llength $vrownum($curview)]
1276     for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1277         set a [lindex $varcorder($curview) $ai]
1278         set l [llength $displayorder]
1279         set al [llength $varccommits($curview,$a)]
1280         if {$l < $r + $al} {
1281             if {$l < $r} {
1282                 set pad [ntimes [expr {$r - $l}] {}]
1283                 set displayorder [concat $displayorder $pad]
1284                 set parentlist [concat $parentlist $pad]
1285             } elseif {$l > $r} {
1286                 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1287                 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1288             }
1289             foreach id $varccommits($curview,$a) {
1290                 lappend displayorder $id
1291                 lappend parentlist $parents($curview,$id)
1292             }
1293         } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1294             set i $r
1295             foreach id $varccommits($curview,$a) {
1296                 lset displayorder $i $id
1297                 lset parentlist $i $parents($curview,$id)
1298                 incr i
1299             }
1300         }
1301         incr r $al
1302     }
1303 }
1304
1305 proc commitonrow {row} {
1306     global displayorder
1307
1308     set id [lindex $displayorder $row]
1309     if {$id eq {}} {
1310         make_disporder $row [expr {$row + 1}]
1311         set id [lindex $displayorder $row]
1312     }
1313     return $id
1314 }
1315
1316 proc closevarcs {v} {
1317     global varctok varccommits varcid parents children
1318     global cmitlisted commitidx vtokmod
1319
1320     set missing_parents 0
1321     set scripts {}
1322     set narcs [llength $varctok($v)]
1323     for {set a 1} {$a < $narcs} {incr a} {
1324         set id [lindex $varccommits($v,$a) end]
1325         foreach p $parents($v,$id) {
1326             if {[info exists varcid($v,$p)]} continue
1327             # add p as a new commit
1328             incr missing_parents
1329             set cmitlisted($v,$p) 0
1330             set parents($v,$p) {}
1331             if {[llength $children($v,$p)] == 1 &&
1332                 [llength $parents($v,$id)] == 1} {
1333                 set b $a
1334             } else {
1335                 set b [newvarc $v $p]
1336             }
1337             set varcid($v,$p) $b
1338             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1339                 modify_arc $v $b
1340             }
1341             lappend varccommits($v,$b) $p
1342             incr commitidx($v)
1343             set scripts [check_interest $p $scripts]
1344         }
1345     }
1346     if {$missing_parents > 0} {
1347         foreach s $scripts {
1348             eval $s
1349         }
1350     }
1351 }
1352
1353 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1354 # Assumes we already have an arc for $rwid.
1355 proc rewrite_commit {v id rwid} {
1356     global children parents varcid varctok vtokmod varccommits
1357
1358     foreach ch $children($v,$id) {
1359         # make $rwid be $ch's parent in place of $id
1360         set i [lsearch -exact $parents($v,$ch) $id]
1361         if {$i < 0} {
1362             puts "oops rewrite_commit didn't find $id in parent list for $ch"
1363         }
1364         set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1365         # add $ch to $rwid's children and sort the list if necessary
1366         if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1367             set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1368                                         $children($v,$rwid)]
1369         }
1370         # fix the graph after joining $id to $rwid
1371         set a $varcid($v,$ch)
1372         fix_reversal $rwid $a $v
1373         # parentlist is wrong for the last element of arc $a
1374         # even if displayorder is right, hence the 3rd arg here
1375         modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1376     }
1377 }
1378
1379 # Mechanism for registering a command to be executed when we come
1380 # across a particular commit.  To handle the case when only the
1381 # prefix of the commit is known, the commitinterest array is now
1382 # indexed by the first 4 characters of the ID.  Each element is a
1383 # list of id, cmd pairs.
1384 proc interestedin {id cmd} {
1385     global commitinterest
1386
1387     lappend commitinterest([string range $id 0 3]) $id $cmd
1388 }
1389
1390 proc check_interest {id scripts} {
1391     global commitinterest
1392
1393     set prefix [string range $id 0 3]
1394     if {[info exists commitinterest($prefix)]} {
1395         set newlist {}
1396         foreach {i script} $commitinterest($prefix) {
1397             if {[string match "$i*" $id]} {
1398                 lappend scripts [string map [list "%I" $id "%P" $i] $script]
1399             } else {
1400                 lappend newlist $i $script
1401             }
1402         }
1403         if {$newlist ne {}} {
1404             set commitinterest($prefix) $newlist
1405         } else {
1406             unset commitinterest($prefix)
1407         }
1408     }
1409     return $scripts
1410 }
1411
1412 proc getcommitlines {fd inst view updating}  {
1413     global cmitlisted leftover
1414     global commitidx commitdata vdatemode
1415     global parents children curview hlview
1416     global idpending ordertok
1417     global varccommits varcid varctok vtokmod vfilelimit vshortids
1418
1419     set stuff [read $fd 500000]
1420     # git log doesn't terminate the last commit with a null...
1421     if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1422         set stuff "\0"
1423     }
1424     if {$stuff == {}} {
1425         if {![eof $fd]} {
1426             return 1
1427         }
1428         global commfd viewcomplete viewactive viewname
1429         global viewinstances
1430         unset commfd($inst)
1431         set i [lsearch -exact $viewinstances($view) $inst]
1432         if {$i >= 0} {
1433             set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1434         }
1435         # set it blocking so we wait for the process to terminate
1436         fconfigure $fd -blocking 1
1437         if {[catch {close $fd} err]} {
1438             set fv {}
1439             if {$view != $curview} {
1440                 set fv " for the \"$viewname($view)\" view"
1441             }
1442             if {[string range $err 0 4] == "usage"} {
1443                 set err "Gitk: error reading commits$fv:\
1444                         bad arguments to git log."
1445                 if {$viewname($view) eq "Command line"} {
1446                     append err \
1447                         "  (Note: arguments to gitk are passed to git log\
1448                          to allow selection of commits to be displayed.)"
1449                 }
1450             } else {
1451                 set err "Error reading commits$fv: $err"
1452             }
1453             error_popup $err
1454         }
1455         if {[incr viewactive($view) -1] <= 0} {
1456             set viewcomplete($view) 1
1457             # Check if we have seen any ids listed as parents that haven't
1458             # appeared in the list
1459             closevarcs $view
1460             notbusy $view
1461         }
1462         if {$view == $curview} {
1463             run chewcommits
1464         }
1465         return 0
1466     }
1467     set start 0
1468     set gotsome 0
1469     set scripts {}
1470     while 1 {
1471         set i [string first "\0" $stuff $start]
1472         if {$i < 0} {
1473             append leftover($inst) [string range $stuff $start end]
1474             break
1475         }
1476         if {$start == 0} {
1477             set cmit $leftover($inst)
1478             append cmit [string range $stuff 0 [expr {$i - 1}]]
1479             set leftover($inst) {}
1480         } else {
1481             set cmit [string range $stuff $start [expr {$i - 1}]]
1482         }
1483         set start [expr {$i + 1}]
1484         set j [string first "\n" $cmit]
1485         set ok 0
1486         set listed 1
1487         if {$j >= 0 && [string match "commit *" $cmit]} {
1488             set ids [string range $cmit 7 [expr {$j - 1}]]
1489             if {[string match {[-^<>]*} $ids]} {
1490                 switch -- [string index $ids 0] {
1491                     "-" {set listed 0}
1492                     "^" {set listed 2}
1493                     "<" {set listed 3}
1494                     ">" {set listed 4}
1495                 }
1496                 set ids [string range $ids 1 end]
1497             }
1498             set ok 1
1499             foreach id $ids {
1500                 if {[string length $id] != 40} {
1501                     set ok 0
1502                     break
1503                 }
1504             }
1505         }
1506         if {!$ok} {
1507             set shortcmit $cmit
1508             if {[string length $shortcmit] > 80} {
1509                 set shortcmit "[string range $shortcmit 0 80]..."
1510             }
1511             error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1512             exit 1
1513         }
1514         set id [lindex $ids 0]
1515         set vid $view,$id
1516
1517         lappend vshortids($view,[string range $id 0 3]) $id
1518
1519         if {!$listed && $updating && ![info exists varcid($vid)] &&
1520             $vfilelimit($view) ne {}} {
1521             # git log doesn't rewrite parents for unlisted commits
1522             # when doing path limiting, so work around that here
1523             # by working out the rewritten parent with git rev-list
1524             # and if we already know about it, using the rewritten
1525             # parent as a substitute parent for $id's children.
1526             if {![catch {
1527                 set rwid [exec git rev-list --first-parent --max-count=1 \
1528                               $id -- $vfilelimit($view)]
1529             }]} {
1530                 if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1531                     # use $rwid in place of $id
1532                     rewrite_commit $view $id $rwid
1533                     continue
1534                 }
1535             }
1536         }
1537
1538         set a 0
1539         if {[info exists varcid($vid)]} {
1540             if {$cmitlisted($vid) || !$listed} continue
1541             set a $varcid($vid)
1542         }
1543         if {$listed} {
1544             set olds [lrange $ids 1 end]
1545         } else {
1546             set olds {}
1547         }
1548         set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1549         set cmitlisted($vid) $listed
1550         set parents($vid) $olds
1551         if {![info exists children($vid)]} {
1552             set children($vid) {}
1553         } elseif {$a == 0 && [llength $children($vid)] == 1} {
1554             set k [lindex $children($vid) 0]
1555             if {[llength $parents($view,$k)] == 1 &&
1556                 (!$vdatemode($view) ||
1557                  $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1558                 set a $varcid($view,$k)
1559             }
1560         }
1561         if {$a == 0} {
1562             # new arc
1563             set a [newvarc $view $id]
1564         }
1565         if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1566             modify_arc $view $a
1567         }
1568         if {![info exists varcid($vid)]} {
1569             set varcid($vid) $a
1570             lappend varccommits($view,$a) $id
1571             incr commitidx($view)
1572         }
1573
1574         set i 0
1575         foreach p $olds {
1576             if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1577                 set vp $view,$p
1578                 if {[llength [lappend children($vp) $id]] > 1 &&
1579                     [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1580                     set children($vp) [lsort -command [list vtokcmp $view] \
1581                                            $children($vp)]
1582                     catch {unset ordertok}
1583                 }
1584                 if {[info exists varcid($view,$p)]} {
1585                     fix_reversal $p $a $view
1586                 }
1587             }
1588             incr i
1589         }
1590
1591         set scripts [check_interest $id $scripts]
1592         set gotsome 1
1593     }
1594     if {$gotsome} {
1595         global numcommits hlview
1596
1597         if {$view == $curview} {
1598             set numcommits $commitidx($view)
1599             run chewcommits
1600         }
1601         if {[info exists hlview] && $view == $hlview} {
1602             # we never actually get here...
1603             run vhighlightmore
1604         }
1605         foreach s $scripts {
1606             eval $s
1607         }
1608     }
1609     return 2
1610 }
1611
1612 proc chewcommits {} {
1613     global curview hlview viewcomplete
1614     global pending_select
1615
1616     layoutmore
1617     if {$viewcomplete($curview)} {
1618         global commitidx varctok
1619         global numcommits startmsecs
1620
1621         if {[info exists pending_select]} {
1622             update
1623             reset_pending_select {}
1624
1625             if {[commitinview $pending_select $curview]} {
1626                 selectline [rowofcommit $pending_select] 1
1627             } else {
1628                 set row [first_real_row]
1629                 selectline $row 1
1630             }
1631         }
1632         if {$commitidx($curview) > 0} {
1633             #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1634             #puts "overall $ms ms for $numcommits commits"
1635             #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1636         } else {
1637             show_status [mc "No commits selected"]
1638         }
1639         notbusy layout
1640     }
1641     return 0
1642 }
1643
1644 proc do_readcommit {id} {
1645     global tclencoding
1646
1647     # Invoke git-log to handle automatic encoding conversion
1648     set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1649     # Read the results using i18n.logoutputencoding
1650     fconfigure $fd -translation lf -eofchar {}
1651     if {$tclencoding != {}} {
1652         fconfigure $fd -encoding $tclencoding
1653     }
1654     set contents [read $fd]
1655     close $fd
1656     # Remove the heading line
1657     regsub {^commit [0-9a-f]+\n} $contents {} contents
1658
1659     return $contents
1660 }
1661
1662 proc readcommit {id} {
1663     if {[catch {set contents [do_readcommit $id]}]} return
1664     parsecommit $id $contents 1
1665 }
1666
1667 proc parsecommit {id contents listed} {
1668     global commitinfo
1669
1670     set inhdr 1
1671     set comment {}
1672     set headline {}
1673     set auname {}
1674     set audate {}
1675     set comname {}
1676     set comdate {}
1677     set hdrend [string first "\n\n" $contents]
1678     if {$hdrend < 0} {
1679         # should never happen...
1680         set hdrend [string length $contents]
1681     }
1682     set header [string range $contents 0 [expr {$hdrend - 1}]]
1683     set comment [string range $contents [expr {$hdrend + 2}] end]
1684     foreach line [split $header "\n"] {
1685         set line [split $line " "]
1686         set tag [lindex $line 0]
1687         if {$tag == "author"} {
1688             set audate [lrange $line end-1 end]
1689             set auname [join [lrange $line 1 end-2] " "]
1690         } elseif {$tag == "committer"} {
1691             set comdate [lrange $line end-1 end]
1692             set comname [join [lrange $line 1 end-2] " "]
1693         }
1694     }
1695     set headline {}
1696     # take the first non-blank line of the comment as the headline
1697     set headline [string trimleft $comment]
1698     set i [string first "\n" $headline]
1699     if {$i >= 0} {
1700         set headline [string range $headline 0 $i]
1701     }
1702     set headline [string trimright $headline]
1703     set i [string first "\r" $headline]
1704     if {$i >= 0} {
1705         set headline [string trimright [string range $headline 0 $i]]
1706     }
1707     if {!$listed} {
1708         # git log indents the comment by 4 spaces;
1709         # if we got this via git cat-file, add the indentation
1710         set newcomment {}
1711         foreach line [split $comment "\n"] {
1712             append newcomment "    "
1713             append newcomment $line
1714             append newcomment "\n"
1715         }
1716         set comment $newcomment
1717     }
1718     set hasnote [string first "\nNotes:\n" $contents]
1719     set diff ""
1720     # If there is diff output shown in the git-log stream, split it
1721     # out.  But get rid of the empty line that always precedes the
1722     # diff.
1723     set i [string first "\n\ndiff" $comment]
1724     if {$i >= 0} {
1725         set diff [string range $comment $i+1 end]
1726         set comment [string range $comment 0 $i-1]
1727     }
1728     set commitinfo($id) [list $headline $auname $audate \
1729                              $comname $comdate $comment $hasnote $diff]
1730 }
1731
1732 proc getcommit {id} {
1733     global commitdata commitinfo
1734
1735     if {[info exists commitdata($id)]} {
1736         parsecommit $id $commitdata($id) 1
1737     } else {
1738         readcommit $id
1739         if {![info exists commitinfo($id)]} {
1740             set commitinfo($id) [list [mc "No commit information available"]]
1741         }
1742     }
1743     return 1
1744 }
1745
1746 # Expand an abbreviated commit ID to a list of full 40-char IDs that match
1747 # and are present in the current view.
1748 # This is fairly slow...
1749 proc longid {prefix} {
1750     global varcid curview vshortids
1751
1752     set ids {}
1753     if {[string length $prefix] >= 4} {
1754         set vshortid $curview,[string range $prefix 0 3]
1755         if {[info exists vshortids($vshortid)]} {
1756             foreach id $vshortids($vshortid) {
1757                 if {[string match "$prefix*" $id]} {
1758                     if {[lsearch -exact $ids $id] < 0} {
1759                         lappend ids $id
1760                         if {[llength $ids] >= 2} break
1761                     }
1762                 }
1763             }
1764         }
1765     } else {
1766         foreach match [array names varcid "$curview,$prefix*"] {
1767             lappend ids [lindex [split $match ","] 1]
1768             if {[llength $ids] >= 2} break
1769         }
1770     }
1771     return $ids
1772 }
1773
1774 proc readrefs {} {
1775     global tagids idtags headids idheads tagobjid
1776     global otherrefids idotherrefs mainhead mainheadid
1777     global selecthead selectheadid
1778     global hideremotes
1779
1780     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1781         catch {unset $v}
1782     }
1783     set refd [open [list | git show-ref -d] r]
1784     while {[gets $refd line] >= 0} {
1785         if {[string index $line 40] ne " "} continue
1786         set id [string range $line 0 39]
1787         set ref [string range $line 41 end]
1788         if {![string match "refs/*" $ref]} continue
1789         set name [string range $ref 5 end]
1790         if {[string match "remotes/*" $name]} {
1791             if {![string match "*/HEAD" $name] && !$hideremotes} {
1792                 set headids($name) $id
1793                 lappend idheads($id) $name
1794             }
1795         } elseif {[string match "heads/*" $name]} {
1796             set name [string range $name 6 end]
1797             set headids($name) $id
1798             lappend idheads($id) $name
1799         } elseif {[string match "tags/*" $name]} {
1800             # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1801             # which is what we want since the former is the commit ID
1802             set name [string range $name 5 end]
1803             if {[string match "*^{}" $name]} {
1804                 set name [string range $name 0 end-3]
1805             } else {
1806                 set tagobjid($name) $id
1807             }
1808             set tagids($name) $id
1809             lappend idtags($id) $name
1810         } else {
1811             set otherrefids($name) $id
1812             lappend idotherrefs($id) $name
1813         }
1814     }
1815     catch {close $refd}
1816     set mainhead {}
1817     set mainheadid {}
1818     catch {
1819         set mainheadid [exec git rev-parse HEAD]
1820         set thehead [exec git symbolic-ref HEAD]
1821         if {[string match "refs/heads/*" $thehead]} {
1822             set mainhead [string range $thehead 11 end]
1823         }
1824     }
1825     set selectheadid {}
1826     if {$selecthead ne {}} {
1827         catch {
1828             set selectheadid [exec git rev-parse --verify $selecthead]
1829         }
1830     }
1831 }
1832
1833 # skip over fake commits
1834 proc first_real_row {} {
1835     global nullid nullid2 numcommits
1836
1837     for {set row 0} {$row < $numcommits} {incr row} {
1838         set id [commitonrow $row]
1839         if {$id ne $nullid && $id ne $nullid2} {
1840             break
1841         }
1842     }
1843     return $row
1844 }
1845
1846 # update things for a head moved to a child of its previous location
1847 proc movehead {id name} {
1848     global headids idheads
1849
1850     removehead $headids($name) $name
1851     set headids($name) $id
1852     lappend idheads($id) $name
1853 }
1854
1855 # update things when a head has been removed
1856 proc removehead {id name} {
1857     global headids idheads
1858
1859     if {$idheads($id) eq $name} {
1860         unset idheads($id)
1861     } else {
1862         set i [lsearch -exact $idheads($id) $name]
1863         if {$i >= 0} {
1864             set idheads($id) [lreplace $idheads($id) $i $i]
1865         }
1866     }
1867     unset headids($name)
1868 }
1869
1870 proc ttk_toplevel {w args} {
1871     global use_ttk
1872     eval [linsert $args 0 ::toplevel $w]
1873     if {$use_ttk} {
1874         place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1875     }
1876     return $w
1877 }
1878
1879 proc make_transient {window origin} {
1880     global have_tk85
1881
1882     # In MacOS Tk 8.4 transient appears to work by setting
1883     # overrideredirect, which is utterly useless, since the
1884     # windows get no border, and are not even kept above
1885     # the parent.
1886     if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1887
1888     wm transient $window $origin
1889
1890     # Windows fails to place transient windows normally, so
1891     # schedule a callback to center them on the parent.
1892     if {[tk windowingsystem] eq {win32}} {
1893         after idle [list tk::PlaceWindow $window widget $origin]
1894     }
1895 }
1896
1897 proc show_error {w top msg {mc mc}} {
1898     global NS
1899     if {![info exists NS]} {set NS ""}
1900     if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1901     message $w.m -text $msg -justify center -aspect 400
1902     pack $w.m -side top -fill x -padx 20 -pady 20
1903     ${NS}::button $w.ok -default active -text [$mc OK] -command "destroy $top"
1904     pack $w.ok -side bottom -fill x
1905     bind $top <Visibility> "grab $top; focus $top"
1906     bind $top <Key-Return> "destroy $top"
1907     bind $top <Key-space>  "destroy $top"
1908     bind $top <Key-Escape> "destroy $top"
1909     tkwait window $top
1910 }
1911
1912 proc error_popup {msg {owner .}} {
1913     if {[tk windowingsystem] eq "win32"} {
1914         tk_messageBox -icon error -type ok -title [wm title .] \
1915             -parent $owner -message $msg
1916     } else {
1917         set w .error
1918         ttk_toplevel $w
1919         make_transient $w $owner
1920         show_error $w $w $msg
1921     }
1922 }
1923
1924 proc confirm_popup {msg {owner .}} {
1925     global confirm_ok NS
1926     set confirm_ok 0
1927     set w .confirm
1928     ttk_toplevel $w
1929     make_transient $w $owner
1930     message $w.m -text $msg -justify center -aspect 400
1931     pack $w.m -side top -fill x -padx 20 -pady 20
1932     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1933     pack $w.ok -side left -fill x
1934     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1935     pack $w.cancel -side right -fill x
1936     bind $w <Visibility> "grab $w; focus $w"
1937     bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1938     bind $w <Key-space>  "set confirm_ok 1; destroy $w"
1939     bind $w <Key-Escape> "destroy $w"
1940     tk::PlaceWindow $w widget $owner
1941     tkwait window $w
1942     return $confirm_ok
1943 }
1944
1945 proc setoptions {} {
1946     if {[tk windowingsystem] ne "win32"} {
1947         option add *Panedwindow.showHandle 1 startupFile
1948         option add *Panedwindow.sashRelief raised startupFile
1949         if {[tk windowingsystem] ne "aqua"} {
1950             option add *Menu.font uifont startupFile
1951         }
1952     } else {
1953         option add *Menu.TearOff 0 startupFile
1954     }
1955     option add *Button.font uifont startupFile
1956     option add *Checkbutton.font uifont startupFile
1957     option add *Radiobutton.font uifont startupFile
1958     option add *Menubutton.font uifont startupFile
1959     option add *Label.font uifont startupFile
1960     option add *Message.font uifont startupFile
1961     option add *Entry.font textfont startupFile
1962     option add *Text.font textfont startupFile
1963     option add *Labelframe.font uifont startupFile
1964     option add *Spinbox.font textfont startupFile
1965     option add *Listbox.font mainfont startupFile
1966 }
1967
1968 # Make a menu and submenus.
1969 # m is the window name for the menu, items is the list of menu items to add.
1970 # Each item is a list {mc label type description options...}
1971 # mc is ignored; it's so we can put mc there to alert xgettext
1972 # label is the string that appears in the menu
1973 # type is cascade, command or radiobutton (should add checkbutton)
1974 # description depends on type; it's the sublist for cascade, the
1975 # command to invoke for command, or {variable value} for radiobutton
1976 proc makemenu {m items} {
1977     menu $m
1978     if {[tk windowingsystem] eq {aqua}} {
1979         set Meta1 Cmd
1980     } else {
1981         set Meta1 Ctrl
1982     }
1983     foreach i $items {
1984         set name [mc [lindex $i 1]]
1985         set type [lindex $i 2]
1986         set thing [lindex $i 3]
1987         set params [list $type]
1988         if {$name ne {}} {
1989             set u [string first "&" [string map {&& x} $name]]
1990             lappend params -label [string map {&& & & {}} $name]
1991             if {$u >= 0} {
1992                 lappend params -underline $u
1993             }
1994         }
1995         switch -- $type {
1996             "cascade" {
1997                 set submenu [string tolower [string map {& ""} [lindex $i 1]]]
1998                 lappend params -menu $m.$submenu
1999             }
2000             "command" {
2001                 lappend params -command $thing
2002             }
2003             "radiobutton" {
2004                 lappend params -variable [lindex $thing 0] \
2005                     -value [lindex $thing 1]
2006             }
2007         }
2008         set tail [lrange $i 4 end]
2009         regsub -all {\yMeta1\y} $tail $Meta1 tail
2010         eval $m add $params $tail
2011         if {$type eq "cascade"} {
2012             makemenu $m.$submenu $thing
2013         }
2014     }
2015 }
2016
2017 # translate string and remove ampersands
2018 proc mca {str} {
2019     return [string map {&& & & {}} [mc $str]]
2020 }
2021
2022 proc cleardropsel {w} {
2023     $w selection clear
2024 }
2025 proc makedroplist {w varname args} {
2026     global use_ttk
2027     if {$use_ttk} {
2028         set width 0
2029         foreach label $args {
2030             set cx [string length $label]
2031             if {$cx > $width} {set width $cx}
2032         }
2033         set gm [ttk::combobox $w -width $width -state readonly\
2034                     -textvariable $varname -values $args \
2035                     -exportselection false]
2036         bind $gm <<ComboboxSelected>> [list $gm selection clear]
2037     } else {
2038         set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2039     }
2040     return $gm
2041 }
2042
2043 proc makewindow {} {
2044     global canv canv2 canv3 linespc charspc ctext cflist cscroll
2045     global tabstop
2046     global findtype findtypemenu findloc findstring fstring geometry
2047     global entries sha1entry sha1string sha1but
2048     global diffcontextstring diffcontext
2049     global ignorespace
2050     global maincursor textcursor curtextcursor
2051     global rowctxmenu fakerowmenu mergemax wrapcomment
2052     global highlight_files gdttype
2053     global searchstring sstring
2054     global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
2055     global uifgcolor uifgdisabledcolor
2056     global filesepbgcolor filesepfgcolor
2057     global mergecolors foundbgcolor currentsearchhitbgcolor
2058     global headctxmenu progresscanv progressitem progresscoords statusw
2059     global fprogitem fprogcoord lastprogupdate progupdatepending
2060     global rprogitem rprogcoord rownumsel numcommits
2061     global have_tk85 use_ttk NS
2062     global git_version
2063     global worddiff
2064
2065     # The "mc" arguments here are purely so that xgettext
2066     # sees the following string as needing to be translated
2067     set file {
2068         mc "File" cascade {
2069             {mc "Update" command updatecommits -accelerator F5}
2070             {mc "Reload" command reloadcommits -accelerator Shift-F5}
2071             {mc "Reread references" command rereadrefs}
2072             {mc "List references" command showrefs -accelerator F2}
2073             {xx "" separator}
2074             {mc "Start git gui" command {exec git gui &}}
2075             {xx "" separator}
2076             {mc "Quit" command doquit -accelerator Meta1-Q}
2077         }}
2078     set edit {
2079         mc "Edit" cascade {
2080             {mc "Preferences" command doprefs}
2081         }}
2082     set view {
2083         mc "View" cascade {
2084             {mc "New view..." command {newview 0} -accelerator Shift-F4}
2085             {mc "Edit view..." command editview -state disabled -accelerator F4}
2086             {mc "Delete view" command delview -state disabled}
2087             {xx "" separator}
2088             {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
2089         }}
2090     if {[tk windowingsystem] ne "aqua"} {
2091         set help {
2092         mc "Help" cascade {
2093             {mc "About gitk" command about}
2094             {mc "Key bindings" command keys}
2095         }}
2096         set bar [list $file $edit $view $help]
2097     } else {
2098         proc ::tk::mac::ShowPreferences {} {doprefs}
2099         proc ::tk::mac::Quit {} {doquit}
2100         lset file end [lreplace [lindex $file end] end-1 end]
2101         set apple {
2102         xx "Apple" cascade {
2103             {mc "About gitk" command about}
2104             {xx "" separator}
2105         }}
2106         set help {
2107         mc "Help" cascade {
2108             {mc "Key bindings" command keys}
2109         }}
2110         set bar [list $apple $file $view $help]
2111     }
2112     makemenu .bar $bar
2113     . configure -menu .bar
2114
2115     if {$use_ttk} {
2116         # cover the non-themed toplevel with a themed frame.
2117         place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2118     }
2119
2120     # the gui has upper and lower half, parts of a paned window.
2121     ${NS}::panedwindow .ctop -orient vertical
2122
2123     # possibly use assumed geometry
2124     if {![info exists geometry(pwsash0)]} {
2125         set geometry(topheight) [expr {15 * $linespc}]
2126         set geometry(topwidth) [expr {80 * $charspc}]
2127         set geometry(botheight) [expr {15 * $linespc}]
2128         set geometry(botwidth) [expr {50 * $charspc}]
2129         set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2130         set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2131     }
2132
2133     # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2134     ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2135     ${NS}::frame .tf.histframe
2136     ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2137     if {!$use_ttk} {
2138         .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2139     }
2140
2141     # create three canvases
2142     set cscroll .tf.histframe.csb
2143     set canv .tf.histframe.pwclist.canv
2144     canvas $canv \
2145         -selectbackground $selectbgcolor \
2146         -background $bgcolor -bd 0 \
2147         -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2148     .tf.histframe.pwclist add $canv
2149     set canv2 .tf.histframe.pwclist.canv2
2150     canvas $canv2 \
2151         -selectbackground $selectbgcolor \
2152         -background $bgcolor -bd 0 -yscrollincr $linespc
2153     .tf.histframe.pwclist add $canv2
2154     set canv3 .tf.histframe.pwclist.canv3
2155     canvas $canv3 \
2156         -selectbackground $selectbgcolor \
2157         -background $bgcolor -bd 0 -yscrollincr $linespc
2158     .tf.histframe.pwclist add $canv3
2159     if {$use_ttk} {
2160         bind .tf.histframe.pwclist <Map> {
2161             bind %W <Map> {}
2162             .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2163             .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2164         }
2165     } else {
2166         eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2167         eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2168     }
2169
2170     # a scroll bar to rule them
2171     ${NS}::scrollbar $cscroll -command {allcanvs yview}
2172     if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2173     pack $cscroll -side right -fill y
2174     bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2175     lappend bglist $canv $canv2 $canv3
2176     pack .tf.histframe.pwclist -fill both -expand 1 -side left
2177
2178     # we have two button bars at bottom of top frame. Bar 1
2179     ${NS}::frame .tf.bar
2180     ${NS}::frame .tf.lbar -height 15
2181
2182     set sha1entry .tf.bar.sha1
2183     set entries $sha1entry
2184     set sha1but .tf.bar.sha1label
2185     button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2186         -command gotocommit -width 8
2187     $sha1but conf -disabledforeground [$sha1but cget -foreground]
2188     pack .tf.bar.sha1label -side left
2189     ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2190     trace add variable sha1string write sha1change
2191     pack $sha1entry -side left -pady 2
2192
2193     set bm_left_data {
2194         #define left_width 16
2195         #define left_height 16
2196         static unsigned char left_bits[] = {
2197         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2198         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2199         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2200     }
2201     set bm_right_data {
2202         #define right_width 16
2203         #define right_height 16
2204         static unsigned char right_bits[] = {
2205         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2206         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2207         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2208     }
2209     image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2210     image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2211     image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2212     image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
2213
2214     ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2215     if {$use_ttk} {
2216         .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2217     } else {
2218         .tf.bar.leftbut configure -image bm-left
2219     }
2220     pack .tf.bar.leftbut -side left -fill y
2221     ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2222     if {$use_ttk} {
2223         .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2224     } else {
2225         .tf.bar.rightbut configure -image bm-right
2226     }
2227     pack .tf.bar.rightbut -side left -fill y
2228
2229     ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2230     set rownumsel {}
2231     ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2232         -relief sunken -anchor e
2233     ${NS}::label .tf.bar.rowlabel2 -text "/"
2234     ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2235         -relief sunken -anchor e
2236     pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2237         -side left
2238     if {!$use_ttk} {
2239         foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2240     }
2241     global selectedline
2242     trace add variable selectedline write selectedline_change
2243
2244     # Status label and progress bar
2245     set statusw .tf.bar.status
2246     ${NS}::label $statusw -width 15 -relief sunken
2247     pack $statusw -side left -padx 5
2248     if {$use_ttk} {
2249         set progresscanv [ttk::progressbar .tf.bar.progress]
2250     } else {
2251         set h [expr {[font metrics uifont -linespace] + 2}]
2252         set progresscanv .tf.bar.progress
2253         canvas $progresscanv -relief sunken -height $h -borderwidth 2
2254         set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
2255         set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2256         set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2257     }
2258     pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2259     set progresscoords {0 0}
2260     set fprogcoord 0
2261     set rprogcoord 0
2262     bind $progresscanv <Configure> adjustprogress
2263     set lastprogupdate [clock clicks -milliseconds]
2264     set progupdatepending 0
2265
2266     # build up the bottom bar of upper window
2267     ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2268
2269     set bm_down_data {
2270         #define down_width 16
2271         #define down_height 16
2272         static unsigned char down_bits[] = {
2273         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2274         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2275         0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
2276         0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
2277     }
2278     image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
2279     ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
2280     .tf.lbar.fnext configure -image bm-down
2281
2282     set bm_up_data {
2283         #define up_width 16
2284         #define up_height 16
2285         static unsigned char up_bits[] = {
2286         0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
2287         0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
2288         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2289         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
2290     }
2291     image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
2292     ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
2293     .tf.lbar.fprev configure -image bm-up
2294
2295     ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2296
2297     pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2298         -side left -fill y
2299     set gdttype [mc "containing:"]
2300     set gm [makedroplist .tf.lbar.gdttype gdttype \
2301                 [mc "containing:"] \
2302                 [mc "touching paths:"] \
2303                 [mc "adding/removing string:"] \
2304                 [mc "changing lines matching:"]]
2305     trace add variable gdttype write gdttype_change
2306     pack .tf.lbar.gdttype -side left -fill y
2307
2308     set findstring {}
2309     set fstring .tf.lbar.findstring
2310     lappend entries $fstring
2311     ${NS}::entry $fstring -width 30 -textvariable findstring
2312     trace add variable findstring write find_change
2313     set findtype [mc "Exact"]
2314     set findtypemenu [makedroplist .tf.lbar.findtype \
2315                           findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2316     trace add variable findtype write findcom_change
2317     set findloc [mc "All fields"]
2318     makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2319         [mc "Comments"] [mc "Author"] [mc "Committer"]
2320     trace add variable findloc write find_change
2321     pack .tf.lbar.findloc -side right
2322     pack .tf.lbar.findtype -side right
2323     pack $fstring -side left -expand 1 -fill x
2324
2325     # Finish putting the upper half of the viewer together
2326     pack .tf.lbar -in .tf -side bottom -fill x
2327     pack .tf.bar -in .tf -side bottom -fill x
2328     pack .tf.histframe -fill both -side top -expand 1
2329     .ctop add .tf
2330     if {!$use_ttk} {
2331         .ctop paneconfigure .tf -height $geometry(topheight)
2332         .ctop paneconfigure .tf -width $geometry(topwidth)
2333     }
2334
2335     # now build up the bottom
2336     ${NS}::panedwindow .pwbottom -orient horizontal
2337
2338     # lower left, a text box over search bar, scroll bar to the right
2339     # if we know window height, then that will set the lower text height, otherwise
2340     # we set lower text height which will drive window height
2341     if {[info exists geometry(main)]} {
2342         ${NS}::frame .bleft -width $geometry(botwidth)
2343     } else {
2344         ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2345     }
2346     ${NS}::frame .bleft.top
2347     ${NS}::frame .bleft.mid
2348     ${NS}::frame .bleft.bottom
2349
2350     ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2351     pack .bleft.top.search -side left -padx 5
2352     set sstring .bleft.top.sstring
2353     set searchstring ""
2354     ${NS}::entry $sstring -width 20 -textvariable searchstring
2355     lappend entries $sstring
2356     trace add variable searchstring write incrsearch
2357     pack $sstring -side left -expand 1 -fill x
2358     ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2359         -command changediffdisp -variable diffelide -value {0 0}
2360     ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2361         -command changediffdisp -variable diffelide -value {0 1}
2362     ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2363         -command changediffdisp -variable diffelide -value {1 0}
2364     ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2365     pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
2366     spinbox .bleft.mid.diffcontext -width 5 \
2367         -from 0 -increment 1 -to 10000000 \
2368         -validate all -validatecommand "diffcontextvalidate %P" \
2369         -textvariable diffcontextstring
2370     .bleft.mid.diffcontext set $diffcontext
2371     trace add variable diffcontextstring write diffcontextchange
2372     lappend entries .bleft.mid.diffcontext
2373     pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
2374     ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2375         -command changeignorespace -variable ignorespace
2376     pack .bleft.mid.ignspace -side left -padx 5
2377
2378     set worddiff [mc "Line diff"]
2379     if {[package vcompare $git_version "1.7.2"] >= 0} {
2380         makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2381             [mc "Markup words"] [mc "Color words"]
2382         trace add variable worddiff write changeworddiff
2383         pack .bleft.mid.worddiff -side left -padx 5
2384     }
2385
2386     set ctext .bleft.bottom.ctext
2387     text $ctext -background $bgcolor -foreground $fgcolor \
2388         -state disabled -font textfont \
2389         -yscrollcommand scrolltext -wrap none \
2390         -xscrollcommand ".bleft.bottom.sbhorizontal set"
2391     if {$have_tk85} {
2392         $ctext conf -tabstyle wordprocessor
2393     }
2394     ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2395     ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2396     pack .bleft.top -side top -fill x
2397     pack .bleft.mid -side top -fill x
2398     grid $ctext .bleft.bottom.sb -sticky nsew
2399     grid .bleft.bottom.sbhorizontal -sticky ew
2400     grid columnconfigure .bleft.bottom 0 -weight 1
2401     grid rowconfigure .bleft.bottom 0 -weight 1
2402     grid rowconfigure .bleft.bottom 1 -weight 0
2403     pack .bleft.bottom -side top -fill both -expand 1
2404     lappend bglist $ctext
2405     lappend fglist $ctext
2406
2407     $ctext tag conf comment -wrap $wrapcomment
2408     $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
2409     $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2410     $ctext tag conf d0 -fore [lindex $diffcolors 0]
2411     $ctext tag conf dresult -fore [lindex $diffcolors 1]
2412     $ctext tag conf m0 -fore [lindex $mergecolors 0]
2413     $ctext tag conf m1 -fore [lindex $mergecolors 1]
2414     $ctext tag conf m2 -fore [lindex $mergecolors 2]
2415     $ctext tag conf m3 -fore [lindex $mergecolors 3]
2416     $ctext tag conf m4 -fore [lindex $mergecolors 4]
2417     $ctext tag conf m5 -fore [lindex $mergecolors 5]
2418     $ctext tag conf m6 -fore [lindex $mergecolors 6]
2419     $ctext tag conf m7 -fore [lindex $mergecolors 7]
2420     $ctext tag conf m8 -fore [lindex $mergecolors 8]
2421     $ctext tag conf m9 -fore [lindex $mergecolors 9]
2422     $ctext tag conf m10 -fore [lindex $mergecolors 10]
2423     $ctext tag conf m11 -fore [lindex $mergecolors 11]
2424     $ctext tag conf m12 -fore [lindex $mergecolors 12]
2425     $ctext tag conf m13 -fore [lindex $mergecolors 13]
2426     $ctext tag conf m14 -fore [lindex $mergecolors 14]
2427     $ctext tag conf m15 -fore [lindex $mergecolors 15]
2428     $ctext tag conf mmax -fore darkgrey
2429     set mergemax 16
2430     $ctext tag conf mresult -font textfontbold
2431     $ctext tag conf msep -font textfontbold
2432     $ctext tag conf found -back $foundbgcolor
2433     $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
2434     $ctext tag conf wwrap -wrap word -lmargin2 1c
2435     $ctext tag conf bold -font textfontbold
2436
2437     .pwbottom add .bleft
2438     if {!$use_ttk} {
2439         .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2440     }
2441
2442     # lower right
2443     ${NS}::frame .bright
2444     ${NS}::frame .bright.mode
2445     ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2446         -command reselectline -variable cmitmode -value "patch"
2447     ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2448         -command reselectline -variable cmitmode -value "tree"
2449     grid .bright.mode.patch .bright.mode.tree -sticky ew
2450     pack .bright.mode -side top -fill x
2451     set cflist .bright.cfiles
2452     set indent [font measure mainfont "nn"]
2453     text $cflist \
2454         -selectbackground $selectbgcolor \
2455         -background $bgcolor -foreground $fgcolor \
2456         -font mainfont \
2457         -tabs [list $indent [expr {2 * $indent}]] \
2458         -yscrollcommand ".bright.sb set" \
2459         -cursor [. cget -cursor] \
2460         -spacing1 1 -spacing3 1
2461     lappend bglist $cflist
2462     lappend fglist $cflist
2463     ${NS}::scrollbar .bright.sb -command "$cflist yview"
2464     pack .bright.sb -side right -fill y
2465     pack $cflist -side left -fill both -expand 1
2466     $cflist tag configure highlight \
2467         -background [$cflist cget -selectbackground]
2468     $cflist tag configure bold -font mainfontbold
2469
2470     .pwbottom add .bright
2471     .ctop add .pwbottom
2472
2473     # restore window width & height if known
2474     if {[info exists geometry(main)]} {
2475         if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2476             if {$w > [winfo screenwidth .]} {
2477                 set w [winfo screenwidth .]
2478             }
2479             if {$h > [winfo screenheight .]} {
2480                 set h [winfo screenheight .]
2481             }
2482             wm geometry . "${w}x$h"
2483         }
2484     }
2485
2486     if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2487         wm state . $geometry(state)
2488     }
2489
2490     if {[tk windowingsystem] eq {aqua}} {
2491         set M1B M1
2492         set ::BM "3"
2493     } else {
2494         set M1B Control
2495         set ::BM "2"
2496     }
2497
2498     if {$use_ttk} {
2499         bind .ctop <Map> {
2500             bind %W <Map> {}
2501             %W sashpos 0 $::geometry(topheight)
2502         }
2503         bind .pwbottom <Map> {
2504             bind %W <Map> {}
2505             %W sashpos 0 $::geometry(botwidth)
2506         }
2507     }
2508
2509     bind .pwbottom <Configure> {resizecdetpanes %W %w}
2510     pack .ctop -fill both -expand 1
2511     bindall <1> {selcanvline %W %x %y}
2512     #bindall <B1-Motion> {selcanvline %W %x %y}
2513     if {[tk windowingsystem] == "win32"} {
2514         bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2515         bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2516     } else {
2517         bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2518         bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2519         if {[tk windowingsystem] eq "aqua"} {
2520             bindall <MouseWheel> {
2521                 set delta [expr {- (%D)}]
2522                 allcanvs yview scroll $delta units
2523             }
2524             bindall <Shift-MouseWheel> {
2525                 set delta [expr {- (%D)}]
2526                 $canv xview scroll $delta units
2527             }
2528         }
2529     }
2530     bindall <$::BM> "canvscan mark %W %x %y"
2531     bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2532     bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2533     bind . <$M1B-Key-w> doquit
2534     bindkey <Home> selfirstline
2535     bindkey <End> sellastline
2536     bind . <Key-Up> "selnextline -1"
2537     bind . <Key-Down> "selnextline 1"
2538     bind . <Shift-Key-Up> "dofind -1 0"
2539     bind . <Shift-Key-Down> "dofind 1 0"
2540     bindkey <Key-Right> "goforw"
2541     bindkey <Key-Left> "goback"
2542     bind . <Key-Prior> "selnextpage -1"
2543     bind . <Key-Next> "selnextpage 1"
2544     bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2545     bind . <$M1B-End> "allcanvs yview moveto 1.0"
2546     bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2547     bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2548     bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2549     bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2550     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2551     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2552     bindkey <Key-space> "$ctext yview scroll 1 pages"
2553     bindkey p "selnextline -1"
2554     bindkey n "selnextline 1"
2555     bindkey z "goback"
2556     bindkey x "goforw"
2557     bindkey k "selnextline -1"
2558     bindkey j "selnextline 1"
2559     bindkey h "goback"
2560     bindkey l "goforw"
2561     bindkey b prevfile
2562     bindkey d "$ctext yview scroll 18 units"
2563     bindkey u "$ctext yview scroll -18 units"
2564     bindkey / {focus $fstring}
2565     bindkey <Key-KP_Divide> {focus $fstring}
2566     bindkey <Key-Return> {dofind 1 1}
2567     bindkey ? {dofind -1 1}
2568     bindkey f nextfile
2569     bind . <F5> updatecommits
2570     bindmodfunctionkey Shift 5 reloadcommits
2571     bind . <F2> showrefs
2572     bindmodfunctionkey Shift 4 {newview 0}
2573     bind . <F4> edit_or_newview
2574     bind . <$M1B-q> doquit
2575     bind . <$M1B-f> {dofind 1 1}
2576     bind . <$M1B-g> {dofind 1 0}
2577     bind . <$M1B-r> dosearchback
2578     bind . <$M1B-s> dosearch
2579     bind . <$M1B-equal> {incrfont 1}
2580     bind . <$M1B-plus> {incrfont 1}
2581     bind . <$M1B-KP_Add> {incrfont 1}
2582     bind . <$M1B-minus> {incrfont -1}
2583     bind . <$M1B-KP_Subtract> {incrfont -1}
2584     wm protocol . WM_DELETE_WINDOW doquit
2585     bind . <Destroy> {stop_backends}
2586     bind . <Button-1> "click %W"
2587     bind $fstring <Key-Return> {dofind 1 1}
2588     bind $sha1entry <Key-Return> {gotocommit; break}
2589     bind $sha1entry <<PasteSelection>> clearsha1
2590     bind $sha1entry <<Paste>> clearsha1
2591     bind $cflist <1> {sel_flist %W %x %y; break}
2592     bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2593     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2594     global ctxbut
2595     bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2596     bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2597     bind $ctext <Button-1> {focus %W}
2598     bind $ctext <<Selection>> rehighlight_search_results
2599     for {set i 1} {$i < 10} {incr i} {
2600         bind . <$M1B-Key-$i> [list go_to_parent $i]
2601     }
2602
2603     set maincursor [. cget -cursor]
2604     set textcursor [$ctext cget -cursor]
2605     set curtextcursor $textcursor
2606
2607     set rowctxmenu .rowctxmenu
2608     makemenu $rowctxmenu {
2609         {mc "Diff this -> selected" command {diffvssel 0}}
2610         {mc "Diff selected -> this" command {diffvssel 1}}
2611         {mc "Make patch" command mkpatch}
2612         {mc "Create tag" command mktag}
2613         {mc "Write commit to file" command writecommit}
2614         {mc "Create new branch" command mkbranch}
2615         {mc "Cherry-pick this commit" command cherrypick}
2616         {mc "Reset HEAD branch to here" command resethead}
2617         {mc "Mark this commit" command markhere}
2618         {mc "Return to mark" command gotomark}
2619         {mc "Find descendant of this and mark" command find_common_desc}
2620         {mc "Compare with marked commit" command compare_commits}
2621         {mc "Diff this -> marked commit" command {diffvsmark 0}}
2622         {mc "Diff marked commit -> this" command {diffvsmark 1}}
2623         {mc "Revert this commit" command revert}
2624     }
2625     $rowctxmenu configure -tearoff 0
2626
2627     set fakerowmenu .fakerowmenu
2628     makemenu $fakerowmenu {
2629         {mc "Diff this -> selected" command {diffvssel 0}}
2630         {mc "Diff selected -> this" command {diffvssel 1}}
2631         {mc "Make patch" command mkpatch}
2632         {mc "Diff this -> marked commit" command {diffvsmark 0}}
2633         {mc "Diff marked commit -> this" command {diffvsmark 1}}
2634     }
2635     $fakerowmenu configure -tearoff 0
2636
2637     set headctxmenu .headctxmenu
2638     makemenu $headctxmenu {
2639         {mc "Check out this branch" command cobranch}
2640         {mc "Remove this branch" command rmbranch}
2641     }
2642     $headctxmenu configure -tearoff 0
2643
2644     global flist_menu
2645     set flist_menu .flistctxmenu
2646     makemenu $flist_menu {
2647         {mc "Highlight this too" command {flist_hl 0}}
2648         {mc "Highlight this only" command {flist_hl 1}}
2649         {mc "External diff" command {external_diff}}
2650         {mc "Blame parent commit" command {external_blame 1}}
2651     }
2652     $flist_menu configure -tearoff 0
2653
2654     global diff_menu
2655     set diff_menu .diffctxmenu
2656     makemenu $diff_menu {
2657         {mc "Show origin of this line" command show_line_source}
2658         {mc "Run git gui blame on this line" command {external_blame_diff}}
2659     }
2660     $diff_menu configure -tearoff 0
2661 }
2662
2663 # Windows sends all mouse wheel events to the current focused window, not
2664 # the one where the mouse hovers, so bind those events here and redirect
2665 # to the correct window
2666 proc windows_mousewheel_redirector {W X Y D} {
2667     global canv canv2 canv3
2668     set w [winfo containing -displayof $W $X $Y]
2669     if {$w ne ""} {
2670         set u [expr {$D < 0 ? 5 : -5}]
2671         if {$w == $canv || $w == $canv2 || $w == $canv3} {
2672             allcanvs yview scroll $u units
2673         } else {
2674             catch {
2675                 $w yview scroll $u units
2676             }
2677         }
2678     }
2679 }
2680
2681 # Update row number label when selectedline changes
2682 proc selectedline_change {n1 n2 op} {
2683     global selectedline rownumsel
2684
2685     if {$selectedline eq {}} {
2686         set rownumsel {}
2687     } else {
2688         set rownumsel [expr {$selectedline + 1}]
2689     }
2690 }
2691
2692 # mouse-2 makes all windows scan vertically, but only the one
2693 # the cursor is in scans horizontally
2694 proc canvscan {op w x y} {
2695     global canv canv2 canv3
2696     foreach c [list $canv $canv2 $canv3] {
2697         if {$c == $w} {
2698             $c scan $op $x $y
2699         } else {
2700             $c scan $op 0 $y
2701         }
2702     }
2703 }
2704
2705 proc scrollcanv {cscroll f0 f1} {
2706     $cscroll set $f0 $f1
2707     drawvisible
2708     flushhighlights
2709 }
2710
2711 # when we make a key binding for the toplevel, make sure
2712 # it doesn't get triggered when that key is pressed in the
2713 # find string entry widget.
2714 proc bindkey {ev script} {
2715     global entries
2716     bind . $ev $script
2717     set escript [bind Entry $ev]
2718     if {$escript == {}} {
2719         set escript [bind Entry <Key>]
2720     }
2721     foreach e $entries {
2722         bind $e $ev "$escript; break"
2723     }
2724 }
2725
2726 proc bindmodfunctionkey {mod n script} {
2727     bind . <$mod-F$n> $script
2728     catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2729 }
2730
2731 # set the focus back to the toplevel for any click outside
2732 # the entry widgets
2733 proc click {w} {
2734     global ctext entries
2735     foreach e [concat $entries $ctext] {
2736         if {$w == $e} return
2737     }
2738     focus .
2739 }
2740
2741 # Adjust the progress bar for a change in requested extent or canvas size
2742 proc adjustprogress {} {
2743     global progresscanv progressitem progresscoords
2744     global fprogitem fprogcoord lastprogupdate progupdatepending
2745     global rprogitem rprogcoord use_ttk
2746
2747     if {$use_ttk} {
2748         $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2749         return
2750     }
2751
2752     set w [expr {[winfo width $progresscanv] - 4}]
2753     set x0 [expr {$w * [lindex $progresscoords 0]}]
2754     set x1 [expr {$w * [lindex $progresscoords 1]}]
2755     set h [winfo height $progresscanv]
2756     $progresscanv coords $progressitem $x0 0 $x1 $h
2757     $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2758     $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2759     set now [clock clicks -milliseconds]
2760     if {$now >= $lastprogupdate + 100} {
2761         set progupdatepending 0
2762         update
2763     } elseif {!$progupdatepending} {
2764         set progupdatepending 1
2765         after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2766     }
2767 }
2768
2769 proc doprogupdate {} {
2770     global lastprogupdate progupdatepending
2771
2772     if {$progupdatepending} {
2773         set progupdatepending 0
2774         set lastprogupdate [clock clicks -milliseconds]
2775         update
2776     }
2777 }
2778
2779 proc savestuff {w} {
2780     global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2781     global use_ttk
2782     global stuffsaved
2783     global config_file config_file_tmp
2784     global config_variables
2785
2786     if {$stuffsaved} return
2787     if {![winfo viewable .]} return
2788     catch {
2789         if {[file exists $config_file_tmp]} {
2790             file delete -force $config_file_tmp
2791         }
2792         set f [open $config_file_tmp w]
2793         if {$::tcl_platform(platform) eq {windows}} {
2794             file attributes $config_file_tmp -hidden true
2795         }
2796         foreach var_name $config_variables {
2797             upvar #0 $var_name var
2798             puts $f [list set $var_name $var]
2799         }
2800
2801         puts $f "set geometry(main) [wm geometry .]"
2802         puts $f "set geometry(state) [wm state .]"
2803         puts $f "set geometry(topwidth) [winfo width .tf]"
2804         puts $f "set geometry(topheight) [winfo height .tf]"
2805         if {$use_ttk} {
2806             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2807             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2808         } else {
2809             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2810             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2811         }
2812         puts $f "set geometry(botwidth) [winfo width .bleft]"
2813         puts $f "set geometry(botheight) [winfo height .bleft]"
2814
2815         puts -nonewline $f "set permviews {"
2816         for {set v 0} {$v < $nextviewnum} {incr v} {
2817             if {$viewperm($v)} {
2818                 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2819             }
2820         }
2821         puts $f "}"
2822         close $f
2823         file rename -force $config_file_tmp $config_file
2824     }
2825     set stuffsaved 1
2826 }
2827
2828 proc resizeclistpanes {win w} {
2829     global oldwidth use_ttk
2830     if {[info exists oldwidth($win)]} {
2831         if {$use_ttk} {
2832             set s0 [$win sashpos 0]
2833             set s1 [$win sashpos 1]
2834         } else {
2835             set s0 [$win sash coord 0]
2836             set s1 [$win sash coord 1]
2837         }
2838         if {$w < 60} {
2839             set sash0 [expr {int($w/2 - 2)}]
2840             set sash1 [expr {int($w*5/6 - 2)}]
2841         } else {
2842             set factor [expr {1.0 * $w / $oldwidth($win)}]
2843             set sash0 [expr {int($factor * [lindex $s0 0])}]
2844             set sash1 [expr {int($factor * [lindex $s1 0])}]
2845             if {$sash0 < 30} {
2846                 set sash0 30
2847             }
2848             if {$sash1 < $sash0 + 20} {
2849                 set sash1 [expr {$sash0 + 20}]
2850             }
2851             if {$sash1 > $w - 10} {
2852                 set sash1 [expr {$w - 10}]
2853                 if {$sash0 > $sash1 - 20} {
2854                     set sash0 [expr {$sash1 - 20}]
2855                 }
2856             }
2857         }
2858         if {$use_ttk} {
2859             $win sashpos 0 $sash0
2860             $win sashpos 1 $sash1
2861         } else {
2862             $win sash place 0 $sash0 [lindex $s0 1]
2863             $win sash place 1 $sash1 [lindex $s1 1]
2864         }
2865     }
2866     set oldwidth($win) $w
2867 }
2868
2869 proc resizecdetpanes {win w} {
2870     global oldwidth use_ttk
2871     if {[info exists oldwidth($win)]} {
2872         if {$use_ttk} {
2873             set s0 [$win sashpos 0]
2874         } else {
2875             set s0 [$win sash coord 0]
2876         }
2877         if {$w < 60} {
2878             set sash0 [expr {int($w*3/4 - 2)}]
2879         } else {
2880             set factor [expr {1.0 * $w / $oldwidth($win)}]
2881             set sash0 [expr {int($factor * [lindex $s0 0])}]
2882             if {$sash0 < 45} {
2883                 set sash0 45
2884             }
2885             if {$sash0 > $w - 15} {
2886                 set sash0 [expr {$w - 15}]
2887             }
2888         }
2889         if {$use_ttk} {
2890             $win sashpos 0 $sash0
2891         } else {
2892             $win sash place 0 $sash0 [lindex $s0 1]
2893         }
2894     }
2895     set oldwidth($win) $w
2896 }
2897
2898 proc allcanvs args {
2899     global canv canv2 canv3
2900     eval $canv $args
2901     eval $canv2 $args
2902     eval $canv3 $args
2903 }
2904
2905 proc bindall {event action} {
2906     global canv canv2 canv3
2907     bind $canv $event $action
2908     bind $canv2 $event $action
2909     bind $canv3 $event $action
2910 }
2911
2912 proc about {} {
2913     global uifont NS
2914     set w .about
2915     if {[winfo exists $w]} {
2916         raise $w
2917         return
2918     }
2919     ttk_toplevel $w
2920     wm title $w [mc "About gitk"]
2921     make_transient $w .
2922     message $w.m -text [mc "
2923 Gitk - a commit viewer for git
2924
2925 Copyright \u00a9 2005-2014 Paul Mackerras
2926
2927 Use and redistribute under the terms of the GNU General Public License"] \
2928             -justify center -aspect 400 -border 2 -bg white -relief groove
2929     pack $w.m -side top -fill x -padx 2 -pady 2
2930     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2931     pack $w.ok -side bottom
2932     bind $w <Visibility> "focus $w.ok"
2933     bind $w <Key-Escape> "destroy $w"
2934     bind $w <Key-Return> "destroy $w"
2935     tk::PlaceWindow $w widget .
2936 }
2937
2938 proc keys {} {
2939     global NS
2940     set w .keys
2941     if {[winfo exists $w]} {
2942         raise $w
2943         return
2944     }
2945     if {[tk windowingsystem] eq {aqua}} {
2946         set M1T Cmd
2947     } else {
2948         set M1T Ctrl
2949     }
2950     ttk_toplevel $w
2951     wm title $w [mc "Gitk key bindings"]
2952     make_transient $w .
2953     message $w.m -text "
2954 [mc "Gitk key bindings:"]
2955
2956 [mc "<%s-Q>             Quit" $M1T]
2957 [mc "<%s-W>             Close window" $M1T]
2958 [mc "<Home>             Move to first commit"]
2959 [mc "<End>              Move to last commit"]
2960 [mc "<Up>, p, k Move up one commit"]
2961 [mc "<Down>, n, j       Move down one commit"]
2962 [mc "<Left>, z, h       Go back in history list"]
2963 [mc "<Right>, x, l      Go forward in history list"]
2964 [mc "<%s-n>     Go to n-th parent of current commit in history list" $M1T]
2965 [mc "<PageUp>   Move up one page in commit list"]
2966 [mc "<PageDown> Move down one page in commit list"]
2967 [mc "<%s-Home>  Scroll to top of commit list" $M1T]
2968 [mc "<%s-End>   Scroll to bottom of commit list" $M1T]
2969 [mc "<%s-Up>    Scroll commit list up one line" $M1T]
2970 [mc "<%s-Down>  Scroll commit list down one line" $M1T]
2971 [mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
2972 [mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
2973 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2974 [mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
2975 [mc "<Delete>, b        Scroll diff view up one page"]
2976 [mc "<Backspace>        Scroll diff view up one page"]
2977 [mc "<Space>            Scroll diff view down one page"]
2978 [mc "u          Scroll diff view up 18 lines"]
2979 [mc "d          Scroll diff view down 18 lines"]
2980 [mc "<%s-F>             Find" $M1T]
2981 [mc "<%s-G>             Move to next find hit" $M1T]
2982 [mc "<Return>   Move to next find hit"]
2983 [mc "/          Focus the search box"]
2984 [mc "?          Move to previous find hit"]
2985 [mc "f          Scroll diff view to next file"]
2986 [mc "<%s-S>             Search for next hit in diff view" $M1T]
2987 [mc "<%s-R>             Search for previous hit in diff view" $M1T]
2988 [mc "<%s-KP+>   Increase font size" $M1T]
2989 [mc "<%s-plus>  Increase font size" $M1T]
2990 [mc "<%s-KP->   Decrease font size" $M1T]
2991 [mc "<%s-minus> Decrease font size" $M1T]
2992 [mc "<F5>               Update"]
2993 " \
2994             -justify left -bg white -border 2 -relief groove
2995     pack $w.m -side top -fill both -padx 2 -pady 2
2996     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2997     bind $w <Key-Escape> [list destroy $w]
2998     pack $w.ok -side bottom
2999     bind $w <Visibility> "focus $w.ok"
3000     bind $w <Key-Escape> "destroy $w"
3001     bind $w <Key-Return> "destroy $w"
3002 }
3003
3004 # Procedures for manipulating the file list window at the
3005 # bottom right of the overall window.
3006
3007 proc treeview {w l openlevs} {
3008     global treecontents treediropen treeheight treeparent treeindex
3009
3010     set ix 0
3011     set treeindex() 0
3012     set lev 0
3013     set prefix {}
3014     set prefixend -1
3015     set prefendstack {}
3016     set htstack {}
3017     set ht 0
3018     set treecontents() {}
3019     $w conf -state normal
3020     foreach f $l {
3021         while {[string range $f 0 $prefixend] ne $prefix} {
3022             if {$lev <= $openlevs} {
3023                 $w mark set e:$treeindex($prefix) "end -1c"
3024                 $w mark gravity e:$treeindex($prefix) left
3025             }
3026             set treeheight($prefix) $ht
3027             incr ht [lindex $htstack end]
3028             set htstack [lreplace $htstack end end]
3029             set prefixend [lindex $prefendstack end]
3030             set prefendstack [lreplace $prefendstack end end]
3031             set prefix [string range $prefix 0 $prefixend]
3032             incr lev -1
3033         }
3034         set tail [string range $f [expr {$prefixend+1}] end]
3035         while {[set slash [string first "/" $tail]] >= 0} {
3036             lappend htstack $ht
3037             set ht 0
3038             lappend prefendstack $prefixend
3039             incr prefixend [expr {$slash + 1}]
3040             set d [string range $tail 0 $slash]
3041             lappend treecontents($prefix) $d
3042             set oldprefix $prefix
3043             append prefix $d
3044             set treecontents($prefix) {}
3045             set treeindex($prefix) [incr ix]
3046             set treeparent($prefix) $oldprefix
3047             set tail [string range $tail [expr {$slash+1}] end]
3048             if {$lev <= $openlevs} {
3049                 set ht 1
3050                 set treediropen($prefix) [expr {$lev < $openlevs}]
3051                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3052                 $w mark set d:$ix "end -1c"
3053                 $w mark gravity d:$ix left
3054                 set str "\n"
3055                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3056                 $w insert end $str
3057                 $w image create end -align center -image $bm -padx 1 \
3058                     -name a:$ix
3059                 $w insert end $d [highlight_tag $prefix]
3060                 $w mark set s:$ix "end -1c"
3061                 $w mark gravity s:$ix left
3062             }
3063             incr lev
3064         }
3065         if {$tail ne {}} {
3066             if {$lev <= $openlevs} {
3067                 incr ht
3068                 set str "\n"
3069                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3070                 $w insert end $str
3071                 $w insert end $tail [highlight_tag $f]
3072             }
3073             lappend treecontents($prefix) $tail
3074         }
3075     }
3076     while {$htstack ne {}} {
3077         set treeheight($prefix) $ht
3078         incr ht [lindex $htstack end]
3079         set htstack [lreplace $htstack end end]
3080         set prefixend [lindex $prefendstack end]
3081         set prefendstack [lreplace $prefendstack end end]
3082         set prefix [string range $prefix 0 $prefixend]
3083     }
3084     $w conf -state disabled
3085 }
3086
3087 proc linetoelt {l} {
3088     global treeheight treecontents
3089
3090     set y 2
3091     set prefix {}
3092     while {1} {
3093         foreach e $treecontents($prefix) {
3094             if {$y == $l} {
3095                 return "$prefix$e"
3096             }
3097             set n 1
3098             if {[string index $e end] eq "/"} {
3099                 set n $treeheight($prefix$e)
3100                 if {$y + $n > $l} {
3101                     append prefix $e
3102                     incr y
3103                     break
3104                 }
3105             }
3106             incr y $n
3107         }
3108     }
3109 }
3110
3111 proc highlight_tree {y prefix} {
3112     global treeheight treecontents cflist
3113
3114     foreach e $treecontents($prefix) {
3115         set path $prefix$e
3116         if {[highlight_tag $path] ne {}} {
3117             $cflist tag add bold $y.0 "$y.0 lineend"
3118         }
3119         incr y
3120         if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3121             set y [highlight_tree $y $path]
3122         }
3123     }
3124     return $y
3125 }
3126
3127 proc treeclosedir {w dir} {
3128     global treediropen treeheight treeparent treeindex
3129
3130     set ix $treeindex($dir)
3131     $w conf -state normal
3132     $w delete s:$ix e:$ix
3133     set treediropen($dir) 0
3134     $w image configure a:$ix -image tri-rt
3135     $w conf -state disabled
3136     set n [expr {1 - $treeheight($dir)}]
3137     while {$dir ne {}} {
3138         incr treeheight($dir) $n
3139         set dir $treeparent($dir)
3140     }
3141 }
3142
3143 proc treeopendir {w dir} {
3144     global treediropen treeheight treeparent treecontents treeindex
3145
3146     set ix $treeindex($dir)
3147     $w conf -state normal
3148     $w image configure a:$ix -image tri-dn
3149     $w mark set e:$ix s:$ix
3150     $w mark gravity e:$ix right
3151     set lev 0
3152     set str "\n"
3153     set n [llength $treecontents($dir)]
3154     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3155         incr lev
3156         append str "\t"
3157         incr treeheight($x) $n
3158     }
3159     foreach e $treecontents($dir) {
3160         set de $dir$e
3161         if {[string index $e end] eq "/"} {
3162             set iy $treeindex($de)
3163             $w mark set d:$iy e:$ix
3164             $w mark gravity d:$iy left
3165             $w insert e:$ix $str
3166             set treediropen($de) 0
3167             $w image create e:$ix -align center -image tri-rt -padx 1 \
3168                 -name a:$iy
3169             $w insert e:$ix $e [highlight_tag $de]
3170             $w mark set s:$iy e:$ix
3171             $w mark gravity s:$iy left
3172             set treeheight($de) 1
3173         } else {
3174             $w insert e:$ix $str
3175             $w insert e:$ix $e [highlight_tag $de]
3176         }
3177     }
3178     $w mark gravity e:$ix right
3179     $w conf -state disabled
3180     set treediropen($dir) 1
3181     set top [lindex [split [$w index @0,0] .] 0]
3182     set ht [$w cget -height]
3183     set l [lindex [split [$w index s:$ix] .] 0]
3184     if {$l < $top} {
3185         $w yview $l.0
3186     } elseif {$l + $n + 1 > $top + $ht} {
3187         set top [expr {$l + $n + 2 - $ht}]
3188         if {$l < $top} {
3189             set top $l
3190         }
3191         $w yview $top.0
3192     }
3193 }
3194
3195 proc treeclick {w x y} {
3196     global treediropen cmitmode ctext cflist cflist_top
3197
3198     if {$cmitmode ne "tree"} return
3199     if {![info exists cflist_top]} return
3200     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3201     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3202     $cflist tag add highlight $l.0 "$l.0 lineend"
3203     set cflist_top $l
3204     if {$l == 1} {
3205         $ctext yview 1.0
3206         return
3207     }
3208     set e [linetoelt $l]
3209     if {[string index $e end] ne "/"} {
3210         showfile $e
3211     } elseif {$treediropen($e)} {
3212         treeclosedir $w $e
3213     } else {
3214         treeopendir $w $e
3215     }
3216 }
3217
3218 proc setfilelist {id} {
3219     global treefilelist cflist jump_to_here
3220
3221     treeview $cflist $treefilelist($id) 0
3222     if {$jump_to_here ne {}} {
3223         set f [lindex $jump_to_here 0]
3224         if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3225             showfile $f
3226         }
3227     }
3228 }
3229
3230 image create bitmap tri-rt -background black -foreground blue -data {
3231     #define tri-rt_width 13
3232     #define tri-rt_height 13
3233     static unsigned char tri-rt_bits[] = {
3234        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3235        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3236        0x00, 0x00};
3237 } -maskdata {
3238     #define tri-rt-mask_width 13
3239     #define tri-rt-mask_height 13
3240     static unsigned char tri-rt-mask_bits[] = {
3241        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3242        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3243        0x08, 0x00};
3244 }
3245 image create bitmap tri-dn -background black -foreground blue -data {
3246     #define tri-dn_width 13
3247     #define tri-dn_height 13
3248     static unsigned char tri-dn_bits[] = {
3249        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3250        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3251        0x00, 0x00};
3252 } -maskdata {
3253     #define tri-dn-mask_width 13
3254     #define tri-dn-mask_height 13
3255     static unsigned char tri-dn-mask_bits[] = {
3256        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3257        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3258        0x00, 0x00};
3259 }
3260
3261 image create bitmap reficon-T -background black -foreground yellow -data {
3262     #define tagicon_width 13
3263     #define tagicon_height 9
3264     static unsigned char tagicon_bits[] = {
3265        0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3266        0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3267 } -maskdata {
3268     #define tagicon-mask_width 13
3269     #define tagicon-mask_height 9
3270     static unsigned char tagicon-mask_bits[] = {
3271        0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3272        0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3273 }
3274 set rectdata {
3275     #define headicon_width 13
3276     #define headicon_height 9
3277     static unsigned char headicon_bits[] = {
3278        0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3279        0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3280 }
3281 set rectmask {
3282     #define headicon-mask_width 13
3283     #define headicon-mask_height 9
3284     static unsigned char headicon-mask_bits[] = {
3285        0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3286        0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3287 }
3288 image create bitmap reficon-H -background black -foreground green \
3289     -data $rectdata -maskdata $rectmask
3290 image create bitmap reficon-o -background black -foreground "#ddddff" \
3291     -data $rectdata -maskdata $rectmask
3292
3293 proc init_flist {first} {
3294     global cflist cflist_top difffilestart
3295
3296     $cflist conf -state normal
3297     $cflist delete 0.0 end
3298     if {$first ne {}} {
3299         $cflist insert end $first
3300         set cflist_top 1
3301         $cflist tag add highlight 1.0 "1.0 lineend"
3302     } else {
3303         catch {unset cflist_top}
3304     }
3305     $cflist conf -state disabled
3306     set difffilestart {}
3307 }
3308
3309 proc highlight_tag {f} {
3310     global highlight_paths
3311
3312     foreach p $highlight_paths {
3313         if {[string match $p $f]} {
3314             return "bold"
3315         }
3316     }
3317     return {}
3318 }
3319
3320 proc highlight_filelist {} {
3321     global cmitmode cflist
3322
3323     $cflist conf -state normal
3324     if {$cmitmode ne "tree"} {
3325         set end [lindex [split [$cflist index end] .] 0]
3326         for {set l 2} {$l < $end} {incr l} {
3327             set line [$cflist get $l.0 "$l.0 lineend"]
3328             if {[highlight_tag $line] ne {}} {
3329                 $cflist tag add bold $l.0 "$l.0 lineend"
3330             }
3331         }
3332     } else {
3333         highlight_tree 2 {}
3334     }
3335     $cflist conf -state disabled
3336 }
3337
3338 proc unhighlight_filelist {} {
3339     global cflist
3340
3341     $cflist conf -state normal
3342     $cflist tag remove bold 1.0 end
3343     $cflist conf -state disabled
3344 }
3345
3346 proc add_flist {fl} {
3347     global cflist
3348
3349     $cflist conf -state normal
3350     foreach f $fl {
3351         $cflist insert end "\n"
3352         $cflist insert end $f [highlight_tag $f]
3353     }
3354     $cflist conf -state disabled
3355 }
3356
3357 proc sel_flist {w x y} {
3358     global ctext difffilestart cflist cflist_top cmitmode
3359
3360     if {$cmitmode eq "tree"} return
3361     if {![info exists cflist_top]} return
3362     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3363     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3364     $cflist tag add highlight $l.0 "$l.0 lineend"
3365     set cflist_top $l
3366     if {$l == 1} {
3367         $ctext yview 1.0
3368     } else {
3369         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3370     }
3371     suppress_highlighting_file_for_current_scrollpos
3372 }
3373
3374 proc pop_flist_menu {w X Y x y} {
3375     global ctext cflist cmitmode flist_menu flist_menu_file
3376     global treediffs diffids
3377
3378     stopfinding
3379     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3380     if {$l <= 1} return
3381     if {$cmitmode eq "tree"} {
3382         set e [linetoelt $l]
3383         if {[string index $e end] eq "/"} return
3384     } else {
3385         set e [lindex $treediffs($diffids) [expr {$l-2}]]
3386     }
3387     set flist_menu_file $e
3388     set xdiffstate "normal"
3389     if {$cmitmode eq "tree"} {
3390         set xdiffstate "disabled"
3391     }
3392     # Disable "External diff" item in tree mode
3393     $flist_menu entryconf 2 -state $xdiffstate
3394     tk_popup $flist_menu $X $Y
3395 }
3396
3397 proc find_ctext_fileinfo {line} {
3398     global ctext_file_names ctext_file_lines
3399
3400     set ok [bsearch $ctext_file_lines $line]
3401     set tline [lindex $ctext_file_lines $ok]
3402
3403     if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3404         return {}
3405     } else {
3406         return [list [lindex $ctext_file_names $ok] $tline]
3407     }
3408 }
3409
3410 proc pop_diff_menu {w X Y x y} {
3411     global ctext diff_menu flist_menu_file
3412     global diff_menu_txtpos diff_menu_line
3413     global diff_menu_filebase
3414
3415     set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3416     set diff_menu_line [lindex $diff_menu_txtpos 0]
3417     # don't pop up the menu on hunk-separator or file-separator lines
3418     if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3419         return
3420     }
3421     stopfinding
3422     set f [find_ctext_fileinfo $diff_menu_line]
3423     if {$f eq {}} return
3424     set flist_menu_file [lindex $f 0]
3425     set diff_menu_filebase [lindex $f 1]
3426     tk_popup $diff_menu $X $Y
3427 }
3428
3429 proc flist_hl {only} {
3430     global flist_menu_file findstring gdttype
3431
3432     set x [shellquote $flist_menu_file]
3433     if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3434         set findstring $x
3435     } else {
3436         append findstring " " $x
3437     }
3438     set gdttype [mc "touching paths:"]
3439 }
3440
3441 proc gitknewtmpdir {} {
3442     global diffnum gitktmpdir gitdir env
3443
3444     if {![info exists gitktmpdir]} {
3445         if {[info exists env(GITK_TMPDIR)]} {
3446             set tmpdir $env(GITK_TMPDIR)
3447         } elseif {[info exists env(TMPDIR)]} {
3448             set tmpdir $env(TMPDIR)
3449         } else {
3450             set tmpdir $gitdir
3451         }
3452         set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
3453         if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
3454             set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3455         }
3456         if {[catch {file mkdir $gitktmpdir} err]} {
3457             error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3458             unset gitktmpdir
3459             return {}
3460         }
3461         set diffnum 0
3462     }
3463     incr diffnum
3464     set diffdir [file join $gitktmpdir $diffnum]
3465     if {[catch {file mkdir $diffdir} err]} {
3466         error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3467         return {}
3468     }
3469     return $diffdir
3470 }
3471
3472 proc save_file_from_commit {filename output what} {
3473     global nullfile
3474
3475     if {[catch {exec git show $filename -- > $output} err]} {
3476         if {[string match "fatal: bad revision *" $err]} {
3477             return $nullfile
3478         }
3479         error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3480         return {}
3481     }
3482     return $output
3483 }
3484
3485 proc external_diff_get_one_file {diffid filename diffdir} {
3486     global nullid nullid2 nullfile
3487     global worktree
3488
3489     if {$diffid == $nullid} {
3490         set difffile [file join $worktree $filename]
3491         if {[file exists $difffile]} {
3492             return $difffile
3493         }
3494         return $nullfile
3495     }
3496     if {$diffid == $nullid2} {
3497         set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3498         return [save_file_from_commit :$filename $difffile index]
3499     }
3500     set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3501     return [save_file_from_commit $diffid:$filename $difffile \
3502                "revision $diffid"]
3503 }
3504
3505 proc external_diff {} {
3506     global nullid nullid2
3507     global flist_menu_file
3508     global diffids
3509     global extdifftool
3510
3511     if {[llength $diffids] == 1} {
3512         # no reference commit given
3513         set diffidto [lindex $diffids 0]
3514         if {$diffidto eq $nullid} {
3515             # diffing working copy with index
3516             set diffidfrom $nullid2
3517         } elseif {$diffidto eq $nullid2} {
3518             # diffing index with HEAD
3519             set diffidfrom "HEAD"
3520         } else {
3521             # use first parent commit
3522             global parentlist selectedline
3523             set diffidfrom [lindex $parentlist $selectedline 0]
3524         }
3525     } else {
3526         set diffidfrom [lindex $diffids 0]
3527         set diffidto [lindex $diffids 1]
3528     }
3529
3530     # make sure that several diffs wont collide
3531     set diffdir [gitknewtmpdir]
3532     if {$diffdir eq {}} return
3533
3534     # gather files to diff
3535     set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3536     set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3537
3538     if {$difffromfile ne {} && $difftofile ne {}} {
3539         set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3540         if {[catch {set fl [open |$cmd r]} err]} {
3541             file delete -force $diffdir
3542             error_popup "$extdifftool: [mc "command failed:"] $err"
3543         } else {
3544             fconfigure $fl -blocking 0
3545             filerun $fl [list delete_at_eof $fl $diffdir]
3546         }
3547     }
3548 }
3549
3550 proc find_hunk_blamespec {base line} {
3551     global ctext
3552
3553     # Find and parse the hunk header
3554     set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3555     if {$s_lix eq {}} return
3556
3557     set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3558     if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3559             s_line old_specs osz osz1 new_line nsz]} {
3560         return
3561     }
3562
3563     # base lines for the parents
3564     set base_lines [list $new_line]
3565     foreach old_spec [lrange [split $old_specs " "] 1 end] {
3566         if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3567                 old_spec old_line osz]} {
3568             return
3569         }
3570         lappend base_lines $old_line
3571     }
3572
3573     # Now scan the lines to determine offset within the hunk
3574     set max_parent [expr {[llength $base_lines]-2}]
3575     set dline 0
3576     set s_lno [lindex [split $s_lix "."] 0]
3577
3578     # Determine if the line is removed
3579     set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3580     if {[string match {[-+ ]*} $chunk]} {
3581         set removed_idx [string first "-" $chunk]
3582         # Choose a parent index
3583         if {$removed_idx >= 0} {
3584             set parent $removed_idx
3585         } else {
3586             set unchanged_idx [string first " " $chunk]
3587             if {$unchanged_idx >= 0} {
3588                 set parent $unchanged_idx
3589             } else {
3590                 # blame the current commit
3591                 set parent -1
3592             }
3593         }
3594         # then count other lines that belong to it
3595         for {set i $line} {[incr i -1] > $s_lno} {} {
3596             set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3597             # Determine if the line is removed
3598             set removed_idx [string first "-" $chunk]
3599             if {$parent >= 0} {
3600                 set code [string index $chunk $parent]
3601                 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3602                     incr dline
3603                 }
3604             } else {
3605                 if {$removed_idx < 0} {
3606                     incr dline
3607                 }
3608             }
3609         }
3610         incr parent
3611     } else {
3612         set parent 0
3613     }
3614
3615     incr dline [lindex $base_lines $parent]
3616     return [list $parent $dline]
3617 }
3618
3619 proc external_blame_diff {} {
3620     global currentid cmitmode
3621     global diff_menu_txtpos diff_menu_line
3622     global diff_menu_filebase flist_menu_file
3623
3624     if {$cmitmode eq "tree"} {
3625         set parent_idx 0
3626         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3627     } else {
3628         set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3629         if {$hinfo ne {}} {
3630             set parent_idx [lindex $hinfo 0]
3631             set line [lindex $hinfo 1]
3632         } else {
3633             set parent_idx 0
3634             set line 0
3635         }
3636     }
3637
3638     external_blame $parent_idx $line
3639 }
3640
3641 # Find the SHA1 ID of the blob for file $fname in the index
3642 # at stage 0 or 2
3643 proc index_sha1 {fname} {
3644     set f [open [list | git ls-files -s $fname] r]
3645     while {[gets $f line] >= 0} {
3646         set info [lindex [split $line "\t"] 0]
3647         set stage [lindex $info 2]
3648         if {$stage eq "0" || $stage eq "2"} {
3649             close $f
3650             return [lindex $info 1]
3651         }
3652     }
3653     close $f
3654     return {}
3655 }
3656
3657 # Turn an absolute path into one relative to the current directory
3658 proc make_relative {f} {
3659     if {[file pathtype $f] eq "relative"} {
3660         return $f
3661     }
3662     set elts [file split $f]
3663     set here [file split [pwd]]
3664     set ei 0
3665     set hi 0
3666     set res {}
3667     foreach d $here {
3668         if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3669             lappend res ".."
3670         } else {
3671             incr ei
3672         }
3673         incr hi
3674     }
3675     set elts [concat $res [lrange $elts $ei end]]
3676     return [eval file join $elts]
3677 }
3678
3679 proc external_blame {parent_idx {line {}}} {
3680     global flist_menu_file cdup
3681     global nullid nullid2
3682     global parentlist selectedline currentid
3683
3684     if {$parent_idx > 0} {
3685         set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3686     } else {
3687         set base_commit $currentid
3688     }
3689
3690     if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3691         error_popup [mc "No such commit"]
3692         return
3693     }
3694
3695     set cmdline [list git gui blame]
3696     if {$line ne {} && $line > 1} {
3697         lappend cmdline "--line=$line"
3698     }
3699     set f [file join $cdup $flist_menu_file]
3700     # Unfortunately it seems git gui blame doesn't like
3701     # being given an absolute path...
3702     set f [make_relative $f]
3703     lappend cmdline $base_commit $f
3704     if {[catch {eval exec $cmdline &} err]} {
3705         error_popup "[mc "git gui blame: command failed:"] $err"
3706     }
3707 }
3708
3709 proc show_line_source {} {
3710     global cmitmode currentid parents curview blamestuff blameinst
3711     global diff_menu_line diff_menu_filebase flist_menu_file
3712     global nullid nullid2 gitdir cdup
3713
3714     set from_index {}
3715     if {$cmitmode eq "tree"} {
3716         set id $currentid
3717         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3718     } else {
3719         set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3720         if {$h eq {}} return
3721         set pi [lindex $h 0]
3722         if {$pi == 0} {
3723             mark_ctext_line $diff_menu_line
3724             return
3725         }
3726         incr pi -1
3727         if {$currentid eq $nullid} {
3728             if {$pi > 0} {
3729                 # must be a merge in progress...
3730                 if {[catch {
3731                     # get the last line from .git/MERGE_HEAD
3732                     set f [open [file join $gitdir MERGE_HEAD] r]
3733                     set id [lindex [split [read $f] "\n"] end-1]
3734                     close $f
3735                 } err]} {
3736                     error_popup [mc "Couldn't read merge head: %s" $err]
3737                     return
3738                 }
3739             } elseif {$parents($curview,$currentid) eq $nullid2} {
3740                 # need to do the blame from the index
3741                 if {[catch {
3742                     set from_index [index_sha1 $flist_menu_file]
3743                 } err]} {
3744                     error_popup [mc "Error reading index: %s" $err]
3745                     return
3746                 }
3747             } else {
3748                 set id $parents($curview,$currentid)
3749             }
3750         } else {
3751             set id [lindex $parents($curview,$currentid) $pi]
3752         }
3753         set line [lindex $h 1]
3754     }
3755     set blameargs {}
3756     if {$from_index ne {}} {
3757         lappend blameargs | git cat-file blob $from_index
3758     }
3759     lappend blameargs | git blame -p -L$line,+1
3760     if {$from_index ne {}} {
3761         lappend blameargs --contents -
3762     } else {
3763         lappend blameargs $id
3764     }
3765     lappend blameargs -- [file join $cdup $flist_menu_file]
3766     if {[catch {
3767         set f [open $blameargs r]
3768     } err]} {
3769         error_popup [mc "Couldn't start git blame: %s" $err]
3770         return
3771     }
3772     nowbusy blaming [mc "Searching"]
3773     fconfigure $f -blocking 0
3774     set i [reg_instance $f]
3775     set blamestuff($i) {}
3776     set blameinst $i
3777     filerun $f [list read_line_source $f $i]
3778 }
3779
3780 proc stopblaming {} {
3781     global blameinst
3782
3783     if {[info exists blameinst]} {
3784         stop_instance $blameinst
3785         unset blameinst
3786         notbusy blaming
3787     }
3788 }
3789
3790 proc read_line_source {fd inst} {
3791     global blamestuff curview commfd blameinst nullid nullid2
3792
3793     while {[gets $fd line] >= 0} {
3794         lappend blamestuff($inst) $line
3795     }
3796     if {![eof $fd]} {
3797         return 1
3798     }
3799     unset commfd($inst)
3800     unset blameinst
3801     notbusy blaming
3802     fconfigure $fd -blocking 1
3803     if {[catch {close $fd} err]} {
3804         error_popup [mc "Error running git blame: %s" $err]
3805         return 0
3806     }
3807
3808     set fname {}
3809     set line [split [lindex $blamestuff($inst) 0] " "]
3810     set id [lindex $line 0]
3811     set lnum [lindex $line 1]
3812     if {[string length $id] == 40 && [string is xdigit $id] &&
3813         [string is digit -strict $lnum]} {
3814         # look for "filename" line
3815         foreach l $blamestuff($inst) {
3816             if {[string match "filename *" $l]} {
3817                 set fname [string range $l 9 end]
3818                 break
3819             }
3820         }
3821     }
3822     if {$fname ne {}} {
3823         # all looks good, select it
3824         if {$id eq $nullid} {
3825             # blame uses all-zeroes to mean not committed,
3826             # which would mean a change in the index
3827             set id $nullid2
3828         }
3829         if {[commitinview $id $curview]} {
3830             selectline [rowofcommit $id] 1 [list $fname $lnum] 1
3831         } else {
3832             error_popup [mc "That line comes from commit %s, \
3833                              which is not in this view" [shortids $id]]
3834         }
3835     } else {
3836         puts "oops couldn't parse git blame output"
3837     }
3838     return 0
3839 }
3840
3841 # delete $dir when we see eof on $f (presumably because the child has exited)
3842 proc delete_at_eof {f dir} {
3843     while {[gets $f line] >= 0} {}
3844     if {[eof $f]} {
3845         if {[catch {close $f} err]} {
3846             error_popup "[mc "External diff viewer failed:"] $err"
3847         }
3848         file delete -force $dir
3849         return 0
3850     }
3851     return 1
3852 }
3853
3854 # Functions for adding and removing shell-type quoting
3855
3856 proc shellquote {str} {
3857     if {![string match "*\['\"\\ \t]*" $str]} {
3858         return $str
3859     }
3860     if {![string match "*\['\"\\]*" $str]} {
3861         return "\"$str\""
3862     }
3863     if {![string match "*'*" $str]} {
3864         return "'$str'"
3865     }
3866     return "\"[string map {\" \\\" \\ \\\\} $str]\""
3867 }
3868
3869 proc shellarglist {l} {
3870     set str {}
3871     foreach a $l {
3872         if {$str ne {}} {
3873             append str " "
3874         }
3875         append str [shellquote $a]
3876     }
3877     return $str
3878 }
3879
3880 proc shelldequote {str} {
3881     set ret {}
3882     set used -1
3883     while {1} {
3884         incr used
3885         if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3886             append ret [string range $str $used end]
3887             set used [string length $str]
3888             break
3889         }
3890         set first [lindex $first 0]
3891         set ch [string index $str $first]
3892         if {$first > $used} {
3893             append ret [string range $str $used [expr {$first - 1}]]
3894             set used $first
3895         }
3896         if {$ch eq " " || $ch eq "\t"} break
3897         incr used
3898         if {$ch eq "'"} {
3899             set first [string first "'" $str $used]
3900             if {$first < 0} {
3901                 error "unmatched single-quote"
3902             }
3903             append ret [string range $str $used [expr {$first - 1}]]
3904             set used $first
3905             continue
3906         }
3907         if {$ch eq "\\"} {
3908             if {$used >= [string length $str]} {
3909                 error "trailing backslash"
3910             }
3911             append ret [string index $str $used]
3912             continue
3913         }
3914         # here ch == "\""
3915         while {1} {
3916             if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3917                 error "unmatched double-quote"
3918             }
3919             set first [lindex $first 0]
3920             set ch [string index $str $first]
3921             if {$first > $used} {
3922                 append ret [string range $str $used [expr {$first - 1}]]
3923                 set used $first
3924             }
3925             if {$ch eq "\""} break
3926             incr used
3927             append ret [string index $str $used]
3928             incr used
3929         }
3930     }
3931     return [list $used $ret]
3932 }
3933
3934 proc shellsplit {str} {
3935     set l {}
3936     while {1} {
3937         set str [string trimleft $str]
3938         if {$str eq {}} break
3939         set dq [shelldequote $str]
3940         set n [lindex $dq 0]
3941         set word [lindex $dq 1]
3942         set str [string range $str $n end]
3943         lappend l $word
3944     }
3945     return $l
3946 }
3947
3948 # Code to implement multiple views
3949
3950 proc newview {ishighlight} {
3951     global nextviewnum newviewname newishighlight
3952     global revtreeargs viewargscmd newviewopts curview
3953
3954     set newishighlight $ishighlight
3955     set top .gitkview
3956     if {[winfo exists $top]} {
3957         raise $top
3958         return
3959     }
3960     decode_view_opts $nextviewnum $revtreeargs
3961     set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3962     set newviewopts($nextviewnum,perm) 0
3963     set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
3964     vieweditor $top $nextviewnum [mc "Gitk view definition"]
3965 }
3966
3967 set known_view_options {
3968     {perm      b    .  {}               {mc "Remember this view"}}
3969     {reflabel  l    +  {}               {mc "References (space separated list):"}}
3970     {refs      t15  .. {}               {mc "Branches & tags:"}}
3971     {allrefs   b    *. "--all"          {mc "All refs"}}
3972     {branches  b    .  "--branches"     {mc "All (local) branches"}}
3973     {tags      b    .  "--tags"         {mc "All tags"}}
3974     {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
3975     {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
3976     {author    t15  .. "--author=*"     {mc "Author:"}}
3977     {committer t15  .  "--committer=*"  {mc "Committer:"}}
3978     {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
3979     {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
3980     {changes_l l    +  {}               {mc "Changes to Files:"}}
3981     {pickaxe_s r0   .  {}               {mc "Fixed String"}}
3982     {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
3983     {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
3984     {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
3985     {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
3986     {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
3987     {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
3988     {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
3989     {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
3990     {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
3991     {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
3992     {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
3993     {first     b    .  "--first-parent" {mc "Limit to first parent"}}
3994     {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
3995     {args      t50  *. {}               {mc "Additional arguments to git log:"}}
3996     {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
3997     {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
3998     }
3999
4000 # Convert $newviewopts($n, ...) into args for git log.
4001 proc encode_view_opts {n} {
4002     global known_view_options newviewopts
4003
4004     set rargs [list]
4005     foreach opt $known_view_options {
4006         set patterns [lindex $opt 3]
4007         if {$patterns eq {}} continue
4008         set pattern [lindex $patterns 0]
4009
4010         if {[lindex $opt 1] eq "b"} {
4011             set val $newviewopts($n,[lindex $opt 0])
4012             if {$val} {
4013                 lappend rargs $pattern
4014             }
4015         } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4016             regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4017             set val $newviewopts($n,$button_id)
4018             if {$val eq $value} {
4019                 lappend rargs $pattern
4020             }
4021         } else {
4022             set val $newviewopts($n,[lindex $opt 0])
4023             set val [string trim $val]
4024             if {$val ne {}} {
4025                 set pfix [string range $pattern 0 end-1]
4026                 lappend rargs $pfix$val
4027             }
4028         }
4029     }
4030     set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4031     return [concat $rargs [shellsplit $newviewopts($n,args)]]
4032 }
4033
4034 # Fill $newviewopts($n, ...) based on args for git log.
4035 proc decode_view_opts {n view_args} {
4036     global known_view_options newviewopts
4037
4038     foreach opt $known_view_options {
4039         set id [lindex $opt 0]
4040         if {[lindex $opt 1] eq "b"} {
4041             # Checkboxes
4042             set val 0
4043         } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4044             # Radiobuttons
4045             regexp {^(.*_)} $id uselessvar id
4046             set val 0
4047         } else {
4048             # Text fields
4049             set val {}
4050         }
4051         set newviewopts($n,$id) $val
4052     }
4053     set oargs [list]
4054     set refargs [list]
4055     foreach arg $view_args {
4056         if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4057             && ![info exists found(limit)]} {
4058             set newviewopts($n,limit) $cnt
4059             set found(limit) 1
4060             continue
4061         }
4062         catch { unset val }
4063         foreach opt $known_view_options {
4064             set id [lindex $opt 0]
4065             if {[info exists found($id)]} continue
4066             foreach pattern [lindex $opt 3] {
4067                 if {![string match $pattern $arg]} continue
4068                 if {[lindex $opt 1] eq "b"} {
4069                     # Check buttons
4070                     set val 1
4071                 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4072                     # Radio buttons
4073                     regexp {^(.*_)} $id uselessvar id
4074                     set val $num
4075                 } else {
4076                     # Text input fields
4077                     set size [string length $pattern]
4078                     set val [string range $arg [expr {$size-1}] end]
4079                 }
4080                 set newviewopts($n,$id) $val
4081                 set found($id) 1
4082                 break
4083             }
4084             if {[info exists val]} break
4085         }
4086         if {[info exists val]} continue
4087         if {[regexp {^-} $arg]} {
4088             lappend oargs $arg
4089         } else {
4090             lappend refargs $arg
4091         }
4092     }
4093     set newviewopts($n,refs) [shellarglist $refargs]
4094     set newviewopts($n,args) [shellarglist $oargs]
4095 }
4096
4097 proc edit_or_newview {} {
4098     global curview
4099
4100     if {$curview > 0} {
4101         editview
4102     } else {
4103         newview 0
4104     }
4105 }
4106
4107 proc editview {} {
4108     global curview
4109     global viewname viewperm newviewname newviewopts
4110     global viewargs viewargscmd
4111
4112     set top .gitkvedit-$curview
4113     if {[winfo exists $top]} {
4114         raise $top
4115         return
4116     }
4117     decode_view_opts $curview $viewargs($curview)
4118     set newviewname($curview)      $viewname($curview)
4119     set newviewopts($curview,perm) $viewperm($curview)
4120     set newviewopts($curview,cmd)  $viewargscmd($curview)
4121     vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4122 }
4123
4124 proc vieweditor {top n title} {
4125     global newviewname newviewopts viewfiles bgcolor
4126     global known_view_options NS
4127
4128     ttk_toplevel $top
4129     wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4130     make_transient $top .
4131
4132     # View name
4133     ${NS}::frame $top.nfr
4134     ${NS}::label $top.nl -text [mc "View Name"]
4135     ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4136     pack $top.nfr -in $top -fill x -pady 5 -padx 3
4137     pack $top.nl -in $top.nfr -side left -padx {0 5}
4138     pack $top.name -in $top.nfr -side left -padx {0 25}
4139
4140     # View options
4141     set cframe $top.nfr
4142     set cexpand 0
4143     set cnt 0
4144     foreach opt $known_view_options {
4145         set id [lindex $opt 0]
4146         set type [lindex $opt 1]
4147         set flags [lindex $opt 2]
4148         set title [eval [lindex $opt 4]]
4149         set lxpad 0
4150
4151         if {$flags eq "+" || $flags eq "*"} {
4152             set cframe $top.fr$cnt
4153             incr cnt
4154             ${NS}::frame $cframe
4155             pack $cframe -in $top -fill x -pady 3 -padx 3
4156             set cexpand [expr {$flags eq "*"}]
4157         } elseif {$flags eq ".." || $flags eq "*."} {
4158             set cframe $top.fr$cnt
4159             incr cnt
4160             ${NS}::frame $cframe
4161             pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4162             set cexpand [expr {$flags eq "*."}]
4163         } else {
4164             set lxpad 5
4165         }
4166
4167         if {$type eq "l"} {
4168             ${NS}::label $cframe.l_$id -text $title
4169             pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4170         } elseif {$type eq "b"} {
4171             ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4172             pack $cframe.c_$id -in $cframe -side left \
4173                 -padx [list $lxpad 0] -expand $cexpand -anchor w
4174         } elseif {[regexp {^r(\d+)$} $type type sz]} {
4175             regexp {^(.*_)} $id uselessvar button_id
4176             ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4177             pack $cframe.c_$id -in $cframe -side left \
4178                 -padx [list $lxpad 0] -expand $cexpand -anchor w
4179         } elseif {[regexp {^t(\d+)$} $type type sz]} {
4180             ${NS}::label $cframe.l_$id -text $title
4181             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4182                 -textvariable newviewopts($n,$id)
4183             pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4184             pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4185         } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4186             ${NS}::label $cframe.l_$id -text $title
4187             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4188                 -textvariable newviewopts($n,$id)
4189             pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4190             pack $cframe.e_$id -in $cframe -side top -fill x
4191         } elseif {$type eq "path"} {
4192             ${NS}::label $top.l -text $title
4193             pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4194             text $top.t -width 40 -height 5 -background $bgcolor
4195             if {[info exists viewfiles($n)]} {
4196                 foreach f $viewfiles($n) {
4197                     $top.t insert end $f
4198                     $top.t insert end "\n"
4199                 }
4200                 $top.t delete {end - 1c} end
4201                 $top.t mark set insert 0.0
4202             }
4203             pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4204         }
4205     }
4206
4207     ${NS}::frame $top.buts
4208     ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4209     ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4210     ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4211     bind $top <Control-Return> [list newviewok $top $n]
4212     bind $top <F5> [list newviewok $top $n 1]
4213     bind $top <Escape> [list destroy $top]
4214     grid $top.buts.ok $top.buts.apply $top.buts.can
4215     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4216     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4217     grid columnconfigure $top.buts 2 -weight 1 -uniform a
4218     pack $top.buts -in $top -side top -fill x
4219     focus $top.t
4220 }
4221
4222 proc doviewmenu {m first cmd op argv} {
4223     set nmenu [$m index end]
4224     for {set i $first} {$i <= $nmenu} {incr i} {
4225         if {[$m entrycget $i -command] eq $cmd} {
4226             eval $m $op $i $argv
4227             break
4228         }
4229     }
4230 }
4231
4232 proc allviewmenus {n op args} {
4233     # global viewhlmenu
4234
4235     doviewmenu .bar.view 5 [list showview $n] $op $args
4236     # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4237 }
4238
4239 proc newviewok {top n {apply 0}} {
4240     global nextviewnum newviewperm newviewname newishighlight
4241     global viewname viewfiles viewperm selectedview curview
4242     global viewargs viewargscmd newviewopts viewhlmenu
4243
4244     if {[catch {
4245         set newargs [encode_view_opts $n]
4246     } err]} {
4247         error_popup "[mc "Error in commit selection arguments:"] $err" $top
4248         return
4249     }
4250     set files {}
4251     foreach f [split [$top.t get 0.0 end] "\n"] {
4252         set ft [string trim $f]
4253         if {$ft ne {}} {
4254             lappend files $ft
4255         }
4256     }
4257     if {![info exists viewfiles($n)]} {
4258         # creating a new view
4259         incr nextviewnum
4260         set viewname($n) $newviewname($n)
4261         set viewperm($n) $newviewopts($n,perm)
4262         set viewfiles($n) $files
4263         set viewargs($n) $newargs
4264         set viewargscmd($n) $newviewopts($n,cmd)
4265         addviewmenu $n
4266         if {!$newishighlight} {
4267             run showview $n
4268         } else {
4269             run addvhighlight $n
4270         }
4271     } else {
4272         # editing an existing view
4273         set viewperm($n) $newviewopts($n,perm)
4274         if {$newviewname($n) ne $viewname($n)} {
4275             set viewname($n) $newviewname($n)
4276             doviewmenu .bar.view 5 [list showview $n] \
4277                 entryconf [list -label $viewname($n)]
4278             # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4279                 # entryconf [list -label $viewname($n) -value $viewname($n)]
4280         }
4281         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4282                 $newviewopts($n,cmd) ne $viewargscmd($n)} {
4283             set viewfiles($n) $files
4284             set viewargs($n) $newargs
4285             set viewargscmd($n) $newviewopts($n,cmd)
4286             if {$curview == $n} {
4287                 run reloadcommits
4288             }
4289         }
4290     }
4291     if {$apply} return
4292     catch {destroy $top}
4293 }
4294
4295 proc delview {} {
4296     global curview viewperm hlview selectedhlview
4297
4298     if {$curview == 0} return
4299     if {[info exists hlview] && $hlview == $curview} {
4300         set selectedhlview [mc "None"]
4301         unset hlview
4302     }
4303     allviewmenus $curview delete
4304     set viewperm($curview) 0
4305     showview 0
4306 }
4307
4308 proc addviewmenu {n} {
4309     global viewname viewhlmenu
4310
4311     .bar.view add radiobutton -label $viewname($n) \
4312         -command [list showview $n] -variable selectedview -value $n
4313     #$viewhlmenu add radiobutton -label $viewname($n) \
4314     #   -command [list addvhighlight $n] -variable selectedhlview
4315 }
4316
4317 proc showview {n} {
4318     global curview cached_commitrow ordertok
4319     global displayorder parentlist rowidlist rowisopt rowfinal
4320     global colormap rowtextx nextcolor canvxmax
4321     global numcommits viewcomplete
4322     global selectedline currentid canv canvy0
4323     global treediffs
4324     global pending_select mainheadid
4325     global commitidx
4326     global selectedview
4327     global hlview selectedhlview commitinterest
4328
4329     if {$n == $curview} return
4330     set selid {}
4331     set ymax [lindex [$canv cget -scrollregion] 3]
4332     set span [$canv yview]
4333     set ytop [expr {[lindex $span 0] * $ymax}]
4334     set ybot [expr {[lindex $span 1] * $ymax}]
4335     set yscreen [expr {($ybot - $ytop) / 2}]
4336     if {$selectedline ne {}} {
4337         set selid $currentid
4338         set y [yc $selectedline]
4339         if {$ytop < $y && $y < $ybot} {
4340             set yscreen [expr {$y - $ytop}]
4341         }
4342     } elseif {[info exists pending_select]} {
4343         set selid $pending_select
4344         unset pending_select
4345     }
4346     unselectline
4347     normalline
4348     catch {unset treediffs}
4349     clear_display
4350     if {[info exists hlview] && $hlview == $n} {
4351         unset hlview
4352         set selectedhlview [mc "None"]
4353     }
4354     catch {unset commitinterest}
4355     catch {unset cached_commitrow}
4356     catch {unset ordertok}
4357
4358     set curview $n
4359     set selectedview $n
4360     .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4361     .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4362
4363     run refill_reflist
4364     if {![info exists viewcomplete($n)]} {
4365         getcommits $selid
4366         return
4367     }
4368
4369     set displayorder {}
4370     set parentlist {}
4371     set rowidlist {}
4372     set rowisopt {}
4373     set rowfinal {}
4374     set numcommits $commitidx($n)
4375
4376     catch {unset colormap}
4377     catch {unset rowtextx}
4378     set nextcolor 0
4379     set canvxmax [$canv cget -width]
4380     set curview $n
4381     set row 0
4382     setcanvscroll
4383     set yf 0
4384     set row {}
4385     if {$selid ne {} && [commitinview $selid $n]} {
4386         set row [rowofcommit $selid]
4387         # try to get the selected row in the same position on the screen
4388         set ymax [lindex [$canv cget -scrollregion] 3]
4389         set ytop [expr {[yc $row] - $yscreen}]
4390         if {$ytop < 0} {
4391             set ytop 0
4392         }
4393         set yf [expr {$ytop * 1.0 / $ymax}]
4394     }
4395     allcanvs yview moveto $yf
4396     drawvisible
4397     if {$row ne {}} {
4398         selectline $row 0
4399     } elseif {!$viewcomplete($n)} {
4400         reset_pending_select $selid
4401     } else {
4402         reset_pending_select {}
4403
4404         if {[commitinview $pending_select $curview]} {
4405             selectline [rowofcommit $pending_select] 1
4406         } else {
4407             set row [first_real_row]
4408             if {$row < $numcommits} {
4409                 selectline $row 0
4410             }
4411         }
4412     }
4413     if {!$viewcomplete($n)} {
4414         if {$numcommits == 0} {
4415             show_status [mc "Reading commits..."]
4416         }
4417     } elseif {$numcommits == 0} {
4418         show_status [mc "No commits selected"]
4419     }
4420 }
4421
4422 # Stuff relating to the highlighting facility
4423
4424 proc ishighlighted {id} {
4425     global vhighlights fhighlights nhighlights rhighlights
4426
4427     if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4428         return $nhighlights($id)
4429     }
4430     if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4431         return $vhighlights($id)
4432     }
4433     if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4434         return $fhighlights($id)
4435     }
4436     if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4437         return $rhighlights($id)
4438     }
4439     return 0
4440 }
4441
4442 proc bolden {id font} {
4443     global canv linehtag currentid boldids need_redisplay markedid
4444
4445     # need_redisplay = 1 means the display is stale and about to be redrawn
4446     if {$need_redisplay} return
4447     lappend boldids $id
4448     $canv itemconf $linehtag($id) -font $font
4449     if {[info exists currentid] && $id eq $currentid} {
4450         $canv delete secsel
4451         set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4452                    -outline {{}} -tags secsel \
4453                    -fill [$canv cget -selectbackground]]
4454         $canv lower $t
4455     }
4456     if {[info exists markedid] && $id eq $markedid} {
4457         make_idmark $id
4458     }
4459 }
4460
4461 proc bolden_name {id font} {
4462     global canv2 linentag currentid boldnameids need_redisplay
4463
4464     if {$need_redisplay} return
4465     lappend boldnameids $id
4466     $canv2 itemconf $linentag($id) -font $font
4467     if {[info exists currentid] && $id eq $currentid} {
4468         $canv2 delete secsel
4469         set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4470                    -outline {{}} -tags secsel \
4471                    -fill [$canv2 cget -selectbackground]]
4472         $canv2 lower $t
4473     }
4474 }
4475
4476 proc unbolden {} {
4477     global boldids
4478
4479     set stillbold {}
4480     foreach id $boldids {
4481         if {![ishighlighted $id]} {
4482             bolden $id mainfont
4483         } else {
4484             lappend stillbold $id
4485         }
4486     }
4487     set boldids $stillbold
4488 }
4489
4490 proc addvhighlight {n} {
4491     global hlview viewcomplete curview vhl_done commitidx
4492
4493     if {[info exists hlview]} {
4494         delvhighlight
4495     }
4496     set hlview $n
4497     if {$n != $curview && ![info exists viewcomplete($n)]} {
4498         start_rev_list $n
4499     }
4500     set vhl_done $commitidx($hlview)
4501     if {$vhl_done > 0} {
4502         drawvisible
4503     }
4504 }
4505
4506 proc delvhighlight {} {
4507     global hlview vhighlights
4508
4509     if {![info exists hlview]} return
4510     unset hlview
4511     catch {unset vhighlights}
4512     unbolden
4513 }
4514
4515 proc vhighlightmore {} {
4516     global hlview vhl_done commitidx vhighlights curview
4517
4518     set max $commitidx($hlview)
4519     set vr [visiblerows]
4520     set r0 [lindex $vr 0]
4521     set r1 [lindex $vr 1]
4522     for {set i $vhl_done} {$i < $max} {incr i} {
4523         set id [commitonrow $i $hlview]
4524         if {[commitinview $id $curview]} {
4525             set row [rowofcommit $id]
4526             if {$r0 <= $row && $row <= $r1} {
4527                 if {![highlighted $row]} {
4528                     bolden $id mainfontbold
4529                 }
4530                 set vhighlights($id) 1
4531             }
4532         }
4533     }
4534     set vhl_done $max
4535     return 0
4536 }
4537
4538 proc askvhighlight {row id} {
4539     global hlview vhighlights iddrawn
4540
4541     if {[commitinview $id $hlview]} {
4542         if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4543             bolden $id mainfontbold
4544         }
4545         set vhighlights($id) 1
4546     } else {
4547         set vhighlights($id) 0
4548     }
4549 }
4550
4551 proc hfiles_change {} {
4552     global highlight_files filehighlight fhighlights fh_serial
4553     global highlight_paths
4554
4555     if {[info exists filehighlight]} {
4556         # delete previous highlights
4557         catch {close $filehighlight}
4558         unset filehighlight
4559         catch {unset fhighlights}
4560         unbolden
4561         unhighlight_filelist
4562     }
4563     set highlight_paths {}
4564     after cancel do_file_hl $fh_serial
4565     incr fh_serial
4566     if {$highlight_files ne {}} {
4567         after 300 do_file_hl $fh_serial
4568     }
4569 }
4570
4571 proc gdttype_change {name ix op} {
4572     global gdttype highlight_files findstring findpattern
4573
4574     stopfinding
4575     if {$findstring ne {}} {
4576         if {$gdttype eq [mc "containing:"]} {
4577             if {$highlight_files ne {}} {
4578                 set highlight_files {}
4579                 hfiles_change
4580             }
4581             findcom_change
4582         } else {
4583             if {$findpattern ne {}} {
4584                 set findpattern {}
4585                 findcom_change
4586             }
4587             set highlight_files $findstring
4588             hfiles_change
4589         }
4590         drawvisible
4591     }
4592     # enable/disable findtype/findloc menus too
4593 }
4594
4595 proc find_change {name ix op} {
4596     global gdttype findstring highlight_files
4597
4598     stopfinding
4599     if {$gdttype eq [mc "containing:"]} {
4600         findcom_change
4601     } else {
4602         if {$highlight_files ne $findstring} {
4603             set highlight_files $findstring
4604             hfiles_change
4605         }
4606     }
4607     drawvisible
4608 }
4609
4610 proc findcom_change args {
4611     global nhighlights boldnameids
4612     global findpattern findtype findstring gdttype
4613
4614     stopfinding
4615     # delete previous highlights, if any
4616     foreach id $boldnameids {
4617         bolden_name $id mainfont
4618     }
4619     set boldnameids {}
4620     catch {unset nhighlights}
4621     unbolden
4622     unmarkmatches
4623     if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4624         set findpattern {}
4625     } elseif {$findtype eq [mc "Regexp"]} {
4626         set findpattern $findstring
4627     } else {
4628         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4629                    $findstring]
4630         set findpattern "*$e*"
4631     }
4632 }
4633
4634 proc makepatterns {l} {
4635     set ret {}
4636     foreach e $l {
4637         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4638         if {[string index $ee end] eq "/"} {
4639             lappend ret "$ee*"
4640         } else {
4641             lappend ret $ee
4642             lappend ret "$ee/*"
4643         }
4644     }
4645     return $ret
4646 }
4647
4648 proc do_file_hl {serial} {
4649     global highlight_files filehighlight highlight_paths gdttype fhl_list
4650     global cdup findtype
4651
4652     if {$gdttype eq [mc "touching paths:"]} {
4653         # If "exact" match then convert backslashes to forward slashes.
4654         # Most useful to support Windows-flavoured file paths.
4655         if {$findtype eq [mc "Exact"]} {
4656             set highlight_files [string map {"\\" "/"} $highlight_files]
4657         }
4658         if {[catch {set paths [shellsplit $highlight_files]}]} return
4659         set highlight_paths [makepatterns $paths]
4660         highlight_filelist
4661         set relative_paths {}
4662         foreach path $paths {
4663             lappend relative_paths [file join $cdup $path]
4664         }
4665         set gdtargs [concat -- $relative_paths]
4666     } elseif {$gdttype eq [mc "adding/removing string:"]} {
4667         set gdtargs [list "-S$highlight_files"]
4668     } elseif {$gdttype eq [mc "changing lines matching:"]} {
4669         set gdtargs [list "-G$highlight_files"]
4670     } else {
4671         # must be "containing:", i.e. we're searching commit info
4672         return
4673     }
4674     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4675     set filehighlight [open $cmd r+]
4676     fconfigure $filehighlight -blocking 0
4677     filerun $filehighlight readfhighlight
4678     set fhl_list {}
4679     drawvisible
4680     flushhighlights
4681 }
4682
4683 proc flushhighlights {} {
4684     global filehighlight fhl_list
4685
4686     if {[info exists filehighlight]} {
4687         lappend fhl_list {}
4688         puts $filehighlight ""
4689         flush $filehighlight
4690     }
4691 }
4692
4693 proc askfilehighlight {row id} {
4694     global filehighlight fhighlights fhl_list
4695
4696     lappend fhl_list $id
4697     set fhighlights($id) -1
4698     puts $filehighlight $id
4699 }
4700
4701 proc readfhighlight {} {
4702     global filehighlight fhighlights curview iddrawn
4703     global fhl_list find_dirn
4704
4705     if {![info exists filehighlight]} {
4706         return 0
4707     }
4708     set nr 0
4709     while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4710         set line [string trim $line]
4711         set i [lsearch -exact $fhl_list $line]
4712         if {$i < 0} continue
4713         for {set j 0} {$j < $i} {incr j} {
4714             set id [lindex $fhl_list $j]
4715             set fhighlights($id) 0
4716         }
4717         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4718         if {$line eq {}} continue
4719         if {![commitinview $line $curview]} continue
4720         if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4721             bolden $line mainfontbold
4722         }
4723         set fhighlights($line) 1
4724     }
4725     if {[eof $filehighlight]} {
4726         # strange...
4727         puts "oops, git diff-tree died"
4728         catch {close $filehighlight}
4729         unset filehighlight
4730         return 0
4731     }
4732     if {[info exists find_dirn]} {
4733         run findmore
4734     }
4735     return 1
4736 }
4737
4738 proc doesmatch {f} {
4739     global findtype findpattern
4740
4741     if {$findtype eq [mc "Regexp"]} {
4742         return [regexp $findpattern $f]
4743     } elseif {$findtype eq [mc "IgnCase"]} {
4744         return [string match -nocase $findpattern $f]
4745     } else {
4746         return [string match $findpattern $f]
4747     }
4748 }
4749
4750 proc askfindhighlight {row id} {
4751     global nhighlights commitinfo iddrawn
4752     global findloc
4753     global markingmatches
4754
4755     if {![info exists commitinfo($id)]} {
4756         getcommit $id
4757     }
4758     set info $commitinfo($id)
4759     set isbold 0
4760     set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
4761     foreach f $info ty $fldtypes {
4762         if {$ty eq ""} continue
4763         if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4764             [doesmatch $f]} {
4765             if {$ty eq [mc "Author"]} {
4766                 set isbold 2
4767                 break
4768             }
4769             set isbold 1
4770         }
4771     }
4772     if {$isbold && [info exists iddrawn($id)]} {
4773         if {![ishighlighted $id]} {
4774             bolden $id mainfontbold
4775             if {$isbold > 1} {
4776                 bolden_name $id mainfontbold
4777             }
4778         }
4779         if {$markingmatches} {
4780             markrowmatches $row $id
4781         }
4782     }
4783     set nhighlights($id) $isbold
4784 }
4785
4786 proc markrowmatches {row id} {
4787     global canv canv2 linehtag linentag commitinfo findloc
4788
4789     set headline [lindex $commitinfo($id) 0]
4790     set author [lindex $commitinfo($id) 1]
4791     $canv delete match$row
4792     $canv2 delete match$row
4793     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4794         set m [findmatches $headline]
4795         if {$m ne {}} {
4796             markmatches $canv $row $headline $linehtag($id) $m \
4797                 [$canv itemcget $linehtag($id) -font] $row
4798         }
4799     }
4800     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4801         set m [findmatches $author]
4802         if {$m ne {}} {
4803             markmatches $canv2 $row $author $linentag($id) $m \
4804                 [$canv2 itemcget $linentag($id) -font] $row
4805         }
4806     }
4807 }
4808
4809 proc vrel_change {name ix op} {
4810     global highlight_related
4811
4812     rhighlight_none
4813     if {$highlight_related ne [mc "None"]} {
4814         run drawvisible
4815     }
4816 }
4817
4818 # prepare for testing whether commits are descendents or ancestors of a
4819 proc rhighlight_sel {a} {
4820     global descendent desc_todo ancestor anc_todo
4821     global highlight_related
4822
4823     catch {unset descendent}
4824     set desc_todo [list $a]
4825     catch {unset ancestor}
4826     set anc_todo [list $a]
4827     if {$highlight_related ne [mc "None"]} {
4828         rhighlight_none
4829         run drawvisible
4830     }
4831 }
4832
4833 proc rhighlight_none {} {
4834     global rhighlights
4835
4836     catch {unset rhighlights}
4837     unbolden
4838 }
4839
4840 proc is_descendent {a} {
4841     global curview children descendent desc_todo
4842
4843     set v $curview
4844     set la [rowofcommit $a]
4845     set todo $desc_todo
4846     set leftover {}
4847     set done 0
4848     for {set i 0} {$i < [llength $todo]} {incr i} {
4849         set do [lindex $todo $i]
4850         if {[rowofcommit $do] < $la} {
4851             lappend leftover $do
4852             continue
4853         }
4854         foreach nk $children($v,$do) {
4855             if {![info exists descendent($nk)]} {
4856                 set descendent($nk) 1
4857                 lappend todo $nk
4858                 if {$nk eq $a} {
4859                     set done 1
4860                 }
4861             }
4862         }
4863         if {$done} {
4864             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4865             return
4866         }
4867     }
4868     set descendent($a) 0
4869     set desc_todo $leftover
4870 }
4871
4872 proc is_ancestor {a} {
4873     global curview parents ancestor anc_todo
4874
4875     set v $curview
4876     set la [rowofcommit $a]
4877     set todo $anc_todo
4878     set leftover {}
4879     set done 0
4880     for {set i 0} {$i < [llength $todo]} {incr i} {
4881         set do [lindex $todo $i]
4882         if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4883             lappend leftover $do
4884             continue
4885         }
4886         foreach np $parents($v,$do) {
4887             if {![info exists ancestor($np)]} {
4888                 set ancestor($np) 1
4889                 lappend todo $np
4890                 if {$np eq $a} {
4891                     set done 1
4892                 }
4893             }
4894         }
4895         if {$done} {
4896             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4897             return
4898         }
4899     }
4900     set ancestor($a) 0
4901     set anc_todo $leftover
4902 }
4903
4904 proc askrelhighlight {row id} {
4905     global descendent highlight_related iddrawn rhighlights
4906     global selectedline ancestor
4907
4908     if {$selectedline eq {}} return
4909     set isbold 0
4910     if {$highlight_related eq [mc "Descendant"] ||
4911         $highlight_related eq [mc "Not descendant"]} {
4912         if {![info exists descendent($id)]} {
4913             is_descendent $id
4914         }
4915         if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4916             set isbold 1
4917         }
4918     } elseif {$highlight_related eq [mc "Ancestor"] ||
4919               $highlight_related eq [mc "Not ancestor"]} {
4920         if {![info exists ancestor($id)]} {
4921             is_ancestor $id
4922         }
4923         if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4924             set isbold 1
4925         }
4926     }
4927     if {[info exists iddrawn($id)]} {
4928         if {$isbold && ![ishighlighted $id]} {
4929             bolden $id mainfontbold
4930         }
4931     }
4932     set rhighlights($id) $isbold
4933 }
4934
4935 # Graph layout functions
4936
4937 proc shortids {ids} {
4938     set res {}
4939     foreach id $ids {
4940         if {[llength $id] > 1} {
4941             lappend res [shortids $id]
4942         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4943             lappend res [string range $id 0 7]
4944         } else {
4945             lappend res $id
4946         }
4947     }
4948     return $res
4949 }
4950
4951 proc ntimes {n o} {
4952     set ret {}
4953     set o [list $o]
4954     for {set mask 1} {$mask <= $n} {incr mask $mask} {
4955         if {($n & $mask) != 0} {
4956             set ret [concat $ret $o]
4957         }
4958         set o [concat $o $o]
4959     }
4960     return $ret
4961 }
4962
4963 proc ordertoken {id} {
4964     global ordertok curview varcid varcstart varctok curview parents children
4965     global nullid nullid2
4966
4967     if {[info exists ordertok($id)]} {
4968         return $ordertok($id)
4969     }
4970     set origid $id
4971     set todo {}
4972     while {1} {
4973         if {[info exists varcid($curview,$id)]} {
4974             set a $varcid($curview,$id)
4975             set p [lindex $varcstart($curview) $a]
4976         } else {
4977             set p [lindex $children($curview,$id) 0]
4978         }
4979         if {[info exists ordertok($p)]} {
4980             set tok $ordertok($p)
4981             break
4982         }
4983         set id [first_real_child $curview,$p]
4984         if {$id eq {}} {
4985             # it's a root
4986             set tok [lindex $varctok($curview) $varcid($curview,$p)]
4987             break
4988         }
4989         if {[llength $parents($curview,$id)] == 1} {
4990             lappend todo [list $p {}]
4991         } else {
4992             set j [lsearch -exact $parents($curview,$id) $p]
4993             if {$j < 0} {
4994                 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4995             }
4996             lappend todo [list $p [strrep $j]]
4997         }
4998     }
4999     for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5000         set p [lindex $todo $i 0]
5001         append tok [lindex $todo $i 1]
5002         set ordertok($p) $tok
5003     }
5004     set ordertok($origid) $tok
5005     return $tok
5006 }
5007
5008 # Work out where id should go in idlist so that order-token
5009 # values increase from left to right
5010 proc idcol {idlist id {i 0}} {
5011     set t [ordertoken $id]
5012     if {$i < 0} {
5013         set i 0
5014     }
5015     if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
5016         if {$i > [llength $idlist]} {
5017             set i [llength $idlist]
5018         }
5019         while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5020         incr i
5021     } else {
5022         if {$t > [ordertoken [lindex $idlist $i]]} {
5023             while {[incr i] < [llength $idlist] &&
5024                    $t >= [ordertoken [lindex $idlist $i]]} {}
5025         }
5026     }
5027     return $i
5028 }
5029
5030 proc initlayout {} {
5031     global rowidlist rowisopt rowfinal displayorder parentlist
5032     global numcommits canvxmax canv
5033     global nextcolor
5034     global colormap rowtextx
5035
5036     set numcommits 0
5037     set displayorder {}
5038     set parentlist {}
5039     set nextcolor 0
5040     set rowidlist {}
5041     set rowisopt {}
5042     set rowfinal {}
5043     set canvxmax [$canv cget -width]
5044     catch {unset colormap}
5045     catch {unset rowtextx}
5046     setcanvscroll
5047 }
5048
5049 proc setcanvscroll {} {
5050     global canv canv2 canv3 numcommits linespc canvxmax canvy0
5051     global lastscrollset lastscrollrows
5052
5053     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5054     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5055     $canv2 conf -scrollregion [list 0 0 0 $ymax]
5056     $canv3 conf -scrollregion [list 0 0 0 $ymax]
5057     set lastscrollset [clock clicks -milliseconds]
5058     set lastscrollrows $numcommits
5059 }
5060
5061 proc visiblerows {} {
5062     global canv numcommits linespc
5063
5064     set ymax [lindex [$canv cget -scrollregion] 3]
5065     if {$ymax eq {} || $ymax == 0} return
5066     set f [$canv yview]
5067     set y0 [expr {int([lindex $f 0] * $ymax)}]
5068     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5069     if {$r0 < 0} {
5070         set r0 0
5071     }
5072     set y1 [expr {int([lindex $f 1] * $ymax)}]
5073     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5074     if {$r1 >= $numcommits} {
5075         set r1 [expr {$numcommits - 1}]
5076     }
5077     return [list $r0 $r1]
5078 }
5079
5080 proc layoutmore {} {
5081     global commitidx viewcomplete curview
5082     global numcommits pending_select curview
5083     global lastscrollset lastscrollrows
5084
5085     if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5086         [clock clicks -milliseconds] - $lastscrollset > 500} {
5087         setcanvscroll
5088     }
5089     if {[info exists pending_select] &&
5090         [commitinview $pending_select $curview]} {
5091         update
5092         selectline [rowofcommit $pending_select] 1
5093     }
5094     drawvisible
5095 }
5096
5097 # With path limiting, we mightn't get the actual HEAD commit,
5098 # so ask git rev-list what is the first ancestor of HEAD that
5099 # touches a file in the path limit.
5100 proc get_viewmainhead {view} {
5101     global viewmainheadid vfilelimit viewinstances mainheadid
5102
5103     catch {
5104         set rfd [open [concat | git rev-list -1 $mainheadid \
5105                            -- $vfilelimit($view)] r]
5106         set j [reg_instance $rfd]
5107         lappend viewinstances($view) $j
5108         fconfigure $rfd -blocking 0
5109         filerun $rfd [list getviewhead $rfd $j $view]
5110         set viewmainheadid($curview) {}
5111     }
5112 }
5113
5114 # git rev-list should give us just 1 line to use as viewmainheadid($view)
5115 proc getviewhead {fd inst view} {
5116     global viewmainheadid commfd curview viewinstances showlocalchanges
5117
5118     set id {}
5119     if {[gets $fd line] < 0} {
5120         if {![eof $fd]} {
5121             return 1
5122         }
5123     } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5124         set id $line
5125     }
5126     set viewmainheadid($view) $id
5127     close $fd
5128     unset commfd($inst)
5129     set i [lsearch -exact $viewinstances($view) $inst]
5130     if {$i >= 0} {
5131         set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5132     }
5133     if {$showlocalchanges && $id ne {} && $view == $curview} {
5134         doshowlocalchanges
5135     }
5136     return 0
5137 }
5138
5139 proc doshowlocalchanges {} {
5140     global curview viewmainheadid
5141
5142     if {$viewmainheadid($curview) eq {}} return
5143     if {[commitinview $viewmainheadid($curview) $curview]} {
5144         dodiffindex
5145     } else {
5146         interestedin $viewmainheadid($curview) dodiffindex
5147     }
5148 }
5149
5150 proc dohidelocalchanges {} {
5151     global nullid nullid2 lserial curview
5152
5153     if {[commitinview $nullid $curview]} {
5154         removefakerow $nullid
5155     }
5156     if {[commitinview $nullid2 $curview]} {
5157         removefakerow $nullid2
5158     }
5159     incr lserial
5160 }
5161
5162 # spawn off a process to do git diff-index --cached HEAD
5163 proc dodiffindex {} {
5164     global lserial showlocalchanges vfilelimit curview
5165     global hasworktree git_version
5166
5167     if {!$showlocalchanges || !$hasworktree} return
5168     incr lserial
5169     if {[package vcompare $git_version "1.7.2"] >= 0} {
5170         set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
5171     } else {
5172         set cmd "|git diff-index --cached HEAD"
5173     }
5174     if {$vfilelimit($curview) ne {}} {
5175         set cmd [concat $cmd -- $vfilelimit($curview)]
5176     }
5177     set fd [open $cmd r]
5178     fconfigure $fd -blocking 0
5179     set i [reg_instance $fd]
5180     filerun $fd [list readdiffindex $fd $lserial $i]
5181 }
5182
5183 proc readdiffindex {fd serial inst} {
5184     global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5185     global vfilelimit
5186
5187     set isdiff 1
5188     if {[gets $fd line] < 0} {
5189         if {![eof $fd]} {
5190             return 1
5191         }
5192         set isdiff 0
5193     }
5194     # we only need to see one line and we don't really care what it says...
5195     stop_instance $inst
5196
5197     if {$serial != $lserial} {
5198         return 0
5199     }
5200
5201     # now see if there are any local changes not checked in to the index
5202     set cmd "|git diff-files"
5203     if {$vfilelimit($curview) ne {}} {
5204         set cmd [concat $cmd -- $vfilelimit($curview)]
5205     }
5206     set fd [open $cmd r]
5207     fconfigure $fd -blocking 0
5208     set i [reg_instance $fd]
5209     filerun $fd [list readdifffiles $fd $serial $i]
5210
5211     if {$isdiff && ![commitinview $nullid2 $curview]} {
5212         # add the line for the changes in the index to the graph
5213         set hl [mc "Local changes checked in to index but not committed"]
5214         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5215         set commitdata($nullid2) "\n    $hl\n"
5216         if {[commitinview $nullid $curview]} {
5217             removefakerow $nullid
5218         }
5219         insertfakerow $nullid2 $viewmainheadid($curview)
5220     } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5221         if {[commitinview $nullid $curview]} {
5222             removefakerow $nullid
5223         }
5224         removefakerow $nullid2
5225     }
5226     return 0
5227 }
5228
5229 proc readdifffiles {fd serial inst} {
5230     global viewmainheadid nullid nullid2 curview
5231     global commitinfo commitdata lserial
5232
5233     set isdiff 1
5234     if {[gets $fd line] < 0} {
5235         if {![eof $fd]} {
5236             return 1
5237         }
5238         set isdiff 0
5239     }
5240     # we only need to see one line and we don't really care what it says...
5241     stop_instance $inst
5242
5243     if {$serial != $lserial} {
5244         return 0
5245     }
5246
5247     if {$isdiff && ![commitinview $nullid $curview]} {
5248         # add the line for the local diff to the graph
5249         set hl [mc "Local uncommitted changes, not checked in to index"]
5250         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5251         set commitdata($nullid) "\n    $hl\n"
5252         if {[commitinview $nullid2 $curview]} {
5253             set p $nullid2
5254         } else {
5255             set p $viewmainheadid($curview)
5256         }
5257         insertfakerow $nullid $p
5258     } elseif {!$isdiff && [commitinview $nullid $curview]} {
5259         removefakerow $nullid
5260     }
5261     return 0
5262 }
5263
5264 proc nextuse {id row} {
5265     global curview children
5266
5267     if {[info exists children($curview,$id)]} {
5268         foreach kid $children($curview,$id) {
5269             if {![commitinview $kid $curview]} {
5270                 return -1
5271             }
5272             if {[rowofcommit $kid] > $row} {
5273                 return [rowofcommit $kid]
5274             }
5275         }
5276     }
5277     if {[commitinview $id $curview]} {
5278         return [rowofcommit $id]
5279     }
5280     return -1
5281 }
5282
5283 proc prevuse {id row} {
5284     global curview children
5285
5286     set ret -1
5287     if {[info exists children($curview,$id)]} {
5288         foreach kid $children($curview,$id) {
5289             if {![commitinview $kid $curview]} break
5290             if {[rowofcommit $kid] < $row} {
5291                 set ret [rowofcommit $kid]
5292             }
5293         }
5294     }
5295     return $ret
5296 }
5297
5298 proc make_idlist {row} {
5299     global displayorder parentlist uparrowlen downarrowlen mingaplen
5300     global commitidx curview children
5301
5302     set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5303     if {$r < 0} {
5304         set r 0
5305     }
5306     set ra [expr {$row - $downarrowlen}]
5307     if {$ra < 0} {
5308         set ra 0
5309     }
5310     set rb [expr {$row + $uparrowlen}]
5311     if {$rb > $commitidx($curview)} {
5312         set rb $commitidx($curview)
5313     }
5314     make_disporder $r [expr {$rb + 1}]
5315     set ids {}
5316     for {} {$r < $ra} {incr r} {
5317         set nextid [lindex $displayorder [expr {$r + 1}]]
5318         foreach p [lindex $parentlist $r] {
5319             if {$p eq $nextid} continue
5320             set rn [nextuse $p $r]
5321             if {$rn >= $row &&
5322                 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5323                 lappend ids [list [ordertoken $p] $p]
5324             }
5325         }
5326     }
5327     for {} {$r < $row} {incr r} {
5328         set nextid [lindex $displayorder [expr {$r + 1}]]
5329         foreach p [lindex $parentlist $r] {
5330             if {$p eq $nextid} continue
5331             set rn [nextuse $p $r]
5332             if {$rn < 0 || $rn >= $row} {
5333                 lappend ids [list [ordertoken $p] $p]
5334             }
5335         }
5336     }
5337     set id [lindex $displayorder $row]
5338     lappend ids [list [ordertoken $id] $id]
5339     while {$r < $rb} {
5340         foreach p [lindex $parentlist $r] {
5341             set firstkid [lindex $children($curview,$p) 0]
5342             if {[rowofcommit $firstkid] < $row} {
5343                 lappend ids [list [ordertoken $p] $p]
5344             }
5345         }
5346         incr r
5347         set id [lindex $displayorder $r]
5348         if {$id ne {}} {
5349             set firstkid [lindex $children($curview,$id) 0]
5350             if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5351                 lappend ids [list [ordertoken $id] $id]
5352             }
5353         }
5354     }
5355     set idlist {}
5356     foreach idx [lsort -unique $ids] {
5357         lappend idlist [lindex $idx 1]
5358     }
5359     return $idlist
5360 }
5361
5362 proc rowsequal {a b} {
5363     while {[set i [lsearch -exact $a {}]] >= 0} {
5364         set a [lreplace $a $i $i]
5365     }
5366     while {[set i [lsearch -exact $b {}]] >= 0} {
5367         set b [lreplace $b $i $i]
5368     }
5369     return [expr {$a eq $b}]
5370 }
5371
5372 proc makeupline {id row rend col} {
5373     global rowidlist uparrowlen downarrowlen mingaplen
5374
5375     for {set r $rend} {1} {set r $rstart} {
5376         set rstart [prevuse $id $r]
5377         if {$rstart < 0} return
5378         if {$rstart < $row} break
5379     }
5380     if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5381         set rstart [expr {$rend - $uparrowlen - 1}]
5382     }
5383     for {set r $rstart} {[incr r] <= $row} {} {
5384         set idlist [lindex $rowidlist $r]
5385         if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5386             set col [idcol $idlist $id $col]
5387             lset rowidlist $r [linsert $idlist $col $id]
5388             changedrow $r
5389         }
5390     }
5391 }
5392
5393 proc layoutrows {row endrow} {
5394     global rowidlist rowisopt rowfinal displayorder
5395     global uparrowlen downarrowlen maxwidth mingaplen
5396     global children parentlist
5397     global commitidx viewcomplete curview
5398
5399     make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5400     set idlist {}
5401     if {$row > 0} {
5402         set rm1 [expr {$row - 1}]
5403         foreach id [lindex $rowidlist $rm1] {
5404             if {$id ne {}} {
5405                 lappend idlist $id
5406             }
5407         }
5408         set final [lindex $rowfinal $rm1]
5409     }
5410     for {} {$row < $endrow} {incr row} {
5411         set rm1 [expr {$row - 1}]
5412         if {$rm1 < 0 || $idlist eq {}} {
5413             set idlist [make_idlist $row]
5414             set final 1
5415         } else {
5416             set id [lindex $displayorder $rm1]
5417             set col [lsearch -exact $idlist $id]
5418             set idlist [lreplace $idlist $col $col]
5419             foreach p [lindex $parentlist $rm1] {
5420                 if {[lsearch -exact $idlist $p] < 0} {
5421                     set col [idcol $idlist $p $col]
5422                     set idlist [linsert $idlist $col $p]
5423                     # if not the first child, we have to insert a line going up
5424                     if {$id ne [lindex $children($curview,$p) 0]} {
5425                         makeupline $p $rm1 $row $col
5426                     }
5427                 }
5428             }
5429             set id [lindex $displayorder $row]
5430             if {$row > $downarrowlen} {
5431                 set termrow [expr {$row - $downarrowlen - 1}]
5432                 foreach p [lindex $parentlist $termrow] {
5433                     set i [lsearch -exact $idlist $p]
5434                     if {$i < 0} continue
5435                     set nr [nextuse $p $termrow]
5436                     if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5437                         set idlist [lreplace $idlist $i $i]
5438                     }
5439                 }
5440             }
5441             set col [lsearch -exact $idlist $id]
5442             if {$col < 0} {
5443                 set col [idcol $idlist $id]
5444                 set idlist [linsert $idlist $col $id]
5445                 if {$children($curview,$id) ne {}} {
5446                     makeupline $id $rm1 $row $col
5447                 }
5448             }
5449             set r [expr {$row + $uparrowlen - 1}]
5450             if {$r < $commitidx($curview)} {
5451                 set x $col
5452                 foreach p [lindex $parentlist $r] {
5453                     if {[lsearch -exact $idlist $p] >= 0} continue
5454                     set fk [lindex $children($curview,$p) 0]
5455                     if {[rowofcommit $fk] < $row} {
5456                         set x [idcol $idlist $p $x]
5457                         set idlist [linsert $idlist $x $p]
5458                     }
5459                 }
5460                 if {[incr r] < $commitidx($curview)} {
5461                     set p [lindex $displayorder $r]
5462                     if {[lsearch -exact $idlist $p] < 0} {
5463                         set fk [lindex $children($curview,$p) 0]
5464                         if {$fk ne {} && [rowofcommit $fk] < $row} {
5465                             set x [idcol $idlist $p $x]
5466                             set idlist [linsert $idlist $x $p]
5467                         }
5468                     }
5469                 }
5470             }
5471         }
5472         if {$final && !$viewcomplete($curview) &&
5473             $row + $uparrowlen + $mingaplen + $downarrowlen
5474                 >= $commitidx($curview)} {
5475             set final 0
5476         }
5477         set l [llength $rowidlist]
5478         if {$row == $l} {
5479             lappend rowidlist $idlist
5480             lappend rowisopt 0
5481             lappend rowfinal $final
5482         } elseif {$row < $l} {
5483             if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5484                 lset rowidlist $row $idlist
5485                 changedrow $row
5486             }
5487             lset rowfinal $row $final
5488         } else {
5489             set pad [ntimes [expr {$row - $l}] {}]
5490             set rowidlist [concat $rowidlist $pad]
5491             lappend rowidlist $idlist
5492             set rowfinal [concat $rowfinal $pad]
5493             lappend rowfinal $final
5494             set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5495         }
5496     }
5497     return $row
5498 }
5499
5500 proc changedrow {row} {
5501     global displayorder iddrawn rowisopt need_redisplay
5502
5503     set l [llength $rowisopt]
5504     if {$row < $l} {
5505         lset rowisopt $row 0
5506         if {$row + 1 < $l} {
5507             lset rowisopt [expr {$row + 1}] 0
5508             if {$row + 2 < $l} {
5509                 lset rowisopt [expr {$row + 2}] 0
5510             }
5511         }
5512     }
5513     set id [lindex $displayorder $row]
5514     if {[info exists iddrawn($id)]} {
5515         set need_redisplay 1
5516     }
5517 }
5518
5519 proc insert_pad {row col npad} {
5520     global rowidlist
5521
5522     set pad [ntimes $npad {}]
5523     set idlist [lindex $rowidlist $row]
5524     set bef [lrange $idlist 0 [expr {$col - 1}]]
5525     set aft [lrange $idlist $col end]
5526     set i [lsearch -exact $aft {}]
5527     if {$i > 0} {
5528         set aft [lreplace $aft $i $i]
5529     }
5530     lset rowidlist $row [concat $bef $pad $aft]
5531     changedrow $row
5532 }
5533
5534 proc optimize_rows {row col endrow} {
5535     global rowidlist rowisopt displayorder curview children
5536
5537     if {$row < 1} {
5538         set row 1
5539     }
5540     for {} {$row < $endrow} {incr row; set col 0} {
5541         if {[lindex $rowisopt $row]} continue
5542         set haspad 0
5543         set y0 [expr {$row - 1}]
5544         set ym [expr {$row - 2}]
5545         set idlist [lindex $rowidlist $row]
5546         set previdlist [lindex $rowidlist $y0]
5547         if {$idlist eq {} || $previdlist eq {}} continue
5548         if {$ym >= 0} {
5549             set pprevidlist [lindex $rowidlist $ym]
5550             if {$pprevidlist eq {}} continue
5551         } else {
5552             set pprevidlist {}
5553         }
5554         set x0 -1
5555         set xm -1
5556         for {} {$col < [llength $idlist]} {incr col} {
5557             set id [lindex $idlist $col]
5558             if {[lindex $previdlist $col] eq $id} continue
5559             if {$id eq {}} {
5560                 set haspad 1
5561                 continue
5562             }
5563             set x0 [lsearch -exact $previdlist $id]
5564             if {$x0 < 0} continue
5565             set z [expr {$x0 - $col}]
5566             set isarrow 0
5567             set z0 {}
5568             if {$ym >= 0} {
5569                 set xm [lsearch -exact $pprevidlist $id]
5570                 if {$xm >= 0} {
5571                     set z0 [expr {$xm - $x0}]
5572                 }
5573             }
5574             if {$z0 eq {}} {
5575                 # if row y0 is the first child of $id then it's not an arrow
5576                 if {[lindex $children($curview,$id) 0] ne
5577                     [lindex $displayorder $y0]} {
5578                     set isarrow 1
5579                 }
5580             }
5581             if {!$isarrow && $id ne [lindex $displayorder $row] &&
5582                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5583                 set isarrow 1
5584             }
5585             # Looking at lines from this row to the previous row,
5586             # make them go straight up if they end in an arrow on
5587             # the previous row; otherwise make them go straight up
5588             # or at 45 degrees.
5589             if {$z < -1 || ($z < 0 && $isarrow)} {
5590                 # Line currently goes left too much;
5591                 # insert pads in the previous row, then optimize it
5592                 set npad [expr {-1 - $z + $isarrow}]
5593                 insert_pad $y0 $x0 $npad
5594                 if {$y0 > 0} {
5595                     optimize_rows $y0 $x0 $row
5596                 }
5597                 set previdlist [lindex $rowidlist $y0]
5598                 set x0 [lsearch -exact $previdlist $id]
5599                 set z [expr {$x0 - $col}]
5600                 if {$z0 ne {}} {
5601                     set pprevidlist [lindex $rowidlist $ym]
5602                     set xm [lsearch -exact $pprevidlist $id]
5603                     set z0 [expr {$xm - $x0}]
5604                 }
5605             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5606                 # Line currently goes right too much;
5607                 # insert pads in this line
5608                 set npad [expr {$z - 1 + $isarrow}]
5609                 insert_pad $row $col $npad
5610                 set idlist [lindex $rowidlist $row]
5611                 incr col $npad
5612                 set z [expr {$x0 - $col}]
5613                 set haspad 1
5614             }
5615             if {$z0 eq {} && !$isarrow && $ym >= 0} {
5616                 # this line links to its first child on row $row-2
5617                 set id [lindex $displayorder $ym]
5618                 set xc [lsearch -exact $pprevidlist $id]
5619                 if {$xc >= 0} {
5620                     set z0 [expr {$xc - $x0}]
5621                 }
5622             }
5623             # avoid lines jigging left then immediately right
5624             if {$z0 ne {} && $z < 0 && $z0 > 0} {
5625                 insert_pad $y0 $x0 1
5626                 incr x0
5627                 optimize_rows $y0 $x0 $row
5628                 set previdlist [lindex $rowidlist $y0]
5629             }
5630         }
5631         if {!$haspad} {
5632             # Find the first column that doesn't have a line going right
5633             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5634                 set id [lindex $idlist $col]
5635                 if {$id eq {}} break
5636                 set x0 [lsearch -exact $previdlist $id]
5637                 if {$x0 < 0} {
5638                     # check if this is the link to the first child
5639                     set kid [lindex $displayorder $y0]
5640                     if {[lindex $children($curview,$id) 0] eq $kid} {
5641                         # it is, work out offset to child
5642                         set x0 [lsearch -exact $previdlist $kid]
5643                     }
5644                 }
5645                 if {$x0 <= $col} break
5646             }
5647             # Insert a pad at that column as long as it has a line and
5648             # isn't the last column
5649             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5650                 set idlist [linsert $idlist $col {}]
5651                 lset rowidlist $row $idlist
5652                 changedrow $row
5653             }
5654         }
5655     }
5656 }
5657
5658 proc xc {row col} {
5659     global canvx0 linespc
5660     return [expr {$canvx0 + $col * $linespc}]
5661 }
5662
5663 proc yc {row} {
5664     global canvy0 linespc
5665     return [expr {$canvy0 + $row * $linespc}]
5666 }
5667
5668 proc linewidth {id} {
5669     global thickerline lthickness
5670
5671     set wid $lthickness
5672     if {[info exists thickerline] && $id eq $thickerline} {
5673         set wid [expr {2 * $lthickness}]
5674     }
5675     return $wid
5676 }
5677
5678 proc rowranges {id} {
5679     global curview children uparrowlen downarrowlen
5680     global rowidlist
5681
5682     set kids $children($curview,$id)
5683     if {$kids eq {}} {
5684         return {}
5685     }
5686     set ret {}
5687     lappend kids $id
5688     foreach child $kids {
5689         if {![commitinview $child $curview]} break
5690         set row [rowofcommit $child]
5691         if {![info exists prev]} {
5692             lappend ret [expr {$row + 1}]
5693         } else {
5694             if {$row <= $prevrow} {
5695                 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5696             }
5697             # see if the line extends the whole way from prevrow to row
5698             if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5699                 [lsearch -exact [lindex $rowidlist \
5700                             [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5701                 # it doesn't, see where it ends
5702                 set r [expr {$prevrow + $downarrowlen}]
5703                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5704                     while {[incr r -1] > $prevrow &&
5705                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5706                 } else {
5707                     while {[incr r] <= $row &&
5708                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5709                     incr r -1
5710                 }
5711                 lappend ret $r
5712                 # see where it starts up again
5713                 set r [expr {$row - $uparrowlen}]
5714                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5715                     while {[incr r] < $row &&
5716                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5717                 } else {
5718                     while {[incr r -1] >= $prevrow &&
5719                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5720                     incr r
5721                 }
5722                 lappend ret $r
5723             }
5724         }
5725         if {$child eq $id} {
5726             lappend ret $row
5727         }
5728         set prev $child
5729         set prevrow $row
5730     }
5731     return $ret
5732 }
5733
5734 proc drawlineseg {id row endrow arrowlow} {
5735     global rowidlist displayorder iddrawn linesegs
5736     global canv colormap linespc curview maxlinelen parentlist
5737
5738     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5739     set le [expr {$row + 1}]
5740     set arrowhigh 1
5741     while {1} {
5742         set c [lsearch -exact [lindex $rowidlist $le] $id]
5743         if {$c < 0} {
5744             incr le -1
5745             break
5746         }
5747         lappend cols $c
5748         set x [lindex $displayorder $le]
5749         if {$x eq $id} {
5750             set arrowhigh 0
5751             break
5752         }
5753         if {[info exists iddrawn($x)] || $le == $endrow} {
5754             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5755             if {$c >= 0} {
5756                 lappend cols $c
5757                 set arrowhigh 0
5758             }
5759             break
5760         }
5761         incr le
5762     }
5763     if {$le <= $row} {
5764         return $row
5765     }
5766
5767     set lines {}
5768     set i 0
5769     set joinhigh 0
5770     if {[info exists linesegs($id)]} {
5771         set lines $linesegs($id)
5772         foreach li $lines {
5773             set r0 [lindex $li 0]
5774             if {$r0 > $row} {
5775                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5776                     set joinhigh 1
5777                 }
5778                 break
5779             }
5780             incr i
5781         }
5782     }
5783     set joinlow 0
5784     if {$i > 0} {
5785         set li [lindex $lines [expr {$i-1}]]
5786         set r1 [lindex $li 1]
5787         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5788             set joinlow 1
5789         }
5790     }
5791
5792     set x [lindex $cols [expr {$le - $row}]]
5793     set xp [lindex $cols [expr {$le - 1 - $row}]]
5794     set dir [expr {$xp - $x}]
5795     if {$joinhigh} {
5796         set ith [lindex $lines $i 2]
5797         set coords [$canv coords $ith]
5798         set ah [$canv itemcget $ith -arrow]
5799         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5800         set x2 [lindex $cols [expr {$le + 1 - $row}]]
5801         if {$x2 ne {} && $x - $x2 == $dir} {
5802             set coords [lrange $coords 0 end-2]
5803         }
5804     } else {
5805         set coords [list [xc $le $x] [yc $le]]
5806     }
5807     if {$joinlow} {
5808         set itl [lindex $lines [expr {$i-1}] 2]
5809         set al [$canv itemcget $itl -arrow]
5810         set arrowlow [expr {$al eq "last" || $al eq "both"}]
5811     } elseif {$arrowlow} {
5812         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5813             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5814             set arrowlow 0
5815         }
5816     }
5817     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5818     for {set y $le} {[incr y -1] > $row} {} {
5819         set x $xp
5820         set xp [lindex $cols [expr {$y - 1 - $row}]]
5821         set ndir [expr {$xp - $x}]
5822         if {$dir != $ndir || $xp < 0} {
5823             lappend coords [xc $y $x] [yc $y]
5824         }
5825         set dir $ndir
5826     }
5827     if {!$joinlow} {
5828         if {$xp < 0} {
5829             # join parent line to first child
5830             set ch [lindex $displayorder $row]
5831             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5832             if {$xc < 0} {
5833                 puts "oops: drawlineseg: child $ch not on row $row"
5834             } elseif {$xc != $x} {
5835                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5836                     set d [expr {int(0.5 * $linespc)}]
5837                     set x1 [xc $row $x]
5838                     if {$xc < $x} {
5839                         set x2 [expr {$x1 - $d}]
5840                     } else {
5841                         set x2 [expr {$x1 + $d}]
5842                     }
5843                     set y2 [yc $row]
5844                     set y1 [expr {$y2 + $d}]
5845                     lappend coords $x1 $y1 $x2 $y2
5846                 } elseif {$xc < $x - 1} {
5847                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
5848                 } elseif {$xc > $x + 1} {
5849                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
5850                 }
5851                 set x $xc
5852             }
5853             lappend coords [xc $row $x] [yc $row]
5854         } else {
5855             set xn [xc $row $xp]
5856             set yn [yc $row]
5857             lappend coords $xn $yn
5858         }
5859         if {!$joinhigh} {
5860             assigncolor $id
5861             set t [$canv create line $coords -width [linewidth $id] \
5862                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
5863             $canv lower $t
5864             bindline $t $id
5865             set lines [linsert $lines $i [list $row $le $t]]
5866         } else {
5867             $canv coords $ith $coords
5868             if {$arrow ne $ah} {
5869                 $canv itemconf $ith -arrow $arrow
5870             }
5871             lset lines $i 0 $row
5872         }
5873     } else {
5874         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5875         set ndir [expr {$xo - $xp}]
5876         set clow [$canv coords $itl]
5877         if {$dir == $ndir} {
5878             set clow [lrange $clow 2 end]
5879         }
5880         set coords [concat $coords $clow]
5881         if {!$joinhigh} {
5882             lset lines [expr {$i-1}] 1 $le
5883         } else {
5884             # coalesce two pieces
5885             $canv delete $ith
5886             set b [lindex $lines [expr {$i-1}] 0]
5887             set e [lindex $lines $i 1]
5888             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5889         }
5890         $canv coords $itl $coords
5891         if {$arrow ne $al} {
5892             $canv itemconf $itl -arrow $arrow
5893         }
5894     }
5895
5896     set linesegs($id) $lines
5897     return $le
5898 }
5899
5900 proc drawparentlinks {id row} {
5901     global rowidlist canv colormap curview parentlist
5902     global idpos linespc
5903
5904     set rowids [lindex $rowidlist $row]
5905     set col [lsearch -exact $rowids $id]
5906     if {$col < 0} return
5907     set olds [lindex $parentlist $row]
5908     set row2 [expr {$row + 1}]
5909     set x [xc $row $col]
5910     set y [yc $row]
5911     set y2 [yc $row2]
5912     set d [expr {int(0.5 * $linespc)}]
5913     set ymid [expr {$y + $d}]
5914     set ids [lindex $rowidlist $row2]
5915     # rmx = right-most X coord used
5916     set rmx 0
5917     foreach p $olds {
5918         set i [lsearch -exact $ids $p]
5919         if {$i < 0} {
5920             puts "oops, parent $p of $id not in list"
5921             continue
5922         }
5923         set x2 [xc $row2 $i]
5924         if {$x2 > $rmx} {
5925             set rmx $x2
5926         }
5927         set j [lsearch -exact $rowids $p]
5928         if {$j < 0} {
5929             # drawlineseg will do this one for us
5930             continue
5931         }
5932         assigncolor $p
5933         # should handle duplicated parents here...
5934         set coords [list $x $y]
5935         if {$i != $col} {
5936             # if attaching to a vertical segment, draw a smaller
5937             # slant for visual distinctness
5938             if {$i == $j} {
5939                 if {$i < $col} {
5940                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5941                 } else {
5942                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5943                 }
5944             } elseif {$i < $col && $i < $j} {
5945                 # segment slants towards us already
5946                 lappend coords [xc $row $j] $y
5947             } else {
5948                 if {$i < $col - 1} {
5949                     lappend coords [expr {$x2 + $linespc}] $y
5950                 } elseif {$i > $col + 1} {
5951                     lappend coords [expr {$x2 - $linespc}] $y
5952                 }
5953                 lappend coords $x2 $y2
5954             }
5955         } else {
5956             lappend coords $x2 $y2
5957         }
5958         set t [$canv create line $coords -width [linewidth $p] \
5959                    -fill $colormap($p) -tags lines.$p]
5960         $canv lower $t
5961         bindline $t $p
5962     }
5963     if {$rmx > [lindex $idpos($id) 1]} {
5964         lset idpos($id) 1 $rmx
5965         redrawtags $id
5966     }
5967 }
5968
5969 proc drawlines {id} {
5970     global canv
5971
5972     $canv itemconf lines.$id -width [linewidth $id]
5973 }
5974
5975 proc drawcmittext {id row col} {
5976     global linespc canv canv2 canv3 fgcolor curview
5977     global cmitlisted commitinfo rowidlist parentlist
5978     global rowtextx idpos idtags idheads idotherrefs
5979     global linehtag linentag linedtag selectedline
5980     global canvxmax boldids boldnameids fgcolor markedid
5981     global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5982     global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
5983     global circleoutlinecolor
5984
5985     # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5986     set listed $cmitlisted($curview,$id)
5987     if {$id eq $nullid} {
5988         set ofill $workingfilescirclecolor
5989     } elseif {$id eq $nullid2} {
5990         set ofill $indexcirclecolor
5991     } elseif {$id eq $mainheadid} {
5992         set ofill $mainheadcirclecolor
5993     } else {
5994         set ofill [lindex $circlecolors $listed]
5995     }
5996     set x [xc $row $col]
5997     set y [yc $row]
5998     set orad [expr {$linespc / 3}]
5999     if {$listed <= 2} {
6000         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6001                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6002                    -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6003     } elseif {$listed == 3} {
6004         # triangle pointing left for left-side commits
6005         set t [$canv create polygon \
6006                    [expr {$x - $orad}] $y \
6007                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6008                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6009                    -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6010     } else {
6011         # triangle pointing right for right-side commits
6012         set t [$canv create polygon \
6013                    [expr {$x + $orad - 1}] $y \
6014                    [expr {$x - $orad}] [expr {$y - $orad}] \
6015                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6016                    -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6017     }
6018     set circleitem($row) $t
6019     $canv raise $t
6020     $canv bind $t <1> {selcanvline {} %x %y}
6021     set rmx [llength [lindex $rowidlist $row]]
6022     set olds [lindex $parentlist $row]
6023     if {$olds ne {}} {
6024         set nextids [lindex $rowidlist [expr {$row + 1}]]
6025         foreach p $olds {
6026             set i [lsearch -exact $nextids $p]
6027             if {$i > $rmx} {
6028                 set rmx $i
6029             }
6030         }
6031     }
6032     set xt [xc $row $rmx]
6033     set rowtextx($row) $xt
6034     set idpos($id) [list $x $xt $y]
6035     if {[info exists idtags($id)] || [info exists idheads($id)]
6036         || [info exists idotherrefs($id)]} {
6037         set xt [drawtags $id $x $xt $y]
6038     }
6039     if {[lindex $commitinfo($id) 6] > 0} {
6040         set xt [drawnotesign $xt $y]
6041     }
6042     set headline [lindex $commitinfo($id) 0]
6043     set name [lindex $commitinfo($id) 1]
6044     set date [lindex $commitinfo($id) 2]
6045     set date [formatdate $date]
6046     set font mainfont
6047     set nfont mainfont
6048     set isbold [ishighlighted $id]
6049     if {$isbold > 0} {
6050         lappend boldids $id
6051         set font mainfontbold
6052         if {$isbold > 1} {
6053             lappend boldnameids $id
6054             set nfont mainfontbold
6055         }
6056     }
6057     set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6058                            -text $headline -font $font -tags text]
6059     $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6060     set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6061                            -text $name -font $nfont -tags text]
6062     set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6063                            -text $date -font mainfont -tags text]
6064     if {$selectedline == $row} {
6065         make_secsel $id
6066     }
6067     if {[info exists markedid] && $markedid eq $id} {
6068         make_idmark $id
6069     }
6070     set xr [expr {$xt + [font measure $font $headline]}]
6071     if {$xr > $canvxmax} {
6072         set canvxmax $xr
6073         setcanvscroll
6074     }
6075 }
6076
6077 proc drawcmitrow {row} {
6078     global displayorder rowidlist nrows_drawn
6079     global iddrawn markingmatches
6080     global commitinfo numcommits
6081     global filehighlight fhighlights findpattern nhighlights
6082     global hlview vhighlights
6083     global highlight_related rhighlights
6084
6085     if {$row >= $numcommits} return
6086
6087     set id [lindex $displayorder $row]
6088     if {[info exists hlview] && ![info exists vhighlights($id)]} {
6089         askvhighlight $row $id
6090     }
6091     if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
6092         askfilehighlight $row $id
6093     }
6094     if {$findpattern ne {} && ![info exists nhighlights($id)]} {
6095         askfindhighlight $row $id
6096     }
6097     if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
6098         askrelhighlight $row $id
6099     }
6100     if {![info exists iddrawn($id)]} {
6101         set col [lsearch -exact [lindex $rowidlist $row] $id]
6102         if {$col < 0} {
6103             puts "oops, row $row id $id not in list"
6104             return
6105         }
6106         if {![info exists commitinfo($id)]} {
6107             getcommit $id
6108         }
6109         assigncolor $id
6110         drawcmittext $id $row $col
6111         set iddrawn($id) 1
6112         incr nrows_drawn
6113     }
6114     if {$markingmatches} {
6115         markrowmatches $row $id
6116     }
6117 }
6118
6119 proc drawcommits {row {endrow {}}} {
6120     global numcommits iddrawn displayorder curview need_redisplay
6121     global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6122
6123     if {$row < 0} {
6124         set row 0
6125     }
6126     if {$endrow eq {}} {
6127         set endrow $row
6128     }
6129     if {$endrow >= $numcommits} {
6130         set endrow [expr {$numcommits - 1}]
6131     }
6132
6133     set rl1 [expr {$row - $downarrowlen - 3}]
6134     if {$rl1 < 0} {
6135         set rl1 0
6136     }
6137     set ro1 [expr {$row - 3}]
6138     if {$ro1 < 0} {
6139         set ro1 0
6140     }
6141     set r2 [expr {$endrow + $uparrowlen + 3}]
6142     if {$r2 > $numcommits} {
6143         set r2 $numcommits
6144     }
6145     for {set r $rl1} {$r < $r2} {incr r} {
6146         if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6147             if {$rl1 < $r} {
6148                 layoutrows $rl1 $r
6149             }
6150             set rl1 [expr {$r + 1}]
6151         }
6152     }
6153     if {$rl1 < $r} {
6154         layoutrows $rl1 $r
6155     }
6156     optimize_rows $ro1 0 $r2
6157     if {$need_redisplay || $nrows_drawn > 2000} {
6158         clear_display
6159     }
6160
6161     # make the lines join to already-drawn rows either side
6162     set r [expr {$row - 1}]
6163     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6164         set r $row
6165     }
6166     set er [expr {$endrow + 1}]
6167     if {$er >= $numcommits ||
6168         ![info exists iddrawn([lindex $displayorder $er])]} {
6169         set er $endrow
6170     }
6171     for {} {$r <= $er} {incr r} {
6172         set id [lindex $displayorder $r]
6173         set wasdrawn [info exists iddrawn($id)]
6174         drawcmitrow $r
6175         if {$r == $er} break
6176         set nextid [lindex $displayorder [expr {$r + 1}]]
6177         if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6178         drawparentlinks $id $r
6179
6180         set rowids [lindex $rowidlist $r]
6181         foreach lid $rowids {
6182             if {$lid eq {}} continue
6183             if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6184             if {$lid eq $id} {
6185                 # see if this is the first child of any of its parents
6186                 foreach p [lindex $parentlist $r] {
6187                     if {[lsearch -exact $rowids $p] < 0} {
6188                         # make this line extend up to the child
6189                         set lineend($p) [drawlineseg $p $r $er 0]
6190                     }
6191                 }
6192             } else {
6193                 set lineend($lid) [drawlineseg $lid $r $er 1]
6194             }
6195         }
6196     }
6197 }
6198
6199 proc undolayout {row} {
6200     global uparrowlen mingaplen downarrowlen
6201     global rowidlist rowisopt rowfinal need_redisplay
6202
6203     set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6204     if {$r < 0} {
6205         set r 0
6206     }
6207     if {[llength $rowidlist] > $r} {
6208         incr r -1
6209         set rowidlist [lrange $rowidlist 0 $r]
6210         set rowfinal [lrange $rowfinal 0 $r]
6211         set rowisopt [lrange $rowisopt 0 $r]
6212         set need_redisplay 1
6213         run drawvisible
6214     }
6215 }
6216
6217 proc drawvisible {} {
6218     global canv linespc curview vrowmod selectedline targetrow targetid
6219     global need_redisplay cscroll numcommits
6220
6221     set fs [$canv yview]
6222     set ymax [lindex [$canv cget -scrollregion] 3]
6223     if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6224     set f0 [lindex $fs 0]
6225     set f1 [lindex $fs 1]
6226     set y0 [expr {int($f0 * $ymax)}]
6227     set y1 [expr {int($f1 * $ymax)}]
6228
6229     if {[info exists targetid]} {
6230         if {[commitinview $targetid $curview]} {
6231             set r [rowofcommit $targetid]
6232             if {$r != $targetrow} {
6233                 # Fix up the scrollregion and change the scrolling position
6234                 # now that our target row has moved.
6235                 set diff [expr {($r - $targetrow) * $linespc}]
6236                 set targetrow $r
6237                 setcanvscroll
6238                 set ymax [lindex [$canv cget -scrollregion] 3]
6239                 incr y0 $diff
6240                 incr y1 $diff
6241                 set f0 [expr {$y0 / $ymax}]
6242                 set f1 [expr {$y1 / $ymax}]
6243                 allcanvs yview moveto $f0
6244                 $cscroll set $f0 $f1
6245                 set need_redisplay 1
6246             }
6247         } else {
6248             unset targetid
6249         }
6250     }
6251
6252     set row [expr {int(($y0 - 3) / $linespc) - 1}]
6253     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6254     if {$endrow >= $vrowmod($curview)} {
6255         update_arcrows $curview
6256     }
6257     if {$selectedline ne {} &&
6258         $row <= $selectedline && $selectedline <= $endrow} {
6259         set targetrow $selectedline
6260     } elseif {[info exists targetid]} {
6261         set targetrow [expr {int(($row + $endrow) / 2)}]
6262     }
6263     if {[info exists targetrow]} {
6264         if {$targetrow >= $numcommits} {
6265             set targetrow [expr {$numcommits - 1}]
6266         }
6267         set targetid [commitonrow $targetrow]
6268     }
6269     drawcommits $row $endrow
6270 }
6271
6272 proc clear_display {} {
6273     global iddrawn linesegs need_redisplay nrows_drawn
6274     global vhighlights fhighlights nhighlights rhighlights
6275     global linehtag linentag linedtag boldids boldnameids
6276
6277     allcanvs delete all
6278     catch {unset iddrawn}
6279     catch {unset linesegs}
6280     catch {unset linehtag}
6281     catch {unset linentag}
6282     catch {unset linedtag}
6283     set boldids {}
6284     set boldnameids {}
6285     catch {unset vhighlights}
6286     catch {unset fhighlights}
6287     catch {unset nhighlights}
6288     catch {unset rhighlights}
6289     set need_redisplay 0
6290     set nrows_drawn 0
6291 }
6292
6293 proc findcrossings {id} {
6294     global rowidlist parentlist numcommits displayorder
6295
6296     set cross {}
6297     set ccross {}
6298     foreach {s e} [rowranges $id] {
6299         if {$e >= $numcommits} {
6300             set e [expr {$numcommits - 1}]
6301         }
6302         if {$e <= $s} continue
6303         for {set row $e} {[incr row -1] >= $s} {} {
6304             set x [lsearch -exact [lindex $rowidlist $row] $id]
6305             if {$x < 0} break
6306             set olds [lindex $parentlist $row]
6307             set kid [lindex $displayorder $row]
6308             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6309             if {$kidx < 0} continue
6310             set nextrow [lindex $rowidlist [expr {$row + 1}]]
6311             foreach p $olds {
6312                 set px [lsearch -exact $nextrow $p]
6313                 if {$px < 0} continue
6314                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6315                     if {[lsearch -exact $ccross $p] >= 0} continue
6316                     if {$x == $px + ($kidx < $px? -1: 1)} {
6317                         lappend ccross $p
6318                     } elseif {[lsearch -exact $cross $p] < 0} {
6319                         lappend cross $p
6320                     }
6321                 }
6322             }
6323         }
6324     }
6325     return [concat $ccross {{}} $cross]
6326 }
6327
6328 proc assigncolor {id} {
6329     global colormap colors nextcolor
6330     global parents children children curview
6331
6332     if {[info exists colormap($id)]} return
6333     set ncolors [llength $colors]
6334     if {[info exists children($curview,$id)]} {
6335         set kids $children($curview,$id)
6336     } else {
6337         set kids {}
6338     }
6339     if {[llength $kids] == 1} {
6340         set child [lindex $kids 0]
6341         if {[info exists colormap($child)]
6342             && [llength $parents($curview,$child)] == 1} {
6343             set colormap($id) $colormap($child)
6344             return
6345         }
6346     }
6347     set badcolors {}
6348     set origbad {}
6349     foreach x [findcrossings $id] {
6350         if {$x eq {}} {
6351             # delimiter between corner crossings and other crossings
6352             if {[llength $badcolors] >= $ncolors - 1} break
6353             set origbad $badcolors
6354         }
6355         if {[info exists colormap($x)]
6356             && [lsearch -exact $badcolors $colormap($x)] < 0} {
6357             lappend badcolors $colormap($x)
6358         }
6359     }
6360     if {[llength $badcolors] >= $ncolors} {
6361         set badcolors $origbad
6362     }
6363     set origbad $badcolors
6364     if {[llength $badcolors] < $ncolors - 1} {
6365         foreach child $kids {
6366             if {[info exists colormap($child)]
6367                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6368                 lappend badcolors $colormap($child)
6369             }
6370             foreach p $parents($curview,$child) {
6371                 if {[info exists colormap($p)]
6372                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
6373                     lappend badcolors $colormap($p)
6374                 }
6375             }
6376         }
6377         if {[llength $badcolors] >= $ncolors} {
6378             set badcolors $origbad
6379         }
6380     }
6381     for {set i 0} {$i <= $ncolors} {incr i} {
6382         set c [lindex $colors $nextcolor]
6383         if {[incr nextcolor] >= $ncolors} {
6384             set nextcolor 0
6385         }
6386         if {[lsearch -exact $badcolors $c]} break
6387     }
6388     set colormap($id) $c
6389 }
6390
6391 proc bindline {t id} {
6392     global canv
6393
6394     $canv bind $t <Enter> "lineenter %x %y $id"
6395     $canv bind $t <Motion> "linemotion %x %y $id"
6396     $canv bind $t <Leave> "lineleave $id"
6397     $canv bind $t <Button-1> "lineclick %x %y $id 1"
6398 }
6399
6400 proc graph_pane_width {} {
6401     global use_ttk
6402
6403     if {$use_ttk} {
6404         set g [.tf.histframe.pwclist sashpos 0]
6405     } else {
6406         set g [.tf.histframe.pwclist sash coord 0]
6407     }
6408     return [lindex $g 0]
6409 }
6410
6411 proc totalwidth {l font extra} {
6412     set tot 0
6413     foreach str $l {
6414         set tot [expr {$tot + [font measure $font $str] + $extra}]
6415     }
6416     return $tot
6417 }
6418
6419 proc drawtags {id x xt y1} {
6420     global idtags idheads idotherrefs mainhead
6421     global linespc lthickness
6422     global canv rowtextx curview fgcolor bgcolor ctxbut
6423     global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6424     global tagbgcolor tagfgcolor tagoutlinecolor
6425     global reflinecolor
6426
6427     set marks {}
6428     set ntags 0
6429     set nheads 0
6430     set singletag 0
6431     set maxtags 3
6432     set maxtagpct 25
6433     set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6434     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6435     set extra [expr {$delta + $lthickness + $linespc}]
6436
6437     if {[info exists idtags($id)]} {
6438         set marks $idtags($id)
6439         set ntags [llength $marks]
6440         if {$ntags > $maxtags ||
6441             [totalwidth $marks mainfont $extra] > $maxwidth} {
6442             # show just a single "n tags..." tag
6443             set singletag 1
6444             if {$ntags == 1} {
6445                 set marks [list "tag..."]
6446             } else {
6447                 set marks [list [format "%d tags..." $ntags]]
6448             }
6449             set ntags 1
6450         }
6451     }
6452     if {[info exists idheads($id)]} {
6453         set marks [concat $marks $idheads($id)]
6454         set nheads [llength $idheads($id)]
6455     }
6456     if {[info exists idotherrefs($id)]} {
6457         set marks [concat $marks $idotherrefs($id)]
6458     }
6459     if {$marks eq {}} {
6460         return $xt
6461     }
6462
6463     set yt [expr {$y1 - 0.5 * $linespc}]
6464     set yb [expr {$yt + $linespc - 1}]
6465     set xvals {}
6466     set wvals {}
6467     set i -1
6468     foreach tag $marks {
6469         incr i
6470         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6471             set wid [font measure mainfontbold $tag]
6472         } else {
6473             set wid [font measure mainfont $tag]
6474         }
6475         lappend xvals $xt
6476         lappend wvals $wid
6477         set xt [expr {$xt + $wid + $extra}]
6478     }
6479     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6480                -width $lthickness -fill $reflinecolor -tags tag.$id]
6481     $canv lower $t
6482     foreach tag $marks x $xvals wid $wvals {
6483         set tag_quoted [string map {% %%} $tag]
6484         set xl [expr {$x + $delta}]
6485         set xr [expr {$x + $delta + $wid + $lthickness}]
6486         set font mainfont
6487         if {[incr ntags -1] >= 0} {
6488             # draw a tag
6489             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6490                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6491                        -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6492                        -tags tag.$id]
6493             if {$singletag} {
6494                 set tagclick [list showtags $id 1]
6495             } else {
6496                 set tagclick [list showtag $tag_quoted 1]
6497             }
6498             $canv bind $t <1> $tagclick
6499             set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6500         } else {
6501             # draw a head or other ref
6502             if {[incr nheads -1] >= 0} {
6503                 set col $headbgcolor
6504                 if {$tag eq $mainhead} {
6505                     set font mainfontbold
6506                 }
6507             } else {
6508                 set col "#ddddff"
6509             }
6510             set xl [expr {$xl - $delta/2}]
6511             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6512                 -width 1 -outline black -fill $col -tags tag.$id
6513             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6514                 set rwid [font measure mainfont $remoteprefix]
6515                 set xi [expr {$x + 1}]
6516                 set yti [expr {$yt + 1}]
6517                 set xri [expr {$x + $rwid}]
6518                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6519                         -width 0 -fill $remotebgcolor -tags tag.$id
6520             }
6521         }
6522         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6523                    -font $font -tags [list tag.$id text]]
6524         if {$ntags >= 0} {
6525             $canv bind $t <1> $tagclick
6526         } elseif {$nheads >= 0} {
6527             $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6528         }
6529     }
6530     return $xt
6531 }
6532
6533 proc drawnotesign {xt y} {
6534     global linespc canv fgcolor
6535
6536     set orad [expr {$linespc / 3}]
6537     set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6538                [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6539                -fill yellow -outline $fgcolor -width 1 -tags circle]
6540     set xt [expr {$xt + $orad * 3}]
6541     return $xt
6542 }
6543
6544 proc xcoord {i level ln} {
6545     global canvx0 xspc1 xspc2
6546
6547     set x [expr {$canvx0 + $i * $xspc1($ln)}]
6548     if {$i > 0 && $i == $level} {
6549         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6550     } elseif {$i > $level} {
6551         set x [expr {$x + $xspc2 - $xspc1($ln)}]
6552     }
6553     return $x
6554 }
6555
6556 proc show_status {msg} {
6557     global canv fgcolor
6558
6559     clear_display
6560     $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6561         -tags text -fill $fgcolor
6562 }
6563
6564 # Don't change the text pane cursor if it is currently the hand cursor,
6565 # showing that we are over a sha1 ID link.
6566 proc settextcursor {c} {
6567     global ctext curtextcursor
6568
6569     if {[$ctext cget -cursor] == $curtextcursor} {
6570         $ctext config -cursor $c
6571     }
6572     set curtextcursor $c
6573 }
6574
6575 proc nowbusy {what {name {}}} {
6576     global isbusy busyname statusw
6577
6578     if {[array names isbusy] eq {}} {
6579         . config -cursor watch
6580         settextcursor watch
6581     }
6582     set isbusy($what) 1
6583     set busyname($what) $name
6584     if {$name ne {}} {
6585         $statusw conf -text $name
6586     }
6587 }
6588
6589 proc notbusy {what} {
6590     global isbusy maincursor textcursor busyname statusw
6591
6592     catch {
6593         unset isbusy($what)
6594         if {$busyname($what) ne {} &&
6595             [$statusw cget -text] eq $busyname($what)} {
6596             $statusw conf -text {}
6597         }
6598     }
6599     if {[array names isbusy] eq {}} {
6600         . config -cursor $maincursor
6601         settextcursor $textcursor
6602     }
6603 }
6604
6605 proc findmatches {f} {
6606     global findtype findstring
6607     if {$findtype == [mc "Regexp"]} {
6608         set matches [regexp -indices -all -inline $findstring $f]
6609     } else {
6610         set fs $findstring
6611         if {$findtype == [mc "IgnCase"]} {
6612             set f [string tolower $f]
6613             set fs [string tolower $fs]
6614         }
6615         set matches {}
6616         set i 0
6617         set l [string length $fs]
6618         while {[set j [string first $fs $f $i]] >= 0} {
6619             lappend matches [list $j [expr {$j+$l-1}]]
6620             set i [expr {$j + $l}]
6621         }
6622     }
6623     return $matches
6624 }
6625
6626 proc dofind {{dirn 1} {wrap 1}} {
6627     global findstring findstartline findcurline selectedline numcommits
6628     global gdttype filehighlight fh_serial find_dirn findallowwrap
6629
6630     if {[info exists find_dirn]} {
6631         if {$find_dirn == $dirn} return
6632         stopfinding
6633     }
6634     focus .
6635     if {$findstring eq {} || $numcommits == 0} return
6636     if {$selectedline eq {}} {
6637         set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6638     } else {
6639         set findstartline $selectedline
6640     }
6641     set findcurline $findstartline
6642     nowbusy finding [mc "Searching"]
6643     if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6644         after cancel do_file_hl $fh_serial
6645         do_file_hl $fh_serial
6646     }
6647     set find_dirn $dirn
6648     set findallowwrap $wrap
6649     run findmore
6650 }
6651
6652 proc stopfinding {} {
6653     global find_dirn findcurline fprogcoord
6654
6655     if {[info exists find_dirn]} {
6656         unset find_dirn
6657         unset findcurline
6658         notbusy finding
6659         set fprogcoord 0
6660         adjustprogress
6661     }
6662     stopblaming
6663 }
6664
6665 proc findmore {} {
6666     global commitdata commitinfo numcommits findpattern findloc
6667     global findstartline findcurline findallowwrap
6668     global find_dirn gdttype fhighlights fprogcoord
6669     global curview varcorder vrownum varccommits vrowmod
6670
6671     if {![info exists find_dirn]} {
6672         return 0
6673     }
6674     set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6675     set l $findcurline
6676     set moretodo 0
6677     if {$find_dirn > 0} {
6678         incr l
6679         if {$l >= $numcommits} {
6680             set l 0
6681         }
6682         if {$l <= $findstartline} {
6683             set lim [expr {$findstartline + 1}]
6684         } else {
6685             set lim $numcommits
6686             set moretodo $findallowwrap
6687         }
6688     } else {
6689         if {$l == 0} {
6690             set l $numcommits
6691         }
6692         incr l -1
6693         if {$l >= $findstartline} {
6694             set lim [expr {$findstartline - 1}]
6695         } else {
6696             set lim -1
6697             set moretodo $findallowwrap
6698         }
6699     }
6700     set n [expr {($lim - $l) * $find_dirn}]
6701     if {$n > 500} {
6702         set n 500
6703         set moretodo 1
6704     }
6705     if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6706         update_arcrows $curview
6707     }
6708     set found 0
6709     set domore 1
6710     set ai [bsearch $vrownum($curview) $l]
6711     set a [lindex $varcorder($curview) $ai]
6712     set arow [lindex $vrownum($curview) $ai]
6713     set ids [lindex $varccommits($curview,$a)]
6714     set arowend [expr {$arow + [llength $ids]}]
6715     if {$gdttype eq [mc "containing:"]} {
6716         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6717             if {$l < $arow || $l >= $arowend} {
6718                 incr ai $find_dirn
6719                 set a [lindex $varcorder($curview) $ai]
6720                 set arow [lindex $vrownum($curview) $ai]
6721                 set ids [lindex $varccommits($curview,$a)]
6722                 set arowend [expr {$arow + [llength $ids]}]
6723             }
6724             set id [lindex $ids [expr {$l - $arow}]]
6725             # shouldn't happen unless git log doesn't give all the commits...
6726             if {![info exists commitdata($id)] ||
6727                 ![doesmatch $commitdata($id)]} {
6728                 continue
6729             }
6730             if {![info exists commitinfo($id)]} {
6731                 getcommit $id
6732             }
6733             set info $commitinfo($id)
6734             foreach f $info ty $fldtypes {
6735                 if {$ty eq ""} continue
6736                 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6737                     [doesmatch $f]} {
6738                     set found 1
6739                     break
6740                 }
6741             }
6742             if {$found} break
6743         }
6744     } else {
6745         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6746             if {$l < $arow || $l >= $arowend} {
6747                 incr ai $find_dirn
6748                 set a [lindex $varcorder($curview) $ai]
6749                 set arow [lindex $vrownum($curview) $ai]
6750                 set ids [lindex $varccommits($curview,$a)]
6751                 set arowend [expr {$arow + [llength $ids]}]
6752             }
6753             set id [lindex $ids [expr {$l - $arow}]]
6754             if {![info exists fhighlights($id)]} {
6755                 # this sets fhighlights($id) to -1
6756                 askfilehighlight $l $id
6757             }
6758             if {$fhighlights($id) > 0} {
6759                 set found $domore
6760                 break
6761             }
6762             if {$fhighlights($id) < 0} {
6763                 if {$domore} {
6764                     set domore 0
6765                     set findcurline [expr {$l - $find_dirn}]
6766                 }
6767             }
6768         }
6769     }
6770     if {$found || ($domore && !$moretodo)} {
6771         unset findcurline
6772         unset find_dirn
6773         notbusy finding
6774         set fprogcoord 0
6775         adjustprogress
6776         if {$found} {
6777             findselectline $l
6778         } else {
6779             bell
6780         }
6781         return 0
6782     }
6783     if {!$domore} {
6784         flushhighlights
6785     } else {
6786         set findcurline [expr {$l - $find_dirn}]
6787     }
6788     set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6789     if {$n < 0} {
6790         incr n $numcommits
6791     }
6792     set fprogcoord [expr {$n * 1.0 / $numcommits}]
6793     adjustprogress
6794     return $domore
6795 }
6796
6797 proc findselectline {l} {
6798     global findloc commentend ctext findcurline markingmatches gdttype
6799
6800     set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6801     set findcurline $l
6802     selectline $l 1
6803     if {$markingmatches &&
6804         ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6805         # highlight the matches in the comments
6806         set f [$ctext get 1.0 $commentend]
6807         set matches [findmatches $f]
6808         foreach match $matches {
6809             set start [lindex $match 0]
6810             set end [expr {[lindex $match 1] + 1}]
6811             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6812         }
6813     }
6814     drawvisible
6815 }
6816
6817 # mark the bits of a headline or author that match a find string
6818 proc markmatches {canv l str tag matches font row} {
6819     global selectedline
6820
6821     set bbox [$canv bbox $tag]
6822     set x0 [lindex $bbox 0]
6823     set y0 [lindex $bbox 1]
6824     set y1 [lindex $bbox 3]
6825     foreach match $matches {
6826         set start [lindex $match 0]
6827         set end [lindex $match 1]
6828         if {$start > $end} continue
6829         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6830         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6831         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6832                    [expr {$x0+$xlen+2}] $y1 \
6833                    -outline {} -tags [list match$l matches] -fill yellow]
6834         $canv lower $t
6835         if {$row == $selectedline} {
6836             $canv raise $t secsel
6837         }
6838     }
6839 }
6840
6841 proc unmarkmatches {} {
6842     global markingmatches
6843
6844     allcanvs delete matches
6845     set markingmatches 0
6846     stopfinding
6847 }
6848
6849 proc selcanvline {w x y} {
6850     global canv canvy0 ctext linespc
6851     global rowtextx
6852     set ymax [lindex [$canv cget -scrollregion] 3]
6853     if {$ymax == {}} return
6854     set yfrac [lindex [$canv yview] 0]
6855     set y [expr {$y + $yfrac * $ymax}]
6856     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6857     if {$l < 0} {
6858         set l 0
6859     }
6860     if {$w eq $canv} {
6861         set xmax [lindex [$canv cget -scrollregion] 2]
6862         set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6863         if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6864     }
6865     unmarkmatches
6866     selectline $l 1
6867 }
6868
6869 proc commit_descriptor {p} {
6870     global commitinfo
6871     if {![info exists commitinfo($p)]} {
6872         getcommit $p
6873     }
6874     set l "..."
6875     if {[llength $commitinfo($p)] > 1} {
6876         set l [lindex $commitinfo($p) 0]
6877     }
6878     return "$p ($l)\n"
6879 }
6880
6881 # append some text to the ctext widget, and make any SHA1 ID
6882 # that we know about be a clickable link.
6883 proc appendwithlinks {text tags} {
6884     global ctext linknum curview
6885
6886     set start [$ctext index "end - 1c"]
6887     $ctext insert end $text $tags
6888     set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
6889     foreach l $links {
6890         set s [lindex $l 0]
6891         set e [lindex $l 1]
6892         set linkid [string range $text $s $e]
6893         incr e
6894         $ctext tag delete link$linknum
6895         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6896         setlink $linkid link$linknum
6897         incr linknum
6898     }
6899 }
6900
6901 proc setlink {id lk} {
6902     global curview ctext pendinglinks
6903     global linkfgcolor
6904
6905     if {[string range $id 0 1] eq "-g"} {
6906       set id [string range $id 2 end]
6907     }
6908
6909     set known 0
6910     if {[string length $id] < 40} {
6911         set matches [longid $id]
6912         if {[llength $matches] > 0} {
6913             if {[llength $matches] > 1} return
6914             set known 1
6915             set id [lindex $matches 0]
6916         }
6917     } else {
6918         set known [commitinview $id $curview]
6919     }
6920     if {$known} {
6921         $ctext tag conf $lk -foreground $linkfgcolor -underline 1
6922         $ctext tag bind $lk <1> [list selbyid $id]
6923         $ctext tag bind $lk <Enter> {linkcursor %W 1}
6924         $ctext tag bind $lk <Leave> {linkcursor %W -1}
6925     } else {
6926         lappend pendinglinks($id) $lk
6927         interestedin $id {makelink %P}
6928     }
6929 }
6930
6931 proc appendshortlink {id {pre {}} {post {}}} {
6932     global ctext linknum
6933
6934     $ctext insert end $pre
6935     $ctext tag delete link$linknum
6936     $ctext insert end [string range $id 0 7] link$linknum
6937     $ctext insert end $post
6938     setlink $id link$linknum
6939     incr linknum
6940 }
6941
6942 proc makelink {id} {
6943     global pendinglinks
6944
6945     if {![info exists pendinglinks($id)]} return
6946     foreach lk $pendinglinks($id) {
6947         setlink $id $lk
6948     }
6949     unset pendinglinks($id)
6950 }
6951
6952 proc linkcursor {w inc} {
6953     global linkentercount curtextcursor
6954
6955     if {[incr linkentercount $inc] > 0} {
6956         $w configure -cursor hand2
6957     } else {
6958         $w configure -cursor $curtextcursor
6959         if {$linkentercount < 0} {
6960             set linkentercount 0
6961         }
6962     }
6963 }
6964
6965 proc viewnextline {dir} {
6966     global canv linespc
6967
6968     $canv delete hover
6969     set ymax [lindex [$canv cget -scrollregion] 3]
6970     set wnow [$canv yview]
6971     set wtop [expr {[lindex $wnow 0] * $ymax}]
6972     set newtop [expr {$wtop + $dir * $linespc}]
6973     if {$newtop < 0} {
6974         set newtop 0
6975     } elseif {$newtop > $ymax} {
6976         set newtop $ymax
6977     }
6978     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6979 }
6980
6981 # add a list of tag or branch names at position pos
6982 # returns the number of names inserted
6983 proc appendrefs {pos ids var} {
6984     global ctext linknum curview $var maxrefs visiblerefs mainheadid
6985
6986     if {[catch {$ctext index $pos}]} {
6987         return 0
6988     }
6989     $ctext conf -state normal
6990     $ctext delete $pos "$pos lineend"
6991     set tags {}
6992     foreach id $ids {
6993         foreach tag [set $var\($id\)] {
6994             lappend tags [list $tag $id]
6995         }
6996     }
6997
6998     set sep {}
6999     set tags [lsort -index 0 -decreasing $tags]
7000     set nutags 0
7001
7002     if {[llength $tags] > $maxrefs} {
7003         # If we are displaying heads, and there are too many,
7004         # see if there are some important heads to display.
7005         # Currently that are the current head and heads listed in $visiblerefs option
7006         set itags {}
7007         if {$var eq "idheads"} {
7008             set utags {}
7009             foreach ti $tags {
7010                 set hname [lindex $ti 0]
7011                 set id [lindex $ti 1]
7012                 if {([lsearch -exact $visiblerefs $hname] != -1 || $id eq $mainheadid) &&
7013                     [llength $itags] < $maxrefs} {
7014                     lappend itags $ti
7015                 } else {
7016                     lappend utags $ti
7017                 }
7018             }
7019             set tags $utags
7020         }
7021         if {$itags ne {}} {
7022             set str [mc "and many more"]
7023             set sep " "
7024         } else {
7025             set str [mc "many"]
7026         }
7027         $ctext insert $pos "$str ([llength $tags])"
7028         set nutags [llength $tags]
7029         set tags $itags
7030     }
7031
7032     foreach ti $tags {
7033         set id [lindex $ti 1]
7034         set lk link$linknum
7035         incr linknum
7036         $ctext tag delete $lk
7037         $ctext insert $pos $sep
7038         $ctext insert $pos [lindex $ti 0] $lk
7039         setlink $id $lk
7040         set sep ", "
7041     }
7042     $ctext tag add wwrap "$pos linestart" "$pos lineend"
7043     $ctext conf -state disabled
7044     return [expr {[llength $tags] + $nutags}]
7045 }
7046
7047 # called when we have finished computing the nearby tags
7048 proc dispneartags {delay} {
7049     global selectedline currentid showneartags tagphase
7050
7051     if {$selectedline eq {} || !$showneartags} return
7052     after cancel dispnexttag
7053     if {$delay} {
7054         after 200 dispnexttag
7055         set tagphase -1
7056     } else {
7057         after idle dispnexttag
7058         set tagphase 0
7059     }
7060 }
7061
7062 proc dispnexttag {} {
7063     global selectedline currentid showneartags tagphase ctext
7064
7065     if {$selectedline eq {} || !$showneartags} return
7066     switch -- $tagphase {
7067         0 {
7068             set dtags [desctags $currentid]
7069             if {$dtags ne {}} {
7070                 appendrefs precedes $dtags idtags
7071             }
7072         }
7073         1 {
7074             set atags [anctags $currentid]
7075             if {$atags ne {}} {
7076                 appendrefs follows $atags idtags
7077             }
7078         }
7079         2 {
7080             set dheads [descheads $currentid]
7081             if {$dheads ne {}} {
7082                 if {[appendrefs branch $dheads idheads] > 1
7083                     && [$ctext get "branch -3c"] eq "h"} {
7084                     # turn "Branch" into "Branches"
7085                     $ctext conf -state normal
7086                     $ctext insert "branch -2c" "es"
7087                     $ctext conf -state disabled
7088                 }
7089             }
7090         }
7091     }
7092     if {[incr tagphase] <= 2} {
7093         after idle dispnexttag
7094     }
7095 }
7096
7097 proc make_secsel {id} {
7098     global linehtag linentag linedtag canv canv2 canv3
7099
7100     if {![info exists linehtag($id)]} return
7101     $canv delete secsel
7102     set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7103                -tags secsel -fill [$canv cget -selectbackground]]
7104     $canv lower $t
7105     $canv2 delete secsel
7106     set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7107                -tags secsel -fill [$canv2 cget -selectbackground]]
7108     $canv2 lower $t
7109     $canv3 delete secsel
7110     set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7111                -tags secsel -fill [$canv3 cget -selectbackground]]
7112     $canv3 lower $t
7113 }
7114
7115 proc make_idmark {id} {
7116     global linehtag canv fgcolor
7117
7118     if {![info exists linehtag($id)]} return
7119     $canv delete markid
7120     set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7121                -tags markid -outline $fgcolor]
7122     $canv raise $t
7123 }
7124
7125 proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
7126     global canv ctext commitinfo selectedline
7127     global canvy0 linespc parents children curview
7128     global currentid sha1entry
7129     global commentend idtags linknum
7130     global mergemax numcommits pending_select
7131     global cmitmode showneartags allcommits
7132     global targetrow targetid lastscrollrows
7133     global autoselect autosellen jump_to_here
7134     global vinlinediff
7135
7136     catch {unset pending_select}
7137     $canv delete hover
7138     normalline
7139     unsel_reflist
7140     stopfinding
7141     if {$l < 0 || $l >= $numcommits} return
7142     set id [commitonrow $l]
7143     set targetid $id
7144     set targetrow $l
7145     set selectedline $l
7146     set currentid $id
7147     if {$lastscrollrows < $numcommits} {
7148         setcanvscroll
7149     }
7150
7151     if {$cmitmode ne "patch" && $switch_to_patch} {
7152         set cmitmode "patch"
7153     }
7154
7155     set y [expr {$canvy0 + $l * $linespc}]
7156     set ymax [lindex [$canv cget -scrollregion] 3]
7157     set ytop [expr {$y - $linespc - 1}]
7158     set ybot [expr {$y + $linespc + 1}]
7159     set wnow [$canv yview]
7160     set wtop [expr {[lindex $wnow 0] * $ymax}]
7161     set wbot [expr {[lindex $wnow 1] * $ymax}]
7162     set wh [expr {$wbot - $wtop}]
7163     set newtop $wtop
7164     if {$ytop < $wtop} {
7165         if {$ybot < $wtop} {
7166             set newtop [expr {$y - $wh / 2.0}]
7167         } else {
7168             set newtop $ytop
7169             if {$newtop > $wtop - $linespc} {
7170                 set newtop [expr {$wtop - $linespc}]
7171             }
7172         }
7173     } elseif {$ybot > $wbot} {
7174         if {$ytop > $wbot} {
7175             set newtop [expr {$y - $wh / 2.0}]
7176         } else {
7177             set newtop [expr {$ybot - $wh}]
7178             if {$newtop < $wtop + $linespc} {
7179                 set newtop [expr {$wtop + $linespc}]
7180             }
7181         }
7182     }
7183     if {$newtop != $wtop} {
7184         if {$newtop < 0} {
7185             set newtop 0
7186         }
7187         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7188         drawvisible
7189     }
7190
7191     make_secsel $id
7192
7193     if {$isnew} {
7194         addtohistory [list selbyid $id 0] savecmitpos
7195     }
7196
7197     $sha1entry delete 0 end
7198     $sha1entry insert 0 $id
7199     if {$autoselect} {
7200         $sha1entry selection range 0 $autosellen
7201     }
7202     rhighlight_sel $id
7203
7204     $ctext conf -state normal
7205     clear_ctext
7206     set linknum 0
7207     if {![info exists commitinfo($id)]} {
7208         getcommit $id
7209     }
7210     set info $commitinfo($id)
7211     set date [formatdate [lindex $info 2]]
7212     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7213     set date [formatdate [lindex $info 4]]
7214     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7215     if {[info exists idtags($id)]} {
7216         $ctext insert end [mc "Tags:"]
7217         foreach tag $idtags($id) {
7218             $ctext insert end " $tag"
7219         }
7220         $ctext insert end "\n"
7221     }
7222
7223     set headers {}
7224     set olds $parents($curview,$id)
7225     if {[llength $olds] > 1} {
7226         set np 0
7227         foreach p $olds {
7228             if {$np >= $mergemax} {
7229                 set tag mmax
7230             } else {
7231                 set tag m$np
7232             }
7233             $ctext insert end "[mc "Parent"]: " $tag
7234             appendwithlinks [commit_descriptor $p] {}
7235             incr np
7236         }
7237     } else {
7238         foreach p $olds {
7239             append headers "[mc "Parent"]: [commit_descriptor $p]"
7240         }
7241     }
7242
7243     foreach c $children($curview,$id) {
7244         append headers "[mc "Child"]:  [commit_descriptor $c]"
7245     }
7246
7247     # make anything that looks like a SHA1 ID be a clickable link
7248     appendwithlinks $headers {}
7249     if {$showneartags} {
7250         if {![info exists allcommits]} {
7251             getallcommits
7252         }
7253         $ctext insert end "[mc "Branch"]: "
7254         $ctext mark set branch "end -1c"
7255         $ctext mark gravity branch left
7256         $ctext insert end "\n[mc "Follows"]: "
7257         $ctext mark set follows "end -1c"
7258         $ctext mark gravity follows left
7259         $ctext insert end "\n[mc "Precedes"]: "
7260         $ctext mark set precedes "end -1c"
7261         $ctext mark gravity precedes left
7262         $ctext insert end "\n"
7263         dispneartags 1
7264     }
7265     $ctext insert end "\n"
7266     set comment [lindex $info 5]
7267     if {[string first "\r" $comment] >= 0} {
7268         set comment [string map {"\r" "\n    "} $comment]
7269     }
7270     appendwithlinks $comment {comment}
7271
7272     $ctext tag remove found 1.0 end
7273     $ctext conf -state disabled
7274     set commentend [$ctext index "end - 1c"]
7275
7276     set jump_to_here $desired_loc
7277     init_flist [mc "Comments"]
7278     if {$cmitmode eq "tree"} {
7279         gettree $id
7280     } elseif {$vinlinediff($curview) == 1} {
7281         showinlinediff $id
7282     } elseif {[llength $olds] <= 1} {
7283         startdiff $id
7284     } else {
7285         mergediff $id
7286     }
7287 }
7288
7289 proc selfirstline {} {
7290     unmarkmatches
7291     selectline 0 1
7292 }
7293
7294 proc sellastline {} {
7295     global numcommits
7296     unmarkmatches
7297     set l [expr {$numcommits - 1}]
7298     selectline $l 1
7299 }
7300
7301 proc selnextline {dir} {
7302     global selectedline
7303     focus .
7304     if {$selectedline eq {}} return
7305     set l [expr {$selectedline + $dir}]
7306     unmarkmatches
7307     selectline $l 1
7308 }
7309
7310 proc selnextpage {dir} {
7311     global canv linespc selectedline numcommits
7312
7313     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7314     if {$lpp < 1} {
7315         set lpp 1
7316     }
7317     allcanvs yview scroll [expr {$dir * $lpp}] units
7318     drawvisible
7319     if {$selectedline eq {}} return
7320     set l [expr {$selectedline + $dir * $lpp}]
7321     if {$l < 0} {
7322         set l 0
7323     } elseif {$l >= $numcommits} {
7324         set l [expr $numcommits - 1]
7325     }
7326     unmarkmatches
7327     selectline $l 1
7328 }
7329
7330 proc unselectline {} {
7331     global selectedline currentid
7332
7333     set selectedline {}
7334     catch {unset currentid}
7335     allcanvs delete secsel
7336     rhighlight_none
7337 }
7338
7339 proc reselectline {} {
7340     global selectedline
7341
7342     if {$selectedline ne {}} {
7343         selectline $selectedline 0
7344     }
7345 }
7346
7347 proc addtohistory {cmd {saveproc {}}} {
7348     global history historyindex curview
7349
7350     unset_posvars
7351     save_position
7352     set elt [list $curview $cmd $saveproc {}]
7353     if {$historyindex > 0
7354         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7355         return
7356     }
7357
7358     if {$historyindex < [llength $history]} {
7359         set history [lreplace $history $historyindex end $elt]
7360     } else {
7361         lappend history $elt
7362     }
7363     incr historyindex
7364     if {$historyindex > 1} {
7365         .tf.bar.leftbut conf -state normal
7366     } else {
7367         .tf.bar.leftbut conf -state disabled
7368     }
7369     .tf.bar.rightbut conf -state disabled
7370 }
7371
7372 # save the scrolling position of the diff display pane
7373 proc save_position {} {
7374     global historyindex history
7375
7376     if {$historyindex < 1} return
7377     set hi [expr {$historyindex - 1}]
7378     set fn [lindex $history $hi 2]
7379     if {$fn ne {}} {
7380         lset history $hi 3 [eval $fn]
7381     }
7382 }
7383
7384 proc unset_posvars {} {
7385     global last_posvars
7386
7387     if {[info exists last_posvars]} {
7388         foreach {var val} $last_posvars {
7389             global $var
7390             catch {unset $var}
7391         }
7392         unset last_posvars
7393     }
7394 }
7395
7396 proc godo {elt} {
7397     global curview last_posvars
7398
7399     set view [lindex $elt 0]
7400     set cmd [lindex $elt 1]
7401     set pv [lindex $elt 3]
7402     if {$curview != $view} {
7403         showview $view
7404     }
7405     unset_posvars
7406     foreach {var val} $pv {
7407         global $var
7408         set $var $val
7409     }
7410     set last_posvars $pv
7411     eval $cmd
7412 }
7413
7414 proc goback {} {
7415     global history historyindex
7416     focus .
7417
7418     if {$historyindex > 1} {
7419         save_position
7420         incr historyindex -1
7421         godo [lindex $history [expr {$historyindex - 1}]]
7422         .tf.bar.rightbut conf -state normal
7423     }
7424     if {$historyindex <= 1} {
7425         .tf.bar.leftbut conf -state disabled
7426     }
7427 }
7428
7429 proc goforw {} {
7430     global history historyindex
7431     focus .
7432
7433     if {$historyindex < [llength $history]} {
7434         save_position
7435         set cmd [lindex $history $historyindex]
7436         incr historyindex
7437         godo $cmd
7438         .tf.bar.leftbut conf -state normal
7439     }
7440     if {$historyindex >= [llength $history]} {
7441         .tf.bar.rightbut conf -state disabled
7442     }
7443 }
7444
7445 proc go_to_parent {i} {
7446     global parents curview targetid
7447     set ps $parents($curview,$targetid)
7448     if {[llength $ps] >= $i} {
7449         selbyid [lindex $ps [expr $i - 1]]
7450     }
7451 }
7452
7453 proc gettree {id} {
7454     global treefilelist treeidlist diffids diffmergeid treepending
7455     global nullid nullid2
7456
7457     set diffids $id
7458     catch {unset diffmergeid}
7459     if {![info exists treefilelist($id)]} {
7460         if {![info exists treepending]} {
7461             if {$id eq $nullid} {
7462                 set cmd [list | git ls-files]
7463             } elseif {$id eq $nullid2} {
7464                 set cmd [list | git ls-files --stage -t]
7465             } else {
7466                 set cmd [list | git ls-tree -r $id]
7467             }
7468             if {[catch {set gtf [open $cmd r]}]} {
7469                 return
7470             }
7471             set treepending $id
7472             set treefilelist($id) {}
7473             set treeidlist($id) {}
7474             fconfigure $gtf -blocking 0 -encoding binary
7475             filerun $gtf [list gettreeline $gtf $id]
7476         }
7477     } else {
7478         setfilelist $id
7479     }
7480 }
7481
7482 proc gettreeline {gtf id} {
7483     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7484
7485     set nl 0
7486     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7487         if {$diffids eq $nullid} {
7488             set fname $line
7489         } else {
7490             set i [string first "\t" $line]
7491             if {$i < 0} continue
7492             set fname [string range $line [expr {$i+1}] end]
7493             set line [string range $line 0 [expr {$i-1}]]
7494             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7495             set sha1 [lindex $line 2]
7496             lappend treeidlist($id) $sha1
7497         }
7498         if {[string index $fname 0] eq "\""} {
7499             set fname [lindex $fname 0]
7500         }
7501         set fname [encoding convertfrom $fname]
7502         lappend treefilelist($id) $fname
7503     }
7504     if {![eof $gtf]} {
7505         return [expr {$nl >= 1000? 2: 1}]
7506     }
7507     close $gtf
7508     unset treepending
7509     if {$cmitmode ne "tree"} {
7510         if {![info exists diffmergeid]} {
7511             gettreediffs $diffids
7512         }
7513     } elseif {$id ne $diffids} {
7514         gettree $diffids
7515     } else {
7516         setfilelist $id
7517     }
7518     return 0
7519 }
7520
7521 proc showfile {f} {
7522     global treefilelist treeidlist diffids nullid nullid2
7523     global ctext_file_names ctext_file_lines
7524     global ctext commentend
7525
7526     set i [lsearch -exact $treefilelist($diffids) $f]
7527     if {$i < 0} {
7528         puts "oops, $f not in list for id $diffids"
7529         return
7530     }
7531     if {$diffids eq $nullid} {
7532         if {[catch {set bf [open $f r]} err]} {
7533             puts "oops, can't read $f: $err"
7534             return
7535         }
7536     } else {
7537         set blob [lindex $treeidlist($diffids) $i]
7538         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7539             puts "oops, error reading blob $blob: $err"
7540             return
7541         }
7542     }
7543     fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7544     filerun $bf [list getblobline $bf $diffids]
7545     $ctext config -state normal
7546     clear_ctext $commentend
7547     lappend ctext_file_names $f
7548     lappend ctext_file_lines [lindex [split $commentend "."] 0]
7549     $ctext insert end "\n"
7550     $ctext insert end "$f\n" filesep
7551     $ctext config -state disabled
7552     $ctext yview $commentend
7553     settabs 0
7554 }
7555
7556 proc getblobline {bf id} {
7557     global diffids cmitmode ctext
7558
7559     if {$id ne $diffids || $cmitmode ne "tree"} {
7560         catch {close $bf}
7561         return 0
7562     }
7563     $ctext config -state normal
7564     set nl 0
7565     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7566         $ctext insert end "$line\n"
7567     }
7568     if {[eof $bf]} {
7569         global jump_to_here ctext_file_names commentend
7570
7571         # delete last newline
7572         $ctext delete "end - 2c" "end - 1c"
7573         close $bf
7574         if {$jump_to_here ne {} &&
7575             [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7576             set lnum [expr {[lindex $jump_to_here 1] +
7577                             [lindex [split $commentend .] 0]}]
7578             mark_ctext_line $lnum
7579         }
7580         $ctext config -state disabled
7581         return 0
7582     }
7583     $ctext config -state disabled
7584     return [expr {$nl >= 1000? 2: 1}]
7585 }
7586
7587 proc mark_ctext_line {lnum} {
7588     global ctext markbgcolor
7589
7590     $ctext tag delete omark
7591     $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7592     $ctext tag conf omark -background $markbgcolor
7593     $ctext see $lnum.0
7594 }
7595
7596 proc mergediff {id} {
7597     global diffmergeid
7598     global diffids treediffs
7599     global parents curview
7600
7601     set diffmergeid $id
7602     set diffids $id
7603     set treediffs($id) {}
7604     set np [llength $parents($curview,$id)]
7605     settabs $np
7606     getblobdiffs $id
7607 }
7608
7609 proc startdiff {ids} {
7610     global treediffs diffids treepending diffmergeid nullid nullid2
7611
7612     settabs 1
7613     set diffids $ids
7614     catch {unset diffmergeid}
7615     if {![info exists treediffs($ids)] ||
7616         [lsearch -exact $ids $nullid] >= 0 ||
7617         [lsearch -exact $ids $nullid2] >= 0} {
7618         if {![info exists treepending]} {
7619             gettreediffs $ids
7620         }
7621     } else {
7622         addtocflist $ids
7623     }
7624 }
7625
7626 proc showinlinediff {ids} {
7627     global commitinfo commitdata ctext
7628     global treediffs
7629
7630     set info $commitinfo($ids)
7631     set diff [lindex $info 7]
7632     set difflines [split $diff "\n"]
7633
7634     initblobdiffvars
7635     set treediff {}
7636
7637     set inhdr 0
7638     foreach line $difflines {
7639         if {![string compare -length 5 "diff " $line]} {
7640             set inhdr 1
7641         } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7642             # offset also accounts for the b/ prefix
7643             lappend treediff [string range $line 6 end]
7644             set inhdr 0
7645         }
7646     }
7647
7648     set treediffs($ids) $treediff
7649     add_flist $treediff
7650
7651     $ctext conf -state normal
7652     foreach line $difflines {
7653         parseblobdiffline $ids $line
7654     }
7655     maybe_scroll_ctext 1
7656     $ctext conf -state disabled
7657 }
7658
7659 # If the filename (name) is under any of the passed filter paths
7660 # then return true to include the file in the listing.
7661 proc path_filter {filter name} {
7662     set worktree [gitworktree]
7663     foreach p $filter {
7664         set fq_p [file normalize $p]
7665         set fq_n [file normalize [file join $worktree $name]]
7666         if {[string match [file normalize $fq_p]* $fq_n]} {
7667             return 1
7668         }
7669     }
7670     return 0
7671 }
7672
7673 proc addtocflist {ids} {
7674     global treediffs
7675
7676     add_flist $treediffs($ids)
7677     getblobdiffs $ids
7678 }
7679
7680 proc diffcmd {ids flags} {
7681     global log_showroot nullid nullid2 git_version
7682
7683     set i [lsearch -exact $ids $nullid]
7684     set j [lsearch -exact $ids $nullid2]
7685     if {$i >= 0} {
7686         if {[llength $ids] > 1 && $j < 0} {
7687             # comparing working directory with some specific revision
7688             set cmd [concat | git diff-index $flags]
7689             if {$i == 0} {
7690                 lappend cmd -R [lindex $ids 1]
7691             } else {
7692                 lappend cmd [lindex $ids 0]
7693             }
7694         } else {
7695             # comparing working directory with index
7696             set cmd [concat | git diff-files $flags]
7697             if {$j == 1} {
7698                 lappend cmd -R
7699             }
7700         }
7701     } elseif {$j >= 0} {
7702         if {[package vcompare $git_version "1.7.2"] >= 0} {
7703             set flags "$flags --ignore-submodules=dirty"
7704         }
7705         set cmd [concat | git diff-index --cached $flags]
7706         if {[llength $ids] > 1} {
7707             # comparing index with specific revision
7708             if {$j == 0} {
7709                 lappend cmd -R [lindex $ids 1]
7710             } else {
7711                 lappend cmd [lindex $ids 0]
7712             }
7713         } else {
7714             # comparing index with HEAD
7715             lappend cmd HEAD
7716         }
7717     } else {
7718         if {$log_showroot} {
7719             lappend flags --root
7720         }
7721         set cmd [concat | git diff-tree -r $flags $ids]
7722     }
7723     return $cmd
7724 }
7725
7726 proc gettreediffs {ids} {
7727     global treediff treepending limitdiffs vfilelimit curview
7728
7729     set cmd [diffcmd $ids {--no-commit-id}]
7730     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7731             set cmd [concat $cmd -- $vfilelimit($curview)]
7732     }
7733     if {[catch {set gdtf [open $cmd r]}]} return
7734
7735     set treepending $ids
7736     set treediff {}
7737     fconfigure $gdtf -blocking 0 -encoding binary
7738     filerun $gdtf [list gettreediffline $gdtf $ids]
7739 }
7740
7741 proc gettreediffline {gdtf ids} {
7742     global treediff treediffs treepending diffids diffmergeid
7743     global cmitmode vfilelimit curview limitdiffs perfile_attrs
7744
7745     set nr 0
7746     set sublist {}
7747     set max 1000
7748     if {$perfile_attrs} {
7749         # cache_gitattr is slow, and even slower on win32 where we
7750         # have to invoke it for only about 30 paths at a time
7751         set max 500
7752         if {[tk windowingsystem] == "win32"} {
7753             set max 120
7754         }
7755     }
7756     while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7757         set i [string first "\t" $line]
7758         if {$i >= 0} {
7759             set file [string range $line [expr {$i+1}] end]
7760             if {[string index $file 0] eq "\""} {
7761                 set file [lindex $file 0]
7762             }
7763             set file [encoding convertfrom $file]
7764             if {$file ne [lindex $treediff end]} {
7765                 lappend treediff $file
7766                 lappend sublist $file
7767             }
7768         }
7769     }
7770     if {$perfile_attrs} {
7771         cache_gitattr encoding $sublist
7772     }
7773     if {![eof $gdtf]} {
7774         return [expr {$nr >= $max? 2: 1}]
7775     }
7776     close $gdtf
7777     set treediffs($ids) $treediff
7778     unset treepending
7779     if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7780         gettree $diffids
7781     } elseif {$ids != $diffids} {
7782         if {![info exists diffmergeid]} {
7783             gettreediffs $diffids
7784         }
7785     } else {
7786         addtocflist $ids
7787     }
7788     return 0
7789 }
7790
7791 # empty string or positive integer
7792 proc diffcontextvalidate {v} {
7793     return [regexp {^(|[1-9][0-9]*)$} $v]
7794 }
7795
7796 proc diffcontextchange {n1 n2 op} {
7797     global diffcontextstring diffcontext
7798
7799     if {[string is integer -strict $diffcontextstring]} {
7800         if {$diffcontextstring >= 0} {
7801             set diffcontext $diffcontextstring
7802             reselectline
7803         }
7804     }
7805 }
7806
7807 proc changeignorespace {} {
7808     reselectline
7809 }
7810
7811 proc changeworddiff {name ix op} {
7812     reselectline
7813 }
7814
7815 proc initblobdiffvars {} {
7816     global diffencoding targetline diffnparents
7817     global diffinhdr currdiffsubmod diffseehere
7818     set targetline {}
7819     set diffnparents 0
7820     set diffinhdr 0
7821     set diffencoding [get_path_encoding {}]
7822     set currdiffsubmod ""
7823     set diffseehere -1
7824 }
7825
7826 proc getblobdiffs {ids} {
7827     global blobdifffd diffids env
7828     global treediffs
7829     global diffcontext
7830     global ignorespace
7831     global worddiff
7832     global limitdiffs vfilelimit curview
7833     global git_version
7834
7835     set textconv {}
7836     if {[package vcompare $git_version "1.6.1"] >= 0} {
7837         set textconv "--textconv"
7838     }
7839     set submodule {}
7840     if {[package vcompare $git_version "1.6.6"] >= 0} {
7841         set submodule "--submodule"
7842     }
7843     set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7844     if {$ignorespace} {
7845         append cmd " -w"
7846     }
7847     if {$worddiff ne [mc "Line diff"]} {
7848         append cmd " --word-diff=porcelain"
7849     }
7850     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7851         set cmd [concat $cmd -- $vfilelimit($curview)]
7852     }
7853     if {[catch {set bdf [open $cmd r]} err]} {
7854         error_popup [mc "Error getting diffs: %s" $err]
7855         return
7856     }
7857     fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7858     set blobdifffd($ids) $bdf
7859     initblobdiffvars
7860     filerun $bdf [list getblobdiffline $bdf $diffids]
7861 }
7862
7863 proc savecmitpos {} {
7864     global ctext cmitmode
7865
7866     if {$cmitmode eq "tree"} {
7867         return {}
7868     }
7869     return [list target_scrollpos [$ctext index @0,0]]
7870 }
7871
7872 proc savectextpos {} {
7873     global ctext
7874
7875     return [list target_scrollpos [$ctext index @0,0]]
7876 }
7877
7878 proc maybe_scroll_ctext {ateof} {
7879     global ctext target_scrollpos
7880
7881     if {![info exists target_scrollpos]} return
7882     if {!$ateof} {
7883         set nlines [expr {[winfo height $ctext]
7884                           / [font metrics textfont -linespace]}]
7885         if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7886     }
7887     $ctext yview $target_scrollpos
7888     unset target_scrollpos
7889 }
7890
7891 proc setinlist {var i val} {
7892     global $var
7893
7894     while {[llength [set $var]] < $i} {
7895         lappend $var {}
7896     }
7897     if {[llength [set $var]] == $i} {
7898         lappend $var $val
7899     } else {
7900         lset $var $i $val
7901     }
7902 }
7903
7904 proc makediffhdr {fname ids} {
7905     global ctext curdiffstart treediffs diffencoding
7906     global ctext_file_names jump_to_here targetline diffline
7907
7908     set fname [encoding convertfrom $fname]
7909     set diffencoding [get_path_encoding $fname]
7910     set i [lsearch -exact $treediffs($ids) $fname]
7911     if {$i >= 0} {
7912         setinlist difffilestart $i $curdiffstart
7913     }
7914     lset ctext_file_names end $fname
7915     set l [expr {(78 - [string length $fname]) / 2}]
7916     set pad [string range "----------------------------------------" 1 $l]
7917     $ctext insert $curdiffstart "$pad $fname $pad" filesep
7918     set targetline {}
7919     if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7920         set targetline [lindex $jump_to_here 1]
7921     }
7922     set diffline 0
7923 }
7924
7925 proc blobdiffmaybeseehere {ateof} {
7926     global diffseehere
7927     if {$diffseehere >= 0} {
7928         mark_ctext_line [lindex [split $diffseehere .] 0]
7929     }
7930     maybe_scroll_ctext $ateof
7931 }
7932
7933 proc getblobdiffline {bdf ids} {
7934     global diffids blobdifffd
7935     global ctext
7936
7937     set nr 0
7938     $ctext conf -state normal
7939     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7940         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7941             catch {close $bdf}
7942             return 0
7943         }
7944         parseblobdiffline $ids $line
7945     }
7946     $ctext conf -state disabled
7947     blobdiffmaybeseehere [eof $bdf]
7948     if {[eof $bdf]} {
7949         catch {close $bdf}
7950         return 0
7951     }
7952     return [expr {$nr >= 1000? 2: 1}]
7953 }
7954
7955 proc parseblobdiffline {ids line} {
7956     global ctext curdiffstart
7957     global diffnexthead diffnextnote difffilestart
7958     global ctext_file_names ctext_file_lines
7959     global diffinhdr treediffs mergemax diffnparents
7960     global diffencoding jump_to_here targetline diffline currdiffsubmod
7961     global worddiff diffseehere
7962
7963     if {![string compare -length 5 "diff " $line]} {
7964         if {![regexp {^diff (--cc|--git) } $line m type]} {
7965             set line [encoding convertfrom $line]
7966             $ctext insert end "$line\n" hunksep
7967             continue
7968         }
7969         # start of a new file
7970         set diffinhdr 1
7971         $ctext insert end "\n"
7972         set curdiffstart [$ctext index "end - 1c"]
7973         lappend ctext_file_names ""
7974         lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7975         $ctext insert end "\n" filesep
7976
7977         if {$type eq "--cc"} {
7978             # start of a new file in a merge diff
7979             set fname [string range $line 10 end]
7980             if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7981                 lappend treediffs($ids) $fname
7982                 add_flist [list $fname]
7983             }
7984
7985         } else {
7986             set line [string range $line 11 end]
7987             # If the name hasn't changed the length will be odd,
7988             # the middle char will be a space, and the two bits either
7989             # side will be a/name and b/name, or "a/name" and "b/name".
7990             # If the name has changed we'll get "rename from" and
7991             # "rename to" or "copy from" and "copy to" lines following
7992             # this, and we'll use them to get the filenames.
7993             # This complexity is necessary because spaces in the
7994             # filename(s) don't get escaped.
7995             set l [string length $line]
7996             set i [expr {$l / 2}]
7997             if {!(($l & 1) && [string index $line $i] eq " " &&
7998                   [string range $line 2 [expr {$i - 1}]] eq \
7999                       [string range $line [expr {$i + 3}] end])} {
8000                 return
8001             }
8002             # unescape if quoted and chop off the a/ from the front
8003             if {[string index $line 0] eq "\""} {
8004                 set fname [string range [lindex $line 0] 2 end]
8005             } else {
8006                 set fname [string range $line 2 [expr {$i - 1}]]
8007             }
8008         }
8009         makediffhdr $fname $ids
8010
8011     } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8012         set fname [encoding convertfrom [string range $line 16 end]]
8013         $ctext insert end "\n"
8014         set curdiffstart [$ctext index "end - 1c"]
8015         lappend ctext_file_names $fname
8016         lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8017         $ctext insert end "$line\n" filesep
8018         set i [lsearch -exact $treediffs($ids) $fname]
8019         if {$i >= 0} {
8020             setinlist difffilestart $i $curdiffstart
8021         }
8022
8023     } elseif {![string compare -length 2 "@@" $line]} {
8024         regexp {^@@+} $line ats
8025         set line [encoding convertfrom $diffencoding $line]
8026         $ctext insert end "$line\n" hunksep
8027         if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8028             set diffline $nl
8029         }
8030         set diffnparents [expr {[string length $ats] - 1}]
8031         set diffinhdr 0
8032
8033     } elseif {![string compare -length 10 "Submodule " $line]} {
8034         # start of a new submodule
8035         if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8036             set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8037         } else {
8038             set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8039         }
8040         if {$currdiffsubmod != $fname} {
8041             $ctext insert end "\n";     # Add newline after commit message
8042         }
8043         set curdiffstart [$ctext index "end - 1c"]
8044         lappend ctext_file_names ""
8045         if {$currdiffsubmod != $fname} {
8046             lappend ctext_file_lines $fname
8047             makediffhdr $fname $ids
8048             set currdiffsubmod $fname
8049             $ctext insert end "\n$line\n" filesep
8050         } else {
8051             $ctext insert end "$line\n" filesep
8052         }
8053     } elseif {![string compare -length 3 "  >" $line]} {
8054         set $currdiffsubmod ""
8055         set line [encoding convertfrom $diffencoding $line]
8056         $ctext insert end "$line\n" dresult
8057     } elseif {![string compare -length 3 "  <" $line]} {
8058         set $currdiffsubmod ""
8059         set line [encoding convertfrom $diffencoding $line]
8060         $ctext insert end "$line\n" d0
8061     } elseif {$diffinhdr} {
8062         if {![string compare -length 12 "rename from " $line]} {
8063             set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8064             if {[string index $fname 0] eq "\""} {
8065                 set fname [lindex $fname 0]
8066             }
8067             set fname [encoding convertfrom $fname]
8068             set i [lsearch -exact $treediffs($ids) $fname]
8069             if {$i >= 0} {
8070                 setinlist difffilestart $i $curdiffstart
8071             }
8072         } elseif {![string compare -length 10 $line "rename to "] ||
8073                   ![string compare -length 8 $line "copy to "]} {
8074             set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8075             if {[string index $fname 0] eq "\""} {
8076                 set fname [lindex $fname 0]
8077             }
8078             makediffhdr $fname $ids
8079         } elseif {[string compare -length 3 $line "---"] == 0} {
8080             # do nothing
8081             return
8082         } elseif {[string compare -length 3 $line "+++"] == 0} {
8083             set diffinhdr 0
8084             return
8085         }
8086         $ctext insert end "$line\n" filesep
8087
8088     } else {
8089         set line [string map {\x1A ^Z} \
8090                       [encoding convertfrom $diffencoding $line]]
8091         # parse the prefix - one ' ', '-' or '+' for each parent
8092         set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8093         set tag [expr {$diffnparents > 1? "m": "d"}]
8094         set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8095         set words_pre_markup ""
8096         set words_post_markup ""
8097         if {[string trim $prefix " -+"] eq {}} {
8098             # prefix only has " ", "-" and "+" in it: normal diff line
8099             set num [string first "-" $prefix]
8100             if {$dowords} {
8101                 set line [string range $line 1 end]
8102             }
8103             if {$num >= 0} {
8104                 # removed line, first parent with line is $num
8105                 if {$num >= $mergemax} {
8106                     set num "max"
8107                 }
8108                 if {$dowords && $worddiff eq [mc "Markup words"]} {
8109                     $ctext insert end "\[-$line-\]" $tag$num
8110                 } else {
8111                     $ctext insert end "$line" $tag$num
8112                 }
8113                 if {!$dowords} {
8114                     $ctext insert end "\n" $tag$num
8115                 }
8116             } else {
8117                 set tags {}
8118                 if {[string first "+" $prefix] >= 0} {
8119                     # added line
8120                     lappend tags ${tag}result
8121                     if {$diffnparents > 1} {
8122                         set num [string first " " $prefix]
8123                         if {$num >= 0} {
8124                             if {$num >= $mergemax} {
8125                                 set num "max"
8126                             }
8127                             lappend tags m$num
8128                         }
8129                     }
8130                     set words_pre_markup "{+"
8131                     set words_post_markup "+}"
8132                 }
8133                 if {$targetline ne {}} {
8134                     if {$diffline == $targetline} {
8135                         set diffseehere [$ctext index "end - 1 chars"]
8136                         set targetline {}
8137                     } else {
8138                         incr diffline
8139                     }
8140                 }
8141                 if {$dowords && $worddiff eq [mc "Markup words"]} {
8142                     $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8143                 } else {
8144                     $ctext insert end "$line" $tags
8145                 }
8146                 if {!$dowords} {
8147                     $ctext insert end "\n" $tags
8148                 }
8149             }
8150         } elseif {$dowords && $prefix eq "~"} {
8151             $ctext insert end "\n" {}
8152         } else {
8153             # "\ No newline at end of file",
8154             # or something else we don't recognize
8155             $ctext insert end "$line\n" hunksep
8156         }
8157     }
8158 }
8159
8160 proc changediffdisp {} {
8161     global ctext diffelide
8162
8163     $ctext tag conf d0 -elide [lindex $diffelide 0]
8164     $ctext tag conf dresult -elide [lindex $diffelide 1]
8165 }
8166
8167 proc highlightfile {cline} {
8168     global cflist cflist_top
8169
8170     if {![info exists cflist_top]} return
8171
8172     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8173     $cflist tag add highlight $cline.0 "$cline.0 lineend"
8174     $cflist see $cline.0
8175     set cflist_top $cline
8176 }
8177
8178 proc highlightfile_for_scrollpos {topidx} {
8179     global cmitmode difffilestart
8180
8181     if {$cmitmode eq "tree"} return
8182     if {![info exists difffilestart]} return
8183
8184     set top [lindex [split $topidx .] 0]
8185     if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8186         highlightfile 0
8187     } else {
8188         highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8189     }
8190 }
8191
8192 proc prevfile {} {
8193     global difffilestart ctext cmitmode
8194
8195     if {$cmitmode eq "tree"} return
8196     set prev 0.0
8197     set here [$ctext index @0,0]
8198     foreach loc $difffilestart {
8199         if {[$ctext compare $loc >= $here]} {
8200             $ctext yview $prev
8201             return
8202         }
8203         set prev $loc
8204     }
8205     $ctext yview $prev
8206 }
8207
8208 proc nextfile {} {
8209     global difffilestart ctext cmitmode
8210
8211     if {$cmitmode eq "tree"} return
8212     set here [$ctext index @0,0]
8213     foreach loc $difffilestart {
8214         if {[$ctext compare $loc > $here]} {
8215             $ctext yview $loc
8216             return
8217         }
8218     }
8219 }
8220
8221 proc clear_ctext {{first 1.0}} {
8222     global ctext smarktop smarkbot
8223     global ctext_file_names ctext_file_lines
8224     global pendinglinks
8225
8226     set l [lindex [split $first .] 0]
8227     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8228         set smarktop $l
8229     }
8230     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8231         set smarkbot $l
8232     }
8233     $ctext delete $first end
8234     if {$first eq "1.0"} {
8235         catch {unset pendinglinks}
8236     }
8237     set ctext_file_names {}
8238     set ctext_file_lines {}
8239 }
8240
8241 proc settabs {{firstab {}}} {
8242     global firsttabstop tabstop ctext have_tk85
8243
8244     if {$firstab ne {} && $have_tk85} {
8245         set firsttabstop $firstab
8246     }
8247     set w [font measure textfont "0"]
8248     if {$firsttabstop != 0} {
8249         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8250                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8251     } elseif {$have_tk85 || $tabstop != 8} {
8252         $ctext conf -tabs [expr {$tabstop * $w}]
8253     } else {
8254         $ctext conf -tabs {}
8255     }
8256 }
8257
8258 proc incrsearch {name ix op} {
8259     global ctext searchstring searchdirn
8260
8261     if {[catch {$ctext index anchor}]} {
8262         # no anchor set, use start of selection, or of visible area
8263         set sel [$ctext tag ranges sel]
8264         if {$sel ne {}} {
8265             $ctext mark set anchor [lindex $sel 0]
8266         } elseif {$searchdirn eq "-forwards"} {
8267             $ctext mark set anchor @0,0
8268         } else {
8269             $ctext mark set anchor @0,[winfo height $ctext]
8270         }
8271     }
8272     if {$searchstring ne {}} {
8273         set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8274         if {$here ne {}} {
8275             $ctext see $here
8276             set mend "$here + $mlen c"
8277             $ctext tag remove sel 1.0 end
8278             $ctext tag add sel $here $mend
8279             suppress_highlighting_file_for_current_scrollpos
8280             highlightfile_for_scrollpos $here
8281         }
8282     }
8283     rehighlight_search_results
8284 }
8285
8286 proc dosearch {} {
8287     global sstring ctext searchstring searchdirn
8288
8289     focus $sstring
8290     $sstring icursor end
8291     set searchdirn -forwards
8292     if {$searchstring ne {}} {
8293         set sel [$ctext tag ranges sel]
8294         if {$sel ne {}} {
8295             set start "[lindex $sel 0] + 1c"
8296         } elseif {[catch {set start [$ctext index anchor]}]} {
8297             set start "@0,0"
8298         }
8299         set match [$ctext search -count mlen -- $searchstring $start]
8300         $ctext tag remove sel 1.0 end
8301         if {$match eq {}} {
8302             bell
8303             return
8304         }
8305         $ctext see $match
8306         suppress_highlighting_file_for_current_scrollpos
8307         highlightfile_for_scrollpos $match
8308         set mend "$match + $mlen c"
8309         $ctext tag add sel $match $mend
8310         $ctext mark unset anchor
8311         rehighlight_search_results
8312     }
8313 }
8314
8315 proc dosearchback {} {
8316     global sstring ctext searchstring searchdirn
8317
8318     focus $sstring
8319     $sstring icursor end
8320     set searchdirn -backwards
8321     if {$searchstring ne {}} {
8322         set sel [$ctext tag ranges sel]
8323         if {$sel ne {}} {
8324             set start [lindex $sel 0]
8325         } elseif {[catch {set start [$ctext index anchor]}]} {
8326             set start @0,[winfo height $ctext]
8327         }
8328         set match [$ctext search -backwards -count ml -- $searchstring $start]
8329         $ctext tag remove sel 1.0 end
8330         if {$match eq {}} {
8331             bell
8332             return
8333         }
8334         $ctext see $match
8335         suppress_highlighting_file_for_current_scrollpos
8336         highlightfile_for_scrollpos $match
8337         set mend "$match + $ml c"
8338         $ctext tag add sel $match $mend
8339         $ctext mark unset anchor
8340         rehighlight_search_results
8341     }
8342 }
8343
8344 proc rehighlight_search_results {} {
8345     global ctext searchstring
8346
8347     $ctext tag remove found 1.0 end
8348     $ctext tag remove currentsearchhit 1.0 end
8349
8350     if {$searchstring ne {}} {
8351         searchmarkvisible 1
8352     }
8353 }
8354
8355 proc searchmark {first last} {
8356     global ctext searchstring
8357
8358     set sel [$ctext tag ranges sel]
8359
8360     set mend $first.0
8361     while {1} {
8362         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8363         if {$match eq {}} break
8364         set mend "$match + $mlen c"
8365         if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8366             $ctext tag add currentsearchhit $match $mend
8367         } else {
8368             $ctext tag add found $match $mend
8369         }
8370     }
8371 }
8372
8373 proc searchmarkvisible {doall} {
8374     global ctext smarktop smarkbot
8375
8376     set topline [lindex [split [$ctext index @0,0] .] 0]
8377     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8378     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8379         # no overlap with previous
8380         searchmark $topline $botline
8381         set smarktop $topline
8382         set smarkbot $botline
8383     } else {
8384         if {$topline < $smarktop} {
8385             searchmark $topline [expr {$smarktop-1}]
8386             set smarktop $topline
8387         }
8388         if {$botline > $smarkbot} {
8389             searchmark [expr {$smarkbot+1}] $botline
8390             set smarkbot $botline
8391         }
8392     }
8393 }
8394
8395 proc suppress_highlighting_file_for_current_scrollpos {} {
8396     global ctext suppress_highlighting_file_for_this_scrollpos
8397
8398     set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8399 }
8400
8401 proc scrolltext {f0 f1} {
8402     global searchstring cmitmode ctext
8403     global suppress_highlighting_file_for_this_scrollpos
8404
8405     set topidx [$ctext index @0,0]
8406     if {![info exists suppress_highlighting_file_for_this_scrollpos]
8407         || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8408         highlightfile_for_scrollpos $topidx
8409     }
8410
8411     catch {unset suppress_highlighting_file_for_this_scrollpos}
8412
8413     .bleft.bottom.sb set $f0 $f1
8414     if {$searchstring ne {}} {
8415         searchmarkvisible 0
8416     }
8417 }
8418
8419 proc setcoords {} {
8420     global linespc charspc canvx0 canvy0
8421     global xspc1 xspc2 lthickness
8422
8423     set linespc [font metrics mainfont -linespace]
8424     set charspc [font measure mainfont "m"]
8425     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8426     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8427     set lthickness [expr {int($linespc / 9) + 1}]
8428     set xspc1(0) $linespc
8429     set xspc2 $linespc
8430 }
8431
8432 proc redisplay {} {
8433     global canv
8434     global selectedline
8435
8436     set ymax [lindex [$canv cget -scrollregion] 3]
8437     if {$ymax eq {} || $ymax == 0} return
8438     set span [$canv yview]
8439     clear_display
8440     setcanvscroll
8441     allcanvs yview moveto [lindex $span 0]
8442     drawvisible
8443     if {$selectedline ne {}} {
8444         selectline $selectedline 0
8445         allcanvs yview moveto [lindex $span 0]
8446     }
8447 }
8448
8449 proc parsefont {f n} {
8450     global fontattr
8451
8452     set fontattr($f,family) [lindex $n 0]
8453     set s [lindex $n 1]
8454     if {$s eq {} || $s == 0} {
8455         set s 10
8456     } elseif {$s < 0} {
8457         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8458     }
8459     set fontattr($f,size) $s
8460     set fontattr($f,weight) normal
8461     set fontattr($f,slant) roman
8462     foreach style [lrange $n 2 end] {
8463         switch -- $style {
8464             "normal" -
8465             "bold"   {set fontattr($f,weight) $style}
8466             "roman" -
8467             "italic" {set fontattr($f,slant) $style}
8468         }
8469     }
8470 }
8471
8472 proc fontflags {f {isbold 0}} {
8473     global fontattr
8474
8475     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8476                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8477                 -slant $fontattr($f,slant)]
8478 }
8479
8480 proc fontname {f} {
8481     global fontattr
8482
8483     set n [list $fontattr($f,family) $fontattr($f,size)]
8484     if {$fontattr($f,weight) eq "bold"} {
8485         lappend n "bold"
8486     }
8487     if {$fontattr($f,slant) eq "italic"} {
8488         lappend n "italic"
8489     }
8490     return $n
8491 }
8492
8493 proc incrfont {inc} {
8494     global mainfont textfont ctext canv cflist showrefstop
8495     global stopped entries fontattr
8496
8497     unmarkmatches
8498     set s $fontattr(mainfont,size)
8499     incr s $inc
8500     if {$s < 1} {
8501         set s 1
8502     }
8503     set fontattr(mainfont,size) $s
8504     font config mainfont -size $s
8505     font config mainfontbold -size $s
8506     set mainfont [fontname mainfont]
8507     set s $fontattr(textfont,size)
8508     incr s $inc
8509     if {$s < 1} {
8510         set s 1
8511     }
8512     set fontattr(textfont,size) $s
8513     font config textfont -size $s
8514     font config textfontbold -size $s
8515     set textfont [fontname textfont]
8516     setcoords
8517     settabs
8518     redisplay
8519 }
8520
8521 proc clearsha1 {} {
8522     global sha1entry sha1string
8523     if {[string length $sha1string] == 40} {
8524         $sha1entry delete 0 end
8525     }
8526 }
8527
8528 proc sha1change {n1 n2 op} {
8529     global sha1string currentid sha1but
8530     if {$sha1string == {}
8531         || ([info exists currentid] && $sha1string == $currentid)} {
8532         set state disabled
8533     } else {
8534         set state normal
8535     }
8536     if {[$sha1but cget -state] == $state} return
8537     if {$state == "normal"} {
8538         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8539     } else {
8540         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8541     }
8542 }
8543
8544 proc gotocommit {} {
8545     global sha1string tagids headids curview varcid
8546
8547     if {$sha1string == {}
8548         || ([info exists currentid] && $sha1string == $currentid)} return
8549     if {[info exists tagids($sha1string)]} {
8550         set id $tagids($sha1string)
8551     } elseif {[info exists headids($sha1string)]} {
8552         set id $headids($sha1string)
8553     } else {
8554         set id [string tolower $sha1string]
8555         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8556             set matches [longid $id]
8557             if {$matches ne {}} {
8558                 if {[llength $matches] > 1} {
8559                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8560                     return
8561                 }
8562                 set id [lindex $matches 0]
8563             }
8564         } else {
8565             if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8566                 error_popup [mc "Revision %s is not known" $sha1string]
8567                 return
8568             }
8569         }
8570     }
8571     if {[commitinview $id $curview]} {
8572         selectline [rowofcommit $id] 1
8573         return
8574     }
8575     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8576         set msg [mc "SHA1 id %s is not known" $sha1string]
8577     } else {
8578         set msg [mc "Revision %s is not in the current view" $sha1string]
8579     }
8580     error_popup $msg
8581 }
8582
8583 proc lineenter {x y id} {
8584     global hoverx hovery hoverid hovertimer
8585     global commitinfo canv
8586
8587     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8588     set hoverx $x
8589     set hovery $y
8590     set hoverid $id
8591     if {[info exists hovertimer]} {
8592         after cancel $hovertimer
8593     }
8594     set hovertimer [after 500 linehover]
8595     $canv delete hover
8596 }
8597
8598 proc linemotion {x y id} {
8599     global hoverx hovery hoverid hovertimer
8600
8601     if {[info exists hoverid] && $id == $hoverid} {
8602         set hoverx $x
8603         set hovery $y
8604         if {[info exists hovertimer]} {
8605             after cancel $hovertimer
8606         }
8607         set hovertimer [after 500 linehover]
8608     }
8609 }
8610
8611 proc lineleave {id} {
8612     global hoverid hovertimer canv
8613
8614     if {[info exists hoverid] && $id == $hoverid} {
8615         $canv delete hover
8616         if {[info exists hovertimer]} {
8617             after cancel $hovertimer
8618             unset hovertimer
8619         }
8620         unset hoverid
8621     }
8622 }
8623
8624 proc linehover {} {
8625     global hoverx hovery hoverid hovertimer
8626     global canv linespc lthickness
8627     global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8628
8629     global commitinfo
8630
8631     set text [lindex $commitinfo($hoverid) 0]
8632     set ymax [lindex [$canv cget -scrollregion] 3]
8633     if {$ymax == {}} return
8634     set yfrac [lindex [$canv yview] 0]
8635     set x [expr {$hoverx + 2 * $linespc}]
8636     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8637     set x0 [expr {$x - 2 * $lthickness}]
8638     set y0 [expr {$y - 2 * $lthickness}]
8639     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8640     set y1 [expr {$y + $linespc + 2 * $lthickness}]
8641     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8642                -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8643                -width 1 -tags hover]
8644     $canv raise $t
8645     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8646                -font mainfont -fill $linehoverfgcolor]
8647     $canv raise $t
8648 }
8649
8650 proc clickisonarrow {id y} {
8651     global lthickness
8652
8653     set ranges [rowranges $id]
8654     set thresh [expr {2 * $lthickness + 6}]
8655     set n [expr {[llength $ranges] - 1}]
8656     for {set i 1} {$i < $n} {incr i} {
8657         set row [lindex $ranges $i]
8658         if {abs([yc $row] - $y) < $thresh} {
8659             return $i
8660         }
8661     }
8662     return {}
8663 }
8664
8665 proc arrowjump {id n y} {
8666     global canv
8667
8668     # 1 <-> 2, 3 <-> 4, etc...
8669     set n [expr {(($n - 1) ^ 1) + 1}]
8670     set row [lindex [rowranges $id] $n]
8671     set yt [yc $row]
8672     set ymax [lindex [$canv cget -scrollregion] 3]
8673     if {$ymax eq {} || $ymax <= 0} return
8674     set view [$canv yview]
8675     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8676     set yfrac [expr {$yt / $ymax - $yspan / 2}]
8677     if {$yfrac < 0} {
8678         set yfrac 0
8679     }
8680     allcanvs yview moveto $yfrac
8681 }
8682
8683 proc lineclick {x y id isnew} {
8684     global ctext commitinfo children canv thickerline curview
8685
8686     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8687     unmarkmatches
8688     unselectline
8689     normalline
8690     $canv delete hover
8691     # draw this line thicker than normal
8692     set thickerline $id
8693     drawlines $id
8694     if {$isnew} {
8695         set ymax [lindex [$canv cget -scrollregion] 3]
8696         if {$ymax eq {}} return
8697         set yfrac [lindex [$canv yview] 0]
8698         set y [expr {$y + $yfrac * $ymax}]
8699     }
8700     set dirn [clickisonarrow $id $y]
8701     if {$dirn ne {}} {
8702         arrowjump $id $dirn $y
8703         return
8704     }
8705
8706     if {$isnew} {
8707         addtohistory [list lineclick $x $y $id 0] savectextpos
8708     }
8709     # fill the details pane with info about this line
8710     $ctext conf -state normal
8711     clear_ctext
8712     settabs 0
8713     $ctext insert end "[mc "Parent"]:\t"
8714     $ctext insert end $id link0
8715     setlink $id link0
8716     set info $commitinfo($id)
8717     $ctext insert end "\n\t[lindex $info 0]\n"
8718     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8719     set date [formatdate [lindex $info 2]]
8720     $ctext insert end "\t[mc "Date"]:\t$date\n"
8721     set kids $children($curview,$id)
8722     if {$kids ne {}} {
8723         $ctext insert end "\n[mc "Children"]:"
8724         set i 0
8725         foreach child $kids {
8726             incr i
8727             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8728             set info $commitinfo($child)
8729             $ctext insert end "\n\t"
8730             $ctext insert end $child link$i
8731             setlink $child link$i
8732             $ctext insert end "\n\t[lindex $info 0]"
8733             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8734             set date [formatdate [lindex $info 2]]
8735             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8736         }
8737     }
8738     maybe_scroll_ctext 1
8739     $ctext conf -state disabled
8740     init_flist {}
8741 }
8742
8743 proc normalline {} {
8744     global thickerline
8745     if {[info exists thickerline]} {
8746         set id $thickerline
8747         unset thickerline
8748         drawlines $id
8749     }
8750 }
8751
8752 proc selbyid {id {isnew 1}} {
8753     global curview
8754     if {[commitinview $id $curview]} {
8755         selectline [rowofcommit $id] $isnew
8756     }
8757 }
8758
8759 proc mstime {} {
8760     global startmstime
8761     if {![info exists startmstime]} {
8762         set startmstime [clock clicks -milliseconds]
8763     }
8764     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8765 }
8766
8767 proc rowmenu {x y id} {
8768     global rowctxmenu selectedline rowmenuid curview
8769     global nullid nullid2 fakerowmenu mainhead markedid
8770
8771     stopfinding
8772     set rowmenuid $id
8773     if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8774         set state disabled
8775     } else {
8776         set state normal
8777     }
8778     if {[info exists markedid] && $markedid ne $id} {
8779         set mstate normal
8780     } else {
8781         set mstate disabled
8782     }
8783     if {$id ne $nullid && $id ne $nullid2} {
8784         set menu $rowctxmenu
8785         if {$mainhead ne {}} {
8786             $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8787         } else {
8788             $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8789         }
8790         $menu entryconfigure 9 -state $mstate
8791         $menu entryconfigure 10 -state $mstate
8792         $menu entryconfigure 11 -state $mstate
8793     } else {
8794         set menu $fakerowmenu
8795     }
8796     $menu entryconfigure [mca "Diff this -> selected"] -state $state
8797     $menu entryconfigure [mca "Diff selected -> this"] -state $state
8798     $menu entryconfigure [mca "Make patch"] -state $state
8799     $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8800     $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8801     tk_popup $menu $x $y
8802 }
8803
8804 proc markhere {} {
8805     global rowmenuid markedid canv
8806
8807     set markedid $rowmenuid
8808     make_idmark $markedid
8809 }
8810
8811 proc gotomark {} {
8812     global markedid
8813
8814     if {[info exists markedid]} {
8815         selbyid $markedid
8816     }
8817 }
8818
8819 proc replace_by_kids {l r} {
8820     global curview children
8821
8822     set id [commitonrow $r]
8823     set l [lreplace $l 0 0]
8824     foreach kid $children($curview,$id) {
8825         lappend l [rowofcommit $kid]
8826     }
8827     return [lsort -integer -decreasing -unique $l]
8828 }
8829
8830 proc find_common_desc {} {
8831     global markedid rowmenuid curview children
8832
8833     if {![info exists markedid]} return
8834     if {![commitinview $markedid $curview] ||
8835         ![commitinview $rowmenuid $curview]} return
8836     #set t1 [clock clicks -milliseconds]
8837     set l1 [list [rowofcommit $markedid]]
8838     set l2 [list [rowofcommit $rowmenuid]]
8839     while 1 {
8840         set r1 [lindex $l1 0]
8841         set r2 [lindex $l2 0]
8842         if {$r1 eq {} || $r2 eq {}} break
8843         if {$r1 == $r2} {
8844             selectline $r1 1
8845             break
8846         }
8847         if {$r1 > $r2} {
8848             set l1 [replace_by_kids $l1 $r1]
8849         } else {
8850             set l2 [replace_by_kids $l2 $r2]
8851         }
8852     }
8853     #set t2 [clock clicks -milliseconds]
8854     #puts "took [expr {$t2-$t1}]ms"
8855 }
8856
8857 proc compare_commits {} {
8858     global markedid rowmenuid curview children
8859
8860     if {![info exists markedid]} return
8861     if {![commitinview $markedid $curview]} return
8862     addtohistory [list do_cmp_commits $markedid $rowmenuid]
8863     do_cmp_commits $markedid $rowmenuid
8864 }
8865
8866 proc getpatchid {id} {
8867     global patchids
8868
8869     if {![info exists patchids($id)]} {
8870         set cmd [diffcmd [list $id] {-p --root}]
8871         # trim off the initial "|"
8872         set cmd [lrange $cmd 1 end]
8873         if {[catch {
8874             set x [eval exec $cmd | git patch-id]
8875             set patchids($id) [lindex $x 0]
8876         }]} {
8877             set patchids($id) "error"
8878         }
8879     }
8880     return $patchids($id)
8881 }
8882
8883 proc do_cmp_commits {a b} {
8884     global ctext curview parents children patchids commitinfo
8885
8886     $ctext conf -state normal
8887     clear_ctext
8888     init_flist {}
8889     for {set i 0} {$i < 100} {incr i} {
8890         set skipa 0
8891         set skipb 0
8892         if {[llength $parents($curview,$a)] > 1} {
8893             appendshortlink $a [mc "Skipping merge commit "] "\n"
8894             set skipa 1
8895         } else {
8896             set patcha [getpatchid $a]
8897         }
8898         if {[llength $parents($curview,$b)] > 1} {
8899             appendshortlink $b [mc "Skipping merge commit "] "\n"
8900             set skipb 1
8901         } else {
8902             set patchb [getpatchid $b]
8903         }
8904         if {!$skipa && !$skipb} {
8905             set heada [lindex $commitinfo($a) 0]
8906             set headb [lindex $commitinfo($b) 0]
8907             if {$patcha eq "error"} {
8908                 appendshortlink $a [mc "Error getting patch ID for "] \
8909                     [mc " - stopping\n"]
8910                 break
8911             }
8912             if {$patchb eq "error"} {
8913                 appendshortlink $b [mc "Error getting patch ID for "] \
8914                     [mc " - stopping\n"]
8915                 break
8916             }
8917             if {$patcha eq $patchb} {
8918                 if {$heada eq $headb} {
8919                     appendshortlink $a [mc "Commit "]
8920                     appendshortlink $b " == " "  $heada\n"
8921                 } else {
8922                     appendshortlink $a [mc "Commit "] "  $heada\n"
8923                     appendshortlink $b [mc " is the same patch as\n       "] \
8924                         "  $headb\n"
8925                 }
8926                 set skipa 1
8927                 set skipb 1
8928             } else {
8929                 $ctext insert end "\n"
8930                 appendshortlink $a [mc "Commit "] "  $heada\n"
8931                 appendshortlink $b [mc " differs from\n       "] \
8932                     "  $headb\n"
8933                 $ctext insert end [mc "Diff of commits:\n\n"]
8934                 $ctext conf -state disabled
8935                 update
8936                 diffcommits $a $b
8937                 return
8938             }
8939         }
8940         if {$skipa} {
8941             set kids [real_children $curview,$a]
8942             if {[llength $kids] != 1} {
8943                 $ctext insert end "\n"
8944                 appendshortlink $a [mc "Commit "] \
8945                     [mc " has %s children - stopping\n" [llength $kids]]
8946                 break
8947             }
8948             set a [lindex $kids 0]
8949         }
8950         if {$skipb} {
8951             set kids [real_children $curview,$b]
8952             if {[llength $kids] != 1} {
8953                 appendshortlink $b [mc "Commit "] \
8954                     [mc " has %s children - stopping\n" [llength $kids]]
8955                 break
8956             }
8957             set b [lindex $kids 0]
8958         }
8959     }
8960     $ctext conf -state disabled
8961 }
8962
8963 proc diffcommits {a b} {
8964     global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
8965
8966     set tmpdir [gitknewtmpdir]
8967     set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8968     set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8969     if {[catch {
8970         exec git diff-tree -p --pretty $a >$fna
8971         exec git diff-tree -p --pretty $b >$fnb
8972     } err]} {
8973         error_popup [mc "Error writing commit to file: %s" $err]
8974         return
8975     }
8976     if {[catch {
8977         set fd [open "| diff -U$diffcontext $fna $fnb" r]
8978     } err]} {
8979         error_popup [mc "Error diffing commits: %s" $err]
8980         return
8981     }
8982     set diffids [list commits $a $b]
8983     set blobdifffd($diffids) $fd
8984     set diffinhdr 0
8985     set currdiffsubmod ""
8986     filerun $fd [list getblobdiffline $fd $diffids]
8987 }
8988
8989 proc diffvssel {dirn} {
8990     global rowmenuid selectedline
8991
8992     if {$selectedline eq {}} return
8993     if {$dirn} {
8994         set oldid [commitonrow $selectedline]
8995         set newid $rowmenuid
8996     } else {
8997         set oldid $rowmenuid
8998         set newid [commitonrow $selectedline]
8999     }
9000     addtohistory [list doseldiff $oldid $newid] savectextpos
9001     doseldiff $oldid $newid
9002 }
9003
9004 proc diffvsmark {dirn} {
9005     global rowmenuid markedid
9006
9007     if {![info exists markedid]} return
9008     if {$dirn} {
9009         set oldid $markedid
9010         set newid $rowmenuid
9011     } else {
9012         set oldid $rowmenuid
9013         set newid $markedid
9014     }
9015     addtohistory [list doseldiff $oldid $newid] savectextpos
9016     doseldiff $oldid $newid
9017 }
9018
9019 proc doseldiff {oldid newid} {
9020     global ctext
9021     global commitinfo
9022
9023     $ctext conf -state normal
9024     clear_ctext
9025     init_flist [mc "Top"]
9026     $ctext insert end "[mc "From"] "
9027     $ctext insert end $oldid link0
9028     setlink $oldid link0
9029     $ctext insert end "\n     "
9030     $ctext insert end [lindex $commitinfo($oldid) 0]
9031     $ctext insert end "\n\n[mc "To"]   "
9032     $ctext insert end $newid link1
9033     setlink $newid link1
9034     $ctext insert end "\n     "
9035     $ctext insert end [lindex $commitinfo($newid) 0]
9036     $ctext insert end "\n"
9037     $ctext conf -state disabled
9038     $ctext tag remove found 1.0 end
9039     startdiff [list $oldid $newid]
9040 }
9041
9042 proc mkpatch {} {
9043     global rowmenuid currentid commitinfo patchtop patchnum NS
9044
9045     if {![info exists currentid]} return
9046     set oldid $currentid
9047     set oldhead [lindex $commitinfo($oldid) 0]
9048     set newid $rowmenuid
9049     set newhead [lindex $commitinfo($newid) 0]
9050     set top .patch
9051     set patchtop $top
9052     catch {destroy $top}
9053     ttk_toplevel $top
9054     make_transient $top .
9055     ${NS}::label $top.title -text [mc "Generate patch"]
9056     grid $top.title - -pady 10
9057     ${NS}::label $top.from -text [mc "From:"]
9058     ${NS}::entry $top.fromsha1 -width 40
9059     $top.fromsha1 insert 0 $oldid
9060     $top.fromsha1 conf -state readonly
9061     grid $top.from $top.fromsha1 -sticky w
9062     ${NS}::entry $top.fromhead -width 60
9063     $top.fromhead insert 0 $oldhead
9064     $top.fromhead conf -state readonly
9065     grid x $top.fromhead -sticky w
9066     ${NS}::label $top.to -text [mc "To:"]
9067     ${NS}::entry $top.tosha1 -width 40
9068     $top.tosha1 insert 0 $newid
9069     $top.tosha1 conf -state readonly
9070     grid $top.to $top.tosha1 -sticky w
9071     ${NS}::entry $top.tohead -width 60
9072     $top.tohead insert 0 $newhead
9073     $top.tohead conf -state readonly
9074     grid x $top.tohead -sticky w
9075     ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9076     grid $top.rev x -pady 10 -padx 5
9077     ${NS}::label $top.flab -text [mc "Output file:"]
9078     ${NS}::entry $top.fname -width 60
9079     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9080     incr patchnum
9081     grid $top.flab $top.fname -sticky w
9082     ${NS}::frame $top.buts
9083     ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9084     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9085     bind $top <Key-Return> mkpatchgo
9086     bind $top <Key-Escape> mkpatchcan
9087     grid $top.buts.gen $top.buts.can
9088     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9089     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9090     grid $top.buts - -pady 10 -sticky ew
9091     focus $top.fname
9092 }
9093
9094 proc mkpatchrev {} {
9095     global patchtop
9096
9097     set oldid [$patchtop.fromsha1 get]
9098     set oldhead [$patchtop.fromhead get]
9099     set newid [$patchtop.tosha1 get]
9100     set newhead [$patchtop.tohead get]
9101     foreach e [list fromsha1 fromhead tosha1 tohead] \
9102             v [list $newid $newhead $oldid $oldhead] {
9103         $patchtop.$e conf -state normal
9104         $patchtop.$e delete 0 end
9105         $patchtop.$e insert 0 $v
9106         $patchtop.$e conf -state readonly
9107     }
9108 }
9109
9110 proc mkpatchgo {} {
9111     global patchtop nullid nullid2
9112
9113     set oldid [$patchtop.fromsha1 get]
9114     set newid [$patchtop.tosha1 get]
9115     set fname [$patchtop.fname get]
9116     set cmd [diffcmd [list $oldid $newid] -p]
9117     # trim off the initial "|"
9118     set cmd [lrange $cmd 1 end]
9119     lappend cmd >$fname &
9120     if {[catch {eval exec $cmd} err]} {
9121         error_popup "[mc "Error creating patch:"] $err" $patchtop
9122     }
9123     catch {destroy $patchtop}
9124     unset patchtop
9125 }
9126
9127 proc mkpatchcan {} {
9128     global patchtop
9129
9130     catch {destroy $patchtop}
9131     unset patchtop
9132 }
9133
9134 proc mktag {} {
9135     global rowmenuid mktagtop commitinfo NS
9136
9137     set top .maketag
9138     set mktagtop $top
9139     catch {destroy $top}
9140     ttk_toplevel $top
9141     make_transient $top .
9142     ${NS}::label $top.title -text [mc "Create tag"]
9143     grid $top.title - -pady 10
9144     ${NS}::label $top.id -text [mc "ID:"]
9145     ${NS}::entry $top.sha1 -width 40
9146     $top.sha1 insert 0 $rowmenuid
9147     $top.sha1 conf -state readonly
9148     grid $top.id $top.sha1 -sticky w
9149     ${NS}::entry $top.head -width 60
9150     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9151     $top.head conf -state readonly
9152     grid x $top.head -sticky w
9153     ${NS}::label $top.tlab -text [mc "Tag name:"]
9154     ${NS}::entry $top.tag -width 60
9155     grid $top.tlab $top.tag -sticky w
9156     ${NS}::label $top.op -text [mc "Tag message is optional"]
9157     grid $top.op -columnspan 2 -sticky we
9158     ${NS}::label $top.mlab -text [mc "Tag message:"]
9159     ${NS}::entry $top.msg -width 60
9160     grid $top.mlab $top.msg -sticky w
9161     ${NS}::frame $top.buts
9162     ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9163     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9164     bind $top <Key-Return> mktaggo
9165     bind $top <Key-Escape> mktagcan
9166     grid $top.buts.gen $top.buts.can
9167     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9168     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9169     grid $top.buts - -pady 10 -sticky ew
9170     focus $top.tag
9171 }
9172
9173 proc domktag {} {
9174     global mktagtop env tagids idtags
9175
9176     set id [$mktagtop.sha1 get]
9177     set tag [$mktagtop.tag get]
9178     set msg [$mktagtop.msg get]
9179     if {$tag == {}} {
9180         error_popup [mc "No tag name specified"] $mktagtop
9181         return 0
9182     }
9183     if {[info exists tagids($tag)]} {
9184         error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9185         return 0
9186     }
9187     if {[catch {
9188         if {$msg != {}} {
9189             exec git tag -a -m $msg $tag $id
9190         } else {
9191             exec git tag $tag $id
9192         }
9193     } err]} {
9194         error_popup "[mc "Error creating tag:"] $err" $mktagtop
9195         return 0
9196     }
9197
9198     set tagids($tag) $id
9199     lappend idtags($id) $tag
9200     redrawtags $id
9201     addedtag $id
9202     dispneartags 0
9203     run refill_reflist
9204     return 1
9205 }
9206
9207 proc redrawtags {id} {
9208     global canv linehtag idpos currentid curview cmitlisted markedid
9209     global canvxmax iddrawn circleitem mainheadid circlecolors
9210     global mainheadcirclecolor
9211
9212     if {![commitinview $id $curview]} return
9213     if {![info exists iddrawn($id)]} return
9214     set row [rowofcommit $id]
9215     if {$id eq $mainheadid} {
9216         set ofill $mainheadcirclecolor
9217     } else {
9218         set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9219     }
9220     $canv itemconf $circleitem($row) -fill $ofill
9221     $canv delete tag.$id
9222     set xt [eval drawtags $id $idpos($id)]
9223     $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9224     set text [$canv itemcget $linehtag($id) -text]
9225     set font [$canv itemcget $linehtag($id) -font]
9226     set xr [expr {$xt + [font measure $font $text]}]
9227     if {$xr > $canvxmax} {
9228         set canvxmax $xr
9229         setcanvscroll
9230     }
9231     if {[info exists currentid] && $currentid == $id} {
9232         make_secsel $id
9233     }
9234     if {[info exists markedid] && $markedid eq $id} {
9235         make_idmark $id
9236     }
9237 }
9238
9239 proc mktagcan {} {
9240     global mktagtop
9241
9242     catch {destroy $mktagtop}
9243     unset mktagtop
9244 }
9245
9246 proc mktaggo {} {
9247     if {![domktag]} return
9248     mktagcan
9249 }
9250
9251 proc writecommit {} {
9252     global rowmenuid wrcomtop commitinfo wrcomcmd NS
9253
9254     set top .writecommit
9255     set wrcomtop $top
9256     catch {destroy $top}
9257     ttk_toplevel $top
9258     make_transient $top .
9259     ${NS}::label $top.title -text [mc "Write commit to file"]
9260     grid $top.title - -pady 10
9261     ${NS}::label $top.id -text [mc "ID:"]
9262     ${NS}::entry $top.sha1 -width 40
9263     $top.sha1 insert 0 $rowmenuid
9264     $top.sha1 conf -state readonly
9265     grid $top.id $top.sha1 -sticky w
9266     ${NS}::entry $top.head -width 60
9267     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9268     $top.head conf -state readonly
9269     grid x $top.head -sticky w
9270     ${NS}::label $top.clab -text [mc "Command:"]
9271     ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9272     grid $top.clab $top.cmd -sticky w -pady 10
9273     ${NS}::label $top.flab -text [mc "Output file:"]
9274     ${NS}::entry $top.fname -width 60
9275     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9276     grid $top.flab $top.fname -sticky w
9277     ${NS}::frame $top.buts
9278     ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9279     ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9280     bind $top <Key-Return> wrcomgo
9281     bind $top <Key-Escape> wrcomcan
9282     grid $top.buts.gen $top.buts.can
9283     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9284     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9285     grid $top.buts - -pady 10 -sticky ew
9286     focus $top.fname
9287 }
9288
9289 proc wrcomgo {} {
9290     global wrcomtop
9291
9292     set id [$wrcomtop.sha1 get]
9293     set cmd "echo $id | [$wrcomtop.cmd get]"
9294     set fname [$wrcomtop.fname get]
9295     if {[catch {exec sh -c $cmd >$fname &} err]} {
9296         error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9297     }
9298     catch {destroy $wrcomtop}
9299     unset wrcomtop
9300 }
9301
9302 proc wrcomcan {} {
9303     global wrcomtop
9304
9305     catch {destroy $wrcomtop}
9306     unset wrcomtop
9307 }
9308
9309 proc mkbranch {} {
9310     global rowmenuid mkbrtop NS
9311
9312     set top .makebranch
9313     catch {destroy $top}
9314     ttk_toplevel $top
9315     make_transient $top .
9316     ${NS}::label $top.title -text [mc "Create new branch"]
9317     grid $top.title - -pady 10
9318     ${NS}::label $top.id -text [mc "ID:"]
9319     ${NS}::entry $top.sha1 -width 40
9320     $top.sha1 insert 0 $rowmenuid
9321     $top.sha1 conf -state readonly
9322     grid $top.id $top.sha1 -sticky w
9323     ${NS}::label $top.nlab -text [mc "Name:"]
9324     ${NS}::entry $top.name -width 40
9325     grid $top.nlab $top.name -sticky w
9326     ${NS}::frame $top.buts
9327     ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9328     ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9329     bind $top <Key-Return> [list mkbrgo $top]
9330     bind $top <Key-Escape> "catch {destroy $top}"
9331     grid $top.buts.go $top.buts.can
9332     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9333     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9334     grid $top.buts - -pady 10 -sticky ew
9335     focus $top.name
9336 }
9337
9338 proc mkbrgo {top} {
9339     global headids idheads
9340
9341     set name [$top.name get]
9342     set id [$top.sha1 get]
9343     set cmdargs {}
9344     set old_id {}
9345     if {$name eq {}} {
9346         error_popup [mc "Please specify a name for the new branch"] $top
9347         return
9348     }
9349     if {[info exists headids($name)]} {
9350         if {![confirm_popup [mc \
9351                 "Branch '%s' already exists. Overwrite?" $name] $top]} {
9352             return
9353         }
9354         set old_id $headids($name)
9355         lappend cmdargs -f
9356     }
9357     catch {destroy $top}
9358     lappend cmdargs $name $id
9359     nowbusy newbranch
9360     update
9361     if {[catch {
9362         eval exec git branch $cmdargs
9363     } err]} {
9364         notbusy newbranch
9365         error_popup $err
9366     } else {
9367         notbusy newbranch
9368         if {$old_id ne {}} {
9369             movehead $id $name
9370             movedhead $id $name
9371             redrawtags $old_id
9372             redrawtags $id
9373         } else {
9374             set headids($name) $id
9375             lappend idheads($id) $name
9376             addedhead $id $name
9377             redrawtags $id
9378         }
9379         dispneartags 0
9380         run refill_reflist
9381     }
9382 }
9383
9384 proc exec_citool {tool_args {baseid {}}} {
9385     global commitinfo env
9386
9387     set save_env [array get env GIT_AUTHOR_*]
9388
9389     if {$baseid ne {}} {
9390         if {![info exists commitinfo($baseid)]} {
9391             getcommit $baseid
9392         }
9393         set author [lindex $commitinfo($baseid) 1]
9394         set date [lindex $commitinfo($baseid) 2]
9395         if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9396                     $author author name email]
9397             && $date ne {}} {
9398             set env(GIT_AUTHOR_NAME) $name
9399             set env(GIT_AUTHOR_EMAIL) $email
9400             set env(GIT_AUTHOR_DATE) $date
9401         }
9402     }
9403
9404     eval exec git citool $tool_args &
9405
9406     array unset env GIT_AUTHOR_*
9407     array set env $save_env
9408 }
9409
9410 proc cherrypick {} {
9411     global rowmenuid curview
9412     global mainhead mainheadid
9413     global gitdir
9414
9415     set oldhead [exec git rev-parse HEAD]
9416     set dheads [descheads $rowmenuid]
9417     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9418         set ok [confirm_popup [mc "Commit %s is already\
9419                 included in branch %s -- really re-apply it?" \
9420                                    [string range $rowmenuid 0 7] $mainhead]]
9421         if {!$ok} return
9422     }
9423     nowbusy cherrypick [mc "Cherry-picking"]
9424     update
9425     # Unfortunately git-cherry-pick writes stuff to stderr even when
9426     # no error occurs, and exec takes that as an indication of error...
9427     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9428         notbusy cherrypick
9429         if {[regexp -line \
9430                  {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9431                  $err msg fname]} {
9432             error_popup [mc "Cherry-pick failed because of local changes\
9433                         to file '%s'.\nPlease commit, reset or stash\
9434                         your changes and try again." $fname]
9435         } elseif {[regexp -line \
9436                        {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9437                        $err]} {
9438             if {[confirm_popup [mc "Cherry-pick failed because of merge\
9439                         conflict.\nDo you wish to run git citool to\
9440                         resolve it?"]]} {
9441                 # Force citool to read MERGE_MSG
9442                 file delete [file join $gitdir "GITGUI_MSG"]
9443                 exec_citool {} $rowmenuid
9444             }
9445         } else {
9446             error_popup $err
9447         }
9448         run updatecommits
9449         return
9450     }
9451     set newhead [exec git rev-parse HEAD]
9452     if {$newhead eq $oldhead} {
9453         notbusy cherrypick
9454         error_popup [mc "No changes committed"]
9455         return
9456     }
9457     addnewchild $newhead $oldhead
9458     if {[commitinview $oldhead $curview]} {
9459         # XXX this isn't right if we have a path limit...
9460         insertrow $newhead $oldhead $curview
9461         if {$mainhead ne {}} {
9462             movehead $newhead $mainhead
9463             movedhead $newhead $mainhead
9464         }
9465         set mainheadid $newhead
9466         redrawtags $oldhead
9467         redrawtags $newhead
9468         selbyid $newhead
9469     }
9470     notbusy cherrypick
9471 }
9472
9473 proc revert {} {
9474     global rowmenuid curview
9475     global mainhead mainheadid
9476     global gitdir
9477
9478     set oldhead [exec git rev-parse HEAD]
9479     set dheads [descheads $rowmenuid]
9480     if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9481        set ok [confirm_popup [mc "Commit %s is not\
9482            included in branch %s -- really revert it?" \
9483                       [string range $rowmenuid 0 7] $mainhead]]
9484        if {!$ok} return
9485     }
9486     nowbusy revert [mc "Reverting"]
9487     update
9488
9489     if [catch {exec git revert --no-edit $rowmenuid} err] {
9490         notbusy revert
9491         if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9492                 $err match files] {
9493             regsub {\n( |\t)+} $files "\n" files
9494             error_popup [mc "Revert failed because of local changes to\
9495                 the following files:%s Please commit, reset or stash \
9496                 your changes and try again." $files]
9497         } elseif [regexp {error: could not revert} $err] {
9498             if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9499                 Do you wish to run git citool to resolve it?"]] {
9500                 # Force citool to read MERGE_MSG
9501                 file delete [file join $gitdir "GITGUI_MSG"]
9502                 exec_citool {} $rowmenuid
9503             }
9504         } else { error_popup $err }
9505         run updatecommits
9506         return
9507     }
9508
9509     set newhead [exec git rev-parse HEAD]
9510     if { $newhead eq $oldhead } {
9511         notbusy revert
9512         error_popup [mc "No changes committed"]
9513         return
9514     }
9515
9516     addnewchild $newhead $oldhead
9517
9518     if [commitinview $oldhead $curview] {
9519         # XXX this isn't right if we have a path limit...
9520         insertrow $newhead $oldhead $curview
9521         if {$mainhead ne {}} {
9522             movehead $newhead $mainhead
9523             movedhead $newhead $mainhead
9524         }
9525         set mainheadid $newhead
9526         redrawtags $oldhead
9527         redrawtags $newhead
9528         selbyid $newhead
9529     }
9530
9531     notbusy revert
9532 }
9533
9534 proc resethead {} {
9535     global mainhead rowmenuid confirm_ok resettype NS
9536
9537     set confirm_ok 0
9538     set w ".confirmreset"
9539     ttk_toplevel $w
9540     make_transient $w .
9541     wm title $w [mc "Confirm reset"]
9542     ${NS}::label $w.m -text \
9543         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9544     pack $w.m -side top -fill x -padx 20 -pady 20
9545     ${NS}::labelframe $w.f -text [mc "Reset type:"]
9546     set resettype mixed
9547     ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9548         -text [mc "Soft: Leave working tree and index untouched"]
9549     grid $w.f.soft -sticky w
9550     ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9551         -text [mc "Mixed: Leave working tree untouched, reset index"]
9552     grid $w.f.mixed -sticky w
9553     ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9554         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9555     grid $w.f.hard -sticky w
9556     pack $w.f -side top -fill x -padx 4
9557     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9558     pack $w.ok -side left -fill x -padx 20 -pady 20
9559     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9560     bind $w <Key-Escape> [list destroy $w]
9561     pack $w.cancel -side right -fill x -padx 20 -pady 20
9562     bind $w <Visibility> "grab $w; focus $w"
9563     tkwait window $w
9564     if {!$confirm_ok} return
9565     if {[catch {set fd [open \
9566             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9567         error_popup $err
9568     } else {
9569         dohidelocalchanges
9570         filerun $fd [list readresetstat $fd]
9571         nowbusy reset [mc "Resetting"]
9572         selbyid $rowmenuid
9573     }
9574 }
9575
9576 proc readresetstat {fd} {
9577     global mainhead mainheadid showlocalchanges rprogcoord
9578
9579     if {[gets $fd line] >= 0} {
9580         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9581             set rprogcoord [expr {1.0 * $m / $n}]
9582             adjustprogress
9583         }
9584         return 1
9585     }
9586     set rprogcoord 0
9587     adjustprogress
9588     notbusy reset
9589     if {[catch {close $fd} err]} {
9590         error_popup $err
9591     }
9592     set oldhead $mainheadid
9593     set newhead [exec git rev-parse HEAD]
9594     if {$newhead ne $oldhead} {
9595         movehead $newhead $mainhead
9596         movedhead $newhead $mainhead
9597         set mainheadid $newhead
9598         redrawtags $oldhead
9599         redrawtags $newhead
9600     }
9601     if {$showlocalchanges} {
9602         doshowlocalchanges
9603     }
9604     return 0
9605 }
9606
9607 # context menu for a head
9608 proc headmenu {x y id head} {
9609     global headmenuid headmenuhead headctxmenu mainhead
9610
9611     stopfinding
9612     set headmenuid $id
9613     set headmenuhead $head
9614     set state normal
9615     if {[string match "remotes/*" $head]} {
9616         set state disabled
9617     }
9618     if {$head eq $mainhead} {
9619         set state disabled
9620     }
9621     $headctxmenu entryconfigure 0 -state $state
9622     $headctxmenu entryconfigure 1 -state $state
9623     tk_popup $headctxmenu $x $y
9624 }
9625
9626 proc cobranch {} {
9627     global headmenuid headmenuhead headids
9628     global showlocalchanges
9629
9630     # check the tree is clean first??
9631     nowbusy checkout [mc "Checking out"]
9632     update
9633     dohidelocalchanges
9634     if {[catch {
9635         set fd [open [list | git checkout $headmenuhead 2>@1] r]
9636     } err]} {
9637         notbusy checkout
9638         error_popup $err
9639         if {$showlocalchanges} {
9640             dodiffindex
9641         }
9642     } else {
9643         filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9644     }
9645 }
9646
9647 proc readcheckoutstat {fd newhead newheadid} {
9648     global mainhead mainheadid headids showlocalchanges progresscoords
9649     global viewmainheadid curview
9650
9651     if {[gets $fd line] >= 0} {
9652         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9653             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9654             adjustprogress
9655         }
9656         return 1
9657     }
9658     set progresscoords {0 0}
9659     adjustprogress
9660     notbusy checkout
9661     if {[catch {close $fd} err]} {
9662         error_popup $err
9663     }
9664     set oldmainid $mainheadid
9665     set mainhead $newhead
9666     set mainheadid $newheadid
9667     set viewmainheadid($curview) $newheadid
9668     redrawtags $oldmainid
9669     redrawtags $newheadid
9670     selbyid $newheadid
9671     if {$showlocalchanges} {
9672         dodiffindex
9673     }
9674 }
9675
9676 proc rmbranch {} {
9677     global headmenuid headmenuhead mainhead
9678     global idheads
9679
9680     set head $headmenuhead
9681     set id $headmenuid
9682     # this check shouldn't be needed any more...
9683     if {$head eq $mainhead} {
9684         error_popup [mc "Cannot delete the currently checked-out branch"]
9685         return
9686     }
9687     set dheads [descheads $id]
9688     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9689         # the stuff on this branch isn't on any other branch
9690         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9691                         branch.\nReally delete branch %s?" $head $head]]} return
9692     }
9693     nowbusy rmbranch
9694     update
9695     if {[catch {exec git branch -D $head} err]} {
9696         notbusy rmbranch
9697         error_popup $err
9698         return
9699     }
9700     removehead $id $head
9701     removedhead $id $head
9702     redrawtags $id
9703     notbusy rmbranch
9704     dispneartags 0
9705     run refill_reflist
9706 }
9707
9708 # Display a list of tags and heads
9709 proc showrefs {} {
9710     global showrefstop bgcolor fgcolor selectbgcolor NS
9711     global bglist fglist reflistfilter reflist maincursor
9712
9713     set top .showrefs
9714     set showrefstop $top
9715     if {[winfo exists $top]} {
9716         raise $top
9717         refill_reflist
9718         return
9719     }
9720     ttk_toplevel $top
9721     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9722     make_transient $top .
9723     text $top.list -background $bgcolor -foreground $fgcolor \
9724         -selectbackground $selectbgcolor -font mainfont \
9725         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9726         -width 30 -height 20 -cursor $maincursor \
9727         -spacing1 1 -spacing3 1 -state disabled
9728     $top.list tag configure highlight -background $selectbgcolor
9729     lappend bglist $top.list
9730     lappend fglist $top.list
9731     ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9732     ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9733     grid $top.list $top.ysb -sticky nsew
9734     grid $top.xsb x -sticky ew
9735     ${NS}::frame $top.f
9736     ${NS}::label $top.f.l -text "[mc "Filter"]: "
9737     ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9738     set reflistfilter "*"
9739     trace add variable reflistfilter write reflistfilter_change
9740     pack $top.f.e -side right -fill x -expand 1
9741     pack $top.f.l -side left
9742     grid $top.f - -sticky ew -pady 2
9743     ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9744     bind $top <Key-Escape> [list destroy $top]
9745     grid $top.close -
9746     grid columnconfigure $top 0 -weight 1
9747     grid rowconfigure $top 0 -weight 1
9748     bind $top.list <1> {break}
9749     bind $top.list <B1-Motion> {break}
9750     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9751     set reflist {}
9752     refill_reflist
9753 }
9754
9755 proc sel_reflist {w x y} {
9756     global showrefstop reflist headids tagids otherrefids
9757
9758     if {![winfo exists $showrefstop]} return
9759     set l [lindex [split [$w index "@$x,$y"] "."] 0]
9760     set ref [lindex $reflist [expr {$l-1}]]
9761     set n [lindex $ref 0]
9762     switch -- [lindex $ref 1] {
9763         "H" {selbyid $headids($n)}
9764         "T" {selbyid $tagids($n)}
9765         "o" {selbyid $otherrefids($n)}
9766     }
9767     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9768 }
9769
9770 proc unsel_reflist {} {
9771     global showrefstop
9772
9773     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9774     $showrefstop.list tag remove highlight 0.0 end
9775 }
9776
9777 proc reflistfilter_change {n1 n2 op} {
9778     global reflistfilter
9779
9780     after cancel refill_reflist
9781     after 200 refill_reflist
9782 }
9783
9784 proc refill_reflist {} {
9785     global reflist reflistfilter showrefstop headids tagids otherrefids
9786     global curview
9787
9788     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9789     set refs {}
9790     foreach n [array names headids] {
9791         if {[string match $reflistfilter $n]} {
9792             if {[commitinview $headids($n) $curview]} {
9793                 lappend refs [list $n H]
9794             } else {
9795                 interestedin $headids($n) {run refill_reflist}
9796             }
9797         }
9798     }
9799     foreach n [array names tagids] {
9800         if {[string match $reflistfilter $n]} {
9801             if {[commitinview $tagids($n) $curview]} {
9802                 lappend refs [list $n T]
9803             } else {
9804                 interestedin $tagids($n) {run refill_reflist}
9805             }
9806         }
9807     }
9808     foreach n [array names otherrefids] {
9809         if {[string match $reflistfilter $n]} {
9810             if {[commitinview $otherrefids($n) $curview]} {
9811                 lappend refs [list $n o]
9812             } else {
9813                 interestedin $otherrefids($n) {run refill_reflist}
9814             }
9815         }
9816     }
9817     set refs [lsort -index 0 $refs]
9818     if {$refs eq $reflist} return
9819
9820     # Update the contents of $showrefstop.list according to the
9821     # differences between $reflist (old) and $refs (new)
9822     $showrefstop.list conf -state normal
9823     $showrefstop.list insert end "\n"
9824     set i 0
9825     set j 0
9826     while {$i < [llength $reflist] || $j < [llength $refs]} {
9827         if {$i < [llength $reflist]} {
9828             if {$j < [llength $refs]} {
9829                 set cmp [string compare [lindex $reflist $i 0] \
9830                              [lindex $refs $j 0]]
9831                 if {$cmp == 0} {
9832                     set cmp [string compare [lindex $reflist $i 1] \
9833                                  [lindex $refs $j 1]]
9834                 }
9835             } else {
9836                 set cmp -1
9837             }
9838         } else {
9839             set cmp 1
9840         }
9841         switch -- $cmp {
9842             -1 {
9843                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9844                 incr i
9845             }
9846             0 {
9847                 incr i
9848                 incr j
9849             }
9850             1 {
9851                 set l [expr {$j + 1}]
9852                 $showrefstop.list image create $l.0 -align baseline \
9853                     -image reficon-[lindex $refs $j 1] -padx 2
9854                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9855                 incr j
9856             }
9857         }
9858     }
9859     set reflist $refs
9860     # delete last newline
9861     $showrefstop.list delete end-2c end-1c
9862     $showrefstop.list conf -state disabled
9863 }
9864
9865 # Stuff for finding nearby tags
9866 proc getallcommits {} {
9867     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9868     global idheads idtags idotherrefs allparents tagobjid
9869     global gitdir
9870
9871     if {![info exists allcommits]} {
9872         set nextarc 0
9873         set allcommits 0
9874         set seeds {}
9875         set allcwait 0
9876         set cachedarcs 0
9877         set allccache [file join $gitdir "gitk.cache"]
9878         if {![catch {
9879             set f [open $allccache r]
9880             set allcwait 1
9881             getcache $f
9882         }]} return
9883     }
9884
9885     if {$allcwait} {
9886         return
9887     }
9888     set cmd [list | git rev-list --parents]
9889     set allcupdate [expr {$seeds ne {}}]
9890     if {!$allcupdate} {
9891         set ids "--all"
9892     } else {
9893         set refs [concat [array names idheads] [array names idtags] \
9894                       [array names idotherrefs]]
9895         set ids {}
9896         set tagobjs {}
9897         foreach name [array names tagobjid] {
9898             lappend tagobjs $tagobjid($name)
9899         }
9900         foreach id [lsort -unique $refs] {
9901             if {![info exists allparents($id)] &&
9902                 [lsearch -exact $tagobjs $id] < 0} {
9903                 lappend ids $id
9904             }
9905         }
9906         if {$ids ne {}} {
9907             foreach id $seeds {
9908                 lappend ids "^$id"
9909             }
9910         }
9911     }
9912     if {$ids ne {}} {
9913         set fd [open [concat $cmd $ids] r]
9914         fconfigure $fd -blocking 0
9915         incr allcommits
9916         nowbusy allcommits
9917         filerun $fd [list getallclines $fd]
9918     } else {
9919         dispneartags 0
9920     }
9921 }
9922
9923 # Since most commits have 1 parent and 1 child, we group strings of
9924 # such commits into "arcs" joining branch/merge points (BMPs), which
9925 # are commits that either don't have 1 parent or don't have 1 child.
9926 #
9927 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9928 # arcout(id) - outgoing arcs for BMP
9929 # arcids(a) - list of IDs on arc including end but not start
9930 # arcstart(a) - BMP ID at start of arc
9931 # arcend(a) - BMP ID at end of arc
9932 # growing(a) - arc a is still growing
9933 # arctags(a) - IDs out of arcids (excluding end) that have tags
9934 # archeads(a) - IDs out of arcids (excluding end) that have heads
9935 # The start of an arc is at the descendent end, so "incoming" means
9936 # coming from descendents, and "outgoing" means going towards ancestors.
9937
9938 proc getallclines {fd} {
9939     global allparents allchildren idtags idheads nextarc
9940     global arcnos arcids arctags arcout arcend arcstart archeads growing
9941     global seeds allcommits cachedarcs allcupdate
9942
9943     set nid 0
9944     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9945         set id [lindex $line 0]
9946         if {[info exists allparents($id)]} {
9947             # seen it already
9948             continue
9949         }
9950         set cachedarcs 0
9951         set olds [lrange $line 1 end]
9952         set allparents($id) $olds
9953         if {![info exists allchildren($id)]} {
9954             set allchildren($id) {}
9955             set arcnos($id) {}
9956             lappend seeds $id
9957         } else {
9958             set a $arcnos($id)
9959             if {[llength $olds] == 1 && [llength $a] == 1} {
9960                 lappend arcids($a) $id
9961                 if {[info exists idtags($id)]} {
9962                     lappend arctags($a) $id
9963                 }
9964                 if {[info exists idheads($id)]} {
9965                     lappend archeads($a) $id
9966                 }
9967                 if {[info exists allparents($olds)]} {
9968                     # seen parent already
9969                     if {![info exists arcout($olds)]} {
9970                         splitarc $olds
9971                     }
9972                     lappend arcids($a) $olds
9973                     set arcend($a) $olds
9974                     unset growing($a)
9975                 }
9976                 lappend allchildren($olds) $id
9977                 lappend arcnos($olds) $a
9978                 continue
9979             }
9980         }
9981         foreach a $arcnos($id) {
9982             lappend arcids($a) $id
9983             set arcend($a) $id
9984             unset growing($a)
9985         }
9986
9987         set ao {}
9988         foreach p $olds {
9989             lappend allchildren($p) $id
9990             set a [incr nextarc]
9991             set arcstart($a) $id
9992             set archeads($a) {}
9993             set arctags($a) {}
9994             set archeads($a) {}
9995             set arcids($a) {}
9996             lappend ao $a
9997             set growing($a) 1
9998             if {[info exists allparents($p)]} {
9999                 # seen it already, may need to make a new branch
10000                 if {![info exists arcout($p)]} {
10001                     splitarc $p
10002                 }
10003                 lappend arcids($a) $p
10004                 set arcend($a) $p
10005                 unset growing($a)
10006             }
10007             lappend arcnos($p) $a
10008         }
10009         set arcout($id) $ao
10010     }
10011     if {$nid > 0} {
10012         global cached_dheads cached_dtags cached_atags
10013         catch {unset cached_dheads}
10014         catch {unset cached_dtags}
10015         catch {unset cached_atags}
10016     }
10017     if {![eof $fd]} {
10018         return [expr {$nid >= 1000? 2: 1}]
10019     }
10020     set cacheok 1
10021     if {[catch {
10022         fconfigure $fd -blocking 1
10023         close $fd
10024     } err]} {
10025         # got an error reading the list of commits
10026         # if we were updating, try rereading the whole thing again
10027         if {$allcupdate} {
10028             incr allcommits -1
10029             dropcache $err
10030             return
10031         }
10032         error_popup "[mc "Error reading commit topology information;\
10033                 branch and preceding/following tag information\
10034                 will be incomplete."]\n($err)"
10035         set cacheok 0
10036     }
10037     if {[incr allcommits -1] == 0} {
10038         notbusy allcommits
10039         if {$cacheok} {
10040             run savecache
10041         }
10042     }
10043     dispneartags 0
10044     return 0
10045 }
10046
10047 proc recalcarc {a} {
10048     global arctags archeads arcids idtags idheads
10049
10050     set at {}
10051     set ah {}
10052     foreach id [lrange $arcids($a) 0 end-1] {
10053         if {[info exists idtags($id)]} {
10054             lappend at $id
10055         }
10056         if {[info exists idheads($id)]} {
10057             lappend ah $id
10058         }
10059     }
10060     set arctags($a) $at
10061     set archeads($a) $ah
10062 }
10063
10064 proc splitarc {p} {
10065     global arcnos arcids nextarc arctags archeads idtags idheads
10066     global arcstart arcend arcout allparents growing
10067
10068     set a $arcnos($p)
10069     if {[llength $a] != 1} {
10070         puts "oops splitarc called but [llength $a] arcs already"
10071         return
10072     }
10073     set a [lindex $a 0]
10074     set i [lsearch -exact $arcids($a) $p]
10075     if {$i < 0} {
10076         puts "oops splitarc $p not in arc $a"
10077         return
10078     }
10079     set na [incr nextarc]
10080     if {[info exists arcend($a)]} {
10081         set arcend($na) $arcend($a)
10082     } else {
10083         set l [lindex $allparents([lindex $arcids($a) end]) 0]
10084         set j [lsearch -exact $arcnos($l) $a]
10085         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10086     }
10087     set tail [lrange $arcids($a) [expr {$i+1}] end]
10088     set arcids($a) [lrange $arcids($a) 0 $i]
10089     set arcend($a) $p
10090     set arcstart($na) $p
10091     set arcout($p) $na
10092     set arcids($na) $tail
10093     if {[info exists growing($a)]} {
10094         set growing($na) 1
10095         unset growing($a)
10096     }
10097
10098     foreach id $tail {
10099         if {[llength $arcnos($id)] == 1} {
10100             set arcnos($id) $na
10101         } else {
10102             set j [lsearch -exact $arcnos($id) $a]
10103             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10104         }
10105     }
10106
10107     # reconstruct tags and heads lists
10108     if {$arctags($a) ne {} || $archeads($a) ne {}} {
10109         recalcarc $a
10110         recalcarc $na
10111     } else {
10112         set arctags($na) {}
10113         set archeads($na) {}
10114     }
10115 }
10116
10117 # Update things for a new commit added that is a child of one
10118 # existing commit.  Used when cherry-picking.
10119 proc addnewchild {id p} {
10120     global allparents allchildren idtags nextarc
10121     global arcnos arcids arctags arcout arcend arcstart archeads growing
10122     global seeds allcommits
10123
10124     if {![info exists allcommits] || ![info exists arcnos($p)]} return
10125     set allparents($id) [list $p]
10126     set allchildren($id) {}
10127     set arcnos($id) {}
10128     lappend seeds $id
10129     lappend allchildren($p) $id
10130     set a [incr nextarc]
10131     set arcstart($a) $id
10132     set archeads($a) {}
10133     set arctags($a) {}
10134     set arcids($a) [list $p]
10135     set arcend($a) $p
10136     if {![info exists arcout($p)]} {
10137         splitarc $p
10138     }
10139     lappend arcnos($p) $a
10140     set arcout($id) [list $a]
10141 }
10142
10143 # This implements a cache for the topology information.
10144 # The cache saves, for each arc, the start and end of the arc,
10145 # the ids on the arc, and the outgoing arcs from the end.
10146 proc readcache {f} {
10147     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10148     global idtags idheads allparents cachedarcs possible_seeds seeds growing
10149     global allcwait
10150
10151     set a $nextarc
10152     set lim $cachedarcs
10153     if {$lim - $a > 500} {
10154         set lim [expr {$a + 500}]
10155     }
10156     if {[catch {
10157         if {$a == $lim} {
10158             # finish reading the cache and setting up arctags, etc.
10159             set line [gets $f]
10160             if {$line ne "1"} {error "bad final version"}
10161             close $f
10162             foreach id [array names idtags] {
10163                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10164                     [llength $allparents($id)] == 1} {
10165                     set a [lindex $arcnos($id) 0]
10166                     if {$arctags($a) eq {}} {
10167                         recalcarc $a
10168                     }
10169                 }
10170             }
10171             foreach id [array names idheads] {
10172                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10173                     [llength $allparents($id)] == 1} {
10174                     set a [lindex $arcnos($id) 0]
10175                     if {$archeads($a) eq {}} {
10176                         recalcarc $a
10177                     }
10178                 }
10179             }
10180             foreach id [lsort -unique $possible_seeds] {
10181                 if {$arcnos($id) eq {}} {
10182                     lappend seeds $id
10183                 }
10184             }
10185             set allcwait 0
10186         } else {
10187             while {[incr a] <= $lim} {
10188                 set line [gets $f]
10189                 if {[llength $line] != 3} {error "bad line"}
10190                 set s [lindex $line 0]
10191                 set arcstart($a) $s
10192                 lappend arcout($s) $a
10193                 if {![info exists arcnos($s)]} {
10194                     lappend possible_seeds $s
10195                     set arcnos($s) {}
10196                 }
10197                 set e [lindex $line 1]
10198                 if {$e eq {}} {
10199                     set growing($a) 1
10200                 } else {
10201                     set arcend($a) $e
10202                     if {![info exists arcout($e)]} {
10203                         set arcout($e) {}
10204                     }
10205                 }
10206                 set arcids($a) [lindex $line 2]
10207                 foreach id $arcids($a) {
10208                     lappend allparents($s) $id
10209                     set s $id
10210                     lappend arcnos($id) $a
10211                 }
10212                 if {![info exists allparents($s)]} {
10213                     set allparents($s) {}
10214                 }
10215                 set arctags($a) {}
10216                 set archeads($a) {}
10217             }
10218             set nextarc [expr {$a - 1}]
10219         }
10220     } err]} {
10221         dropcache $err
10222         return 0
10223     }
10224     if {!$allcwait} {
10225         getallcommits
10226     }
10227     return $allcwait
10228 }
10229
10230 proc getcache {f} {
10231     global nextarc cachedarcs possible_seeds
10232
10233     if {[catch {
10234         set line [gets $f]
10235         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10236         # make sure it's an integer
10237         set cachedarcs [expr {int([lindex $line 1])}]
10238         if {$cachedarcs < 0} {error "bad number of arcs"}
10239         set nextarc 0
10240         set possible_seeds {}
10241         run readcache $f
10242     } err]} {
10243         dropcache $err
10244     }
10245     return 0
10246 }
10247
10248 proc dropcache {err} {
10249     global allcwait nextarc cachedarcs seeds
10250
10251     #puts "dropping cache ($err)"
10252     foreach v {arcnos arcout arcids arcstart arcend growing \
10253                    arctags archeads allparents allchildren} {
10254         global $v
10255         catch {unset $v}
10256     }
10257     set allcwait 0
10258     set nextarc 0
10259     set cachedarcs 0
10260     set seeds {}
10261     getallcommits
10262 }
10263
10264 proc writecache {f} {
10265     global cachearc cachedarcs allccache
10266     global arcstart arcend arcnos arcids arcout
10267
10268     set a $cachearc
10269     set lim $cachedarcs
10270     if {$lim - $a > 1000} {
10271         set lim [expr {$a + 1000}]
10272     }
10273     if {[catch {
10274         while {[incr a] <= $lim} {
10275             if {[info exists arcend($a)]} {
10276                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10277             } else {
10278                 puts $f [list $arcstart($a) {} $arcids($a)]
10279             }
10280         }
10281     } err]} {
10282         catch {close $f}
10283         catch {file delete $allccache}
10284         #puts "writing cache failed ($err)"
10285         return 0
10286     }
10287     set cachearc [expr {$a - 1}]
10288     if {$a > $cachedarcs} {
10289         puts $f "1"
10290         close $f
10291         return 0
10292     }
10293     return 1
10294 }
10295
10296 proc savecache {} {
10297     global nextarc cachedarcs cachearc allccache
10298
10299     if {$nextarc == $cachedarcs} return
10300     set cachearc 0
10301     set cachedarcs $nextarc
10302     catch {
10303         set f [open $allccache w]
10304         puts $f [list 1 $cachedarcs]
10305         run writecache $f
10306     }
10307 }
10308
10309 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10310 # or 0 if neither is true.
10311 proc anc_or_desc {a b} {
10312     global arcout arcstart arcend arcnos cached_isanc
10313
10314     if {$arcnos($a) eq $arcnos($b)} {
10315         # Both are on the same arc(s); either both are the same BMP,
10316         # or if one is not a BMP, the other is also not a BMP or is
10317         # the BMP at end of the arc (and it only has 1 incoming arc).
10318         # Or both can be BMPs with no incoming arcs.
10319         if {$a eq $b || $arcnos($a) eq {}} {
10320             return 0
10321         }
10322         # assert {[llength $arcnos($a)] == 1}
10323         set arc [lindex $arcnos($a) 0]
10324         set i [lsearch -exact $arcids($arc) $a]
10325         set j [lsearch -exact $arcids($arc) $b]
10326         if {$i < 0 || $i > $j} {
10327             return 1
10328         } else {
10329             return -1
10330         }
10331     }
10332
10333     if {![info exists arcout($a)]} {
10334         set arc [lindex $arcnos($a) 0]
10335         if {[info exists arcend($arc)]} {
10336             set aend $arcend($arc)
10337         } else {
10338             set aend {}
10339         }
10340         set a $arcstart($arc)
10341     } else {
10342         set aend $a
10343     }
10344     if {![info exists arcout($b)]} {
10345         set arc [lindex $arcnos($b) 0]
10346         if {[info exists arcend($arc)]} {
10347             set bend $arcend($arc)
10348         } else {
10349             set bend {}
10350         }
10351         set b $arcstart($arc)
10352     } else {
10353         set bend $b
10354     }
10355     if {$a eq $bend} {
10356         return 1
10357     }
10358     if {$b eq $aend} {
10359         return -1
10360     }
10361     if {[info exists cached_isanc($a,$bend)]} {
10362         if {$cached_isanc($a,$bend)} {
10363             return 1
10364         }
10365     }
10366     if {[info exists cached_isanc($b,$aend)]} {
10367         if {$cached_isanc($b,$aend)} {
10368             return -1
10369         }
10370         if {[info exists cached_isanc($a,$bend)]} {
10371             return 0
10372         }
10373     }
10374
10375     set todo [list $a $b]
10376     set anc($a) a
10377     set anc($b) b
10378     for {set i 0} {$i < [llength $todo]} {incr i} {
10379         set x [lindex $todo $i]
10380         if {$anc($x) eq {}} {
10381             continue
10382         }
10383         foreach arc $arcnos($x) {
10384             set xd $arcstart($arc)
10385             if {$xd eq $bend} {
10386                 set cached_isanc($a,$bend) 1
10387                 set cached_isanc($b,$aend) 0
10388                 return 1
10389             } elseif {$xd eq $aend} {
10390                 set cached_isanc($b,$aend) 1
10391                 set cached_isanc($a,$bend) 0
10392                 return -1
10393             }
10394             if {![info exists anc($xd)]} {
10395                 set anc($xd) $anc($x)
10396                 lappend todo $xd
10397             } elseif {$anc($xd) ne $anc($x)} {
10398                 set anc($xd) {}
10399             }
10400         }
10401     }
10402     set cached_isanc($a,$bend) 0
10403     set cached_isanc($b,$aend) 0
10404     return 0
10405 }
10406
10407 # This identifies whether $desc has an ancestor that is
10408 # a growing tip of the graph and which is not an ancestor of $anc
10409 # and returns 0 if so and 1 if not.
10410 # If we subsequently discover a tag on such a growing tip, and that
10411 # turns out to be a descendent of $anc (which it could, since we
10412 # don't necessarily see children before parents), then $desc
10413 # isn't a good choice to display as a descendent tag of
10414 # $anc (since it is the descendent of another tag which is
10415 # a descendent of $anc).  Similarly, $anc isn't a good choice to
10416 # display as a ancestor tag of $desc.
10417 #
10418 proc is_certain {desc anc} {
10419     global arcnos arcout arcstart arcend growing problems
10420
10421     set certain {}
10422     if {[llength $arcnos($anc)] == 1} {
10423         # tags on the same arc are certain
10424         if {$arcnos($desc) eq $arcnos($anc)} {
10425             return 1
10426         }
10427         if {![info exists arcout($anc)]} {
10428             # if $anc is partway along an arc, use the start of the arc instead
10429             set a [lindex $arcnos($anc) 0]
10430             set anc $arcstart($a)
10431         }
10432     }
10433     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10434         set x $desc
10435     } else {
10436         set a [lindex $arcnos($desc) 0]
10437         set x $arcend($a)
10438     }
10439     if {$x == $anc} {
10440         return 1
10441     }
10442     set anclist [list $x]
10443     set dl($x) 1
10444     set nnh 1
10445     set ngrowanc 0
10446     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10447         set x [lindex $anclist $i]
10448         if {$dl($x)} {
10449             incr nnh -1
10450         }
10451         set done($x) 1
10452         foreach a $arcout($x) {
10453             if {[info exists growing($a)]} {
10454                 if {![info exists growanc($x)] && $dl($x)} {
10455                     set growanc($x) 1
10456                     incr ngrowanc
10457                 }
10458             } else {
10459                 set y $arcend($a)
10460                 if {[info exists dl($y)]} {
10461                     if {$dl($y)} {
10462                         if {!$dl($x)} {
10463                             set dl($y) 0
10464                             if {![info exists done($y)]} {
10465                                 incr nnh -1
10466                             }
10467                             if {[info exists growanc($x)]} {
10468                                 incr ngrowanc -1
10469                             }
10470                             set xl [list $y]
10471                             for {set k 0} {$k < [llength $xl]} {incr k} {
10472                                 set z [lindex $xl $k]
10473                                 foreach c $arcout($z) {
10474                                     if {[info exists arcend($c)]} {
10475                                         set v $arcend($c)
10476                                         if {[info exists dl($v)] && $dl($v)} {
10477                                             set dl($v) 0
10478                                             if {![info exists done($v)]} {
10479                                                 incr nnh -1
10480                                             }
10481                                             if {[info exists growanc($v)]} {
10482                                                 incr ngrowanc -1
10483                                             }
10484                                             lappend xl $v
10485                                         }
10486                                     }
10487                                 }
10488                             }
10489                         }
10490                     }
10491                 } elseif {$y eq $anc || !$dl($x)} {
10492                     set dl($y) 0
10493                     lappend anclist $y
10494                 } else {
10495                     set dl($y) 1
10496                     lappend anclist $y
10497                     incr nnh
10498                 }
10499             }
10500         }
10501     }
10502     foreach x [array names growanc] {
10503         if {$dl($x)} {
10504             return 0
10505         }
10506         return 0
10507     }
10508     return 1
10509 }
10510
10511 proc validate_arctags {a} {
10512     global arctags idtags
10513
10514     set i -1
10515     set na $arctags($a)
10516     foreach id $arctags($a) {
10517         incr i
10518         if {![info exists idtags($id)]} {
10519             set na [lreplace $na $i $i]
10520             incr i -1
10521         }
10522     }
10523     set arctags($a) $na
10524 }
10525
10526 proc validate_archeads {a} {
10527     global archeads idheads
10528
10529     set i -1
10530     set na $archeads($a)
10531     foreach id $archeads($a) {
10532         incr i
10533         if {![info exists idheads($id)]} {
10534             set na [lreplace $na $i $i]
10535             incr i -1
10536         }
10537     }
10538     set archeads($a) $na
10539 }
10540
10541 # Return the list of IDs that have tags that are descendents of id,
10542 # ignoring IDs that are descendents of IDs already reported.
10543 proc desctags {id} {
10544     global arcnos arcstart arcids arctags idtags allparents
10545     global growing cached_dtags
10546
10547     if {![info exists allparents($id)]} {
10548         return {}
10549     }
10550     set t1 [clock clicks -milliseconds]
10551     set argid $id
10552     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10553         # part-way along an arc; check that arc first
10554         set a [lindex $arcnos($id) 0]
10555         if {$arctags($a) ne {}} {
10556             validate_arctags $a
10557             set i [lsearch -exact $arcids($a) $id]
10558             set tid {}
10559             foreach t $arctags($a) {
10560                 set j [lsearch -exact $arcids($a) $t]
10561                 if {$j >= $i} break
10562                 set tid $t
10563             }
10564             if {$tid ne {}} {
10565                 return $tid
10566             }
10567         }
10568         set id $arcstart($a)
10569         if {[info exists idtags($id)]} {
10570             return $id
10571         }
10572     }
10573     if {[info exists cached_dtags($id)]} {
10574         return $cached_dtags($id)
10575     }
10576
10577     set origid $id
10578     set todo [list $id]
10579     set queued($id) 1
10580     set nc 1
10581     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10582         set id [lindex $todo $i]
10583         set done($id) 1
10584         set ta [info exists hastaggedancestor($id)]
10585         if {!$ta} {
10586             incr nc -1
10587         }
10588         # ignore tags on starting node
10589         if {!$ta && $i > 0} {
10590             if {[info exists idtags($id)]} {
10591                 set tagloc($id) $id
10592                 set ta 1
10593             } elseif {[info exists cached_dtags($id)]} {
10594                 set tagloc($id) $cached_dtags($id)
10595                 set ta 1
10596             }
10597         }
10598         foreach a $arcnos($id) {
10599             set d $arcstart($a)
10600             if {!$ta && $arctags($a) ne {}} {
10601                 validate_arctags $a
10602                 if {$arctags($a) ne {}} {
10603                     lappend tagloc($id) [lindex $arctags($a) end]
10604                 }
10605             }
10606             if {$ta || $arctags($a) ne {}} {
10607                 set tomark [list $d]
10608                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10609                     set dd [lindex $tomark $j]
10610                     if {![info exists hastaggedancestor($dd)]} {
10611                         if {[info exists done($dd)]} {
10612                             foreach b $arcnos($dd) {
10613                                 lappend tomark $arcstart($b)
10614                             }
10615                             if {[info exists tagloc($dd)]} {
10616                                 unset tagloc($dd)
10617                             }
10618                         } elseif {[info exists queued($dd)]} {
10619                             incr nc -1
10620                         }
10621                         set hastaggedancestor($dd) 1
10622                     }
10623                 }
10624             }
10625             if {![info exists queued($d)]} {
10626                 lappend todo $d
10627                 set queued($d) 1
10628                 if {![info exists hastaggedancestor($d)]} {
10629                     incr nc
10630                 }
10631             }
10632         }
10633     }
10634     set tags {}
10635     foreach id [array names tagloc] {
10636         if {![info exists hastaggedancestor($id)]} {
10637             foreach t $tagloc($id) {
10638                 if {[lsearch -exact $tags $t] < 0} {
10639                     lappend tags $t
10640                 }
10641             }
10642         }
10643     }
10644     set t2 [clock clicks -milliseconds]
10645     set loopix $i
10646
10647     # remove tags that are descendents of other tags
10648     for {set i 0} {$i < [llength $tags]} {incr i} {
10649         set a [lindex $tags $i]
10650         for {set j 0} {$j < $i} {incr j} {
10651             set b [lindex $tags $j]
10652             set r [anc_or_desc $a $b]
10653             if {$r == 1} {
10654                 set tags [lreplace $tags $j $j]
10655                 incr j -1
10656                 incr i -1
10657             } elseif {$r == -1} {
10658                 set tags [lreplace $tags $i $i]
10659                 incr i -1
10660                 break
10661             }
10662         }
10663     }
10664
10665     if {[array names growing] ne {}} {
10666         # graph isn't finished, need to check if any tag could get
10667         # eclipsed by another tag coming later.  Simply ignore any
10668         # tags that could later get eclipsed.
10669         set ctags {}
10670         foreach t $tags {
10671             if {[is_certain $t $origid]} {
10672                 lappend ctags $t
10673             }
10674         }
10675         if {$tags eq $ctags} {
10676             set cached_dtags($origid) $tags
10677         } else {
10678             set tags $ctags
10679         }
10680     } else {
10681         set cached_dtags($origid) $tags
10682     }
10683     set t3 [clock clicks -milliseconds]
10684     if {0 && $t3 - $t1 >= 100} {
10685         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10686             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10687     }
10688     return $tags
10689 }
10690
10691 proc anctags {id} {
10692     global arcnos arcids arcout arcend arctags idtags allparents
10693     global growing cached_atags
10694
10695     if {![info exists allparents($id)]} {
10696         return {}
10697     }
10698     set t1 [clock clicks -milliseconds]
10699     set argid $id
10700     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10701         # part-way along an arc; check that arc first
10702         set a [lindex $arcnos($id) 0]
10703         if {$arctags($a) ne {}} {
10704             validate_arctags $a
10705             set i [lsearch -exact $arcids($a) $id]
10706             foreach t $arctags($a) {
10707                 set j [lsearch -exact $arcids($a) $t]
10708                 if {$j > $i} {
10709                     return $t
10710                 }
10711             }
10712         }
10713         if {![info exists arcend($a)]} {
10714             return {}
10715         }
10716         set id $arcend($a)
10717         if {[info exists idtags($id)]} {
10718             return $id
10719         }
10720     }
10721     if {[info exists cached_atags($id)]} {
10722         return $cached_atags($id)
10723     }
10724
10725     set origid $id
10726     set todo [list $id]
10727     set queued($id) 1
10728     set taglist {}
10729     set nc 1
10730     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10731         set id [lindex $todo $i]
10732         set done($id) 1
10733         set td [info exists hastaggeddescendent($id)]
10734         if {!$td} {
10735             incr nc -1
10736         }
10737         # ignore tags on starting node
10738         if {!$td && $i > 0} {
10739             if {[info exists idtags($id)]} {
10740                 set tagloc($id) $id
10741                 set td 1
10742             } elseif {[info exists cached_atags($id)]} {
10743                 set tagloc($id) $cached_atags($id)
10744                 set td 1
10745             }
10746         }
10747         foreach a $arcout($id) {
10748             if {!$td && $arctags($a) ne {}} {
10749                 validate_arctags $a
10750                 if {$arctags($a) ne {}} {
10751                     lappend tagloc($id) [lindex $arctags($a) 0]
10752                 }
10753             }
10754             if {![info exists arcend($a)]} continue
10755             set d $arcend($a)
10756             if {$td || $arctags($a) ne {}} {
10757                 set tomark [list $d]
10758                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10759                     set dd [lindex $tomark $j]
10760                     if {![info exists hastaggeddescendent($dd)]} {
10761                         if {[info exists done($dd)]} {
10762                             foreach b $arcout($dd) {
10763                                 if {[info exists arcend($b)]} {
10764                                     lappend tomark $arcend($b)
10765                                 }
10766                             }
10767                             if {[info exists tagloc($dd)]} {
10768                                 unset tagloc($dd)
10769                             }
10770                         } elseif {[info exists queued($dd)]} {
10771                             incr nc -1
10772                         }
10773                         set hastaggeddescendent($dd) 1
10774                     }
10775                 }
10776             }
10777             if {![info exists queued($d)]} {
10778                 lappend todo $d
10779                 set queued($d) 1
10780                 if {![info exists hastaggeddescendent($d)]} {
10781                     incr nc
10782                 }
10783             }
10784         }
10785     }
10786     set t2 [clock clicks -milliseconds]
10787     set loopix $i
10788     set tags {}
10789     foreach id [array names tagloc] {
10790         if {![info exists hastaggeddescendent($id)]} {
10791             foreach t $tagloc($id) {
10792                 if {[lsearch -exact $tags $t] < 0} {
10793                     lappend tags $t
10794                 }
10795             }
10796         }
10797     }
10798
10799     # remove tags that are ancestors of other tags
10800     for {set i 0} {$i < [llength $tags]} {incr i} {
10801         set a [lindex $tags $i]
10802         for {set j 0} {$j < $i} {incr j} {
10803             set b [lindex $tags $j]
10804             set r [anc_or_desc $a $b]
10805             if {$r == -1} {
10806                 set tags [lreplace $tags $j $j]
10807                 incr j -1
10808                 incr i -1
10809             } elseif {$r == 1} {
10810                 set tags [lreplace $tags $i $i]
10811                 incr i -1
10812                 break
10813             }
10814         }
10815     }
10816
10817     if {[array names growing] ne {}} {
10818         # graph isn't finished, need to check if any tag could get
10819         # eclipsed by another tag coming later.  Simply ignore any
10820         # tags that could later get eclipsed.
10821         set ctags {}
10822         foreach t $tags {
10823             if {[is_certain $origid $t]} {
10824                 lappend ctags $t
10825             }
10826         }
10827         if {$tags eq $ctags} {
10828             set cached_atags($origid) $tags
10829         } else {
10830             set tags $ctags
10831         }
10832     } else {
10833         set cached_atags($origid) $tags
10834     }
10835     set t3 [clock clicks -milliseconds]
10836     if {0 && $t3 - $t1 >= 100} {
10837         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10838             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10839     }
10840     return $tags
10841 }
10842
10843 # Return the list of IDs that have heads that are descendents of id,
10844 # including id itself if it has a head.
10845 proc descheads {id} {
10846     global arcnos arcstart arcids archeads idheads cached_dheads
10847     global allparents arcout
10848
10849     if {![info exists allparents($id)]} {
10850         return {}
10851     }
10852     set aret {}
10853     if {![info exists arcout($id)]} {
10854         # part-way along an arc; check it first
10855         set a [lindex $arcnos($id) 0]
10856         if {$archeads($a) ne {}} {
10857             validate_archeads $a
10858             set i [lsearch -exact $arcids($a) $id]
10859             foreach t $archeads($a) {
10860                 set j [lsearch -exact $arcids($a) $t]
10861                 if {$j > $i} break
10862                 lappend aret $t
10863             }
10864         }
10865         set id $arcstart($a)
10866     }
10867     set origid $id
10868     set todo [list $id]
10869     set seen($id) 1
10870     set ret {}
10871     for {set i 0} {$i < [llength $todo]} {incr i} {
10872         set id [lindex $todo $i]
10873         if {[info exists cached_dheads($id)]} {
10874             set ret [concat $ret $cached_dheads($id)]
10875         } else {
10876             if {[info exists idheads($id)]} {
10877                 lappend ret $id
10878             }
10879             foreach a $arcnos($id) {
10880                 if {$archeads($a) ne {}} {
10881                     validate_archeads $a
10882                     if {$archeads($a) ne {}} {
10883                         set ret [concat $ret $archeads($a)]
10884                     }
10885                 }
10886                 set d $arcstart($a)
10887                 if {![info exists seen($d)]} {
10888                     lappend todo $d
10889                     set seen($d) 1
10890                 }
10891             }
10892         }
10893     }
10894     set ret [lsort -unique $ret]
10895     set cached_dheads($origid) $ret
10896     return [concat $ret $aret]
10897 }
10898
10899 proc addedtag {id} {
10900     global arcnos arcout cached_dtags cached_atags
10901
10902     if {![info exists arcnos($id)]} return
10903     if {![info exists arcout($id)]} {
10904         recalcarc [lindex $arcnos($id) 0]
10905     }
10906     catch {unset cached_dtags}
10907     catch {unset cached_atags}
10908 }
10909
10910 proc addedhead {hid head} {
10911     global arcnos arcout cached_dheads
10912
10913     if {![info exists arcnos($hid)]} return
10914     if {![info exists arcout($hid)]} {
10915         recalcarc [lindex $arcnos($hid) 0]
10916     }
10917     catch {unset cached_dheads}
10918 }
10919
10920 proc removedhead {hid head} {
10921     global cached_dheads
10922
10923     catch {unset cached_dheads}
10924 }
10925
10926 proc movedhead {hid head} {
10927     global arcnos arcout cached_dheads
10928
10929     if {![info exists arcnos($hid)]} return
10930     if {![info exists arcout($hid)]} {
10931         recalcarc [lindex $arcnos($hid) 0]
10932     }
10933     catch {unset cached_dheads}
10934 }
10935
10936 proc changedrefs {} {
10937     global cached_dheads cached_dtags cached_atags cached_tagcontent
10938     global arctags archeads arcnos arcout idheads idtags
10939
10940     foreach id [concat [array names idheads] [array names idtags]] {
10941         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10942             set a [lindex $arcnos($id) 0]
10943             if {![info exists donearc($a)]} {
10944                 recalcarc $a
10945                 set donearc($a) 1
10946             }
10947         }
10948     }
10949     catch {unset cached_tagcontent}
10950     catch {unset cached_dtags}
10951     catch {unset cached_atags}
10952     catch {unset cached_dheads}
10953 }
10954
10955 proc rereadrefs {} {
10956     global idtags idheads idotherrefs mainheadid
10957
10958     set refids [concat [array names idtags] \
10959                     [array names idheads] [array names idotherrefs]]
10960     foreach id $refids {
10961         if {![info exists ref($id)]} {
10962             set ref($id) [listrefs $id]
10963         }
10964     }
10965     set oldmainhead $mainheadid
10966     readrefs
10967     changedrefs
10968     set refids [lsort -unique [concat $refids [array names idtags] \
10969                         [array names idheads] [array names idotherrefs]]]
10970     foreach id $refids {
10971         set v [listrefs $id]
10972         if {![info exists ref($id)] || $ref($id) != $v} {
10973             redrawtags $id
10974         }
10975     }
10976     if {$oldmainhead ne $mainheadid} {
10977         redrawtags $oldmainhead
10978         redrawtags $mainheadid
10979     }
10980     run refill_reflist
10981 }
10982
10983 proc listrefs {id} {
10984     global idtags idheads idotherrefs
10985
10986     set x {}
10987     if {[info exists idtags($id)]} {
10988         set x $idtags($id)
10989     }
10990     set y {}
10991     if {[info exists idheads($id)]} {
10992         set y $idheads($id)
10993     }
10994     set z {}
10995     if {[info exists idotherrefs($id)]} {
10996         set z $idotherrefs($id)
10997     }
10998     return [list $x $y $z]
10999 }
11000
11001 proc add_tag_ctext {tag} {
11002     global ctext cached_tagcontent tagids
11003
11004     if {![info exists cached_tagcontent($tag)]} {
11005         catch {
11006             set cached_tagcontent($tag) [exec git cat-file -p $tag]
11007         }
11008     }
11009     $ctext insert end "[mc "Tag"]: $tag\n" bold
11010     if {[info exists cached_tagcontent($tag)]} {
11011         set text $cached_tagcontent($tag)
11012     } else {
11013         set text "[mc "Id"]:  $tagids($tag)"
11014     }
11015     appendwithlinks $text {}
11016 }
11017
11018 proc showtag {tag isnew} {
11019     global ctext cached_tagcontent tagids linknum tagobjid
11020
11021     if {$isnew} {
11022         addtohistory [list showtag $tag 0] savectextpos
11023     }
11024     $ctext conf -state normal
11025     clear_ctext
11026     settabs 0
11027     set linknum 0
11028     add_tag_ctext $tag
11029     maybe_scroll_ctext 1
11030     $ctext conf -state disabled
11031     init_flist {}
11032 }
11033
11034 proc showtags {id isnew} {
11035     global idtags ctext linknum
11036
11037     if {$isnew} {
11038         addtohistory [list showtags $id 0] savectextpos
11039     }
11040     $ctext conf -state normal
11041     clear_ctext
11042     settabs 0
11043     set linknum 0
11044     set sep {}
11045     foreach tag $idtags($id) {
11046         $ctext insert end $sep
11047         add_tag_ctext $tag
11048         set sep "\n\n"
11049     }
11050     maybe_scroll_ctext 1
11051     $ctext conf -state disabled
11052     init_flist {}
11053 }
11054
11055 proc doquit {} {
11056     global stopped
11057     global gitktmpdir
11058
11059     set stopped 100
11060     savestuff .
11061     destroy .
11062
11063     if {[info exists gitktmpdir]} {
11064         catch {file delete -force $gitktmpdir}
11065     }
11066 }
11067
11068 proc mkfontdisp {font top which} {
11069     global fontattr fontpref $font NS use_ttk
11070
11071     set fontpref($font) [set $font]
11072     ${NS}::button $top.${font}but -text $which \
11073         -command [list choosefont $font $which]
11074     ${NS}::label $top.$font -relief flat -font $font \
11075         -text $fontattr($font,family) -justify left
11076     grid x $top.${font}but $top.$font -sticky w
11077 }
11078
11079 proc choosefont {font which} {
11080     global fontparam fontlist fonttop fontattr
11081     global prefstop NS
11082
11083     set fontparam(which) $which
11084     set fontparam(font) $font
11085     set fontparam(family) [font actual $font -family]
11086     set fontparam(size) $fontattr($font,size)
11087     set fontparam(weight) $fontattr($font,weight)
11088     set fontparam(slant) $fontattr($font,slant)
11089     set top .gitkfont
11090     set fonttop $top
11091     if {![winfo exists $top]} {
11092         font create sample
11093         eval font config sample [font actual $font]
11094         ttk_toplevel $top
11095         make_transient $top $prefstop
11096         wm title $top [mc "Gitk font chooser"]
11097         ${NS}::label $top.l -textvariable fontparam(which)
11098         pack $top.l -side top
11099         set fontlist [lsort [font families]]
11100         ${NS}::frame $top.f
11101         listbox $top.f.fam -listvariable fontlist \
11102             -yscrollcommand [list $top.f.sb set]
11103         bind $top.f.fam <<ListboxSelect>> selfontfam
11104         ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11105         pack $top.f.sb -side right -fill y
11106         pack $top.f.fam -side left -fill both -expand 1
11107         pack $top.f -side top -fill both -expand 1
11108         ${NS}::frame $top.g
11109         spinbox $top.g.size -from 4 -to 40 -width 4 \
11110             -textvariable fontparam(size) \
11111             -validatecommand {string is integer -strict %s}
11112         checkbutton $top.g.bold -padx 5 \
11113             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11114             -variable fontparam(weight) -onvalue bold -offvalue normal
11115         checkbutton $top.g.ital -padx 5 \
11116             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
11117             -variable fontparam(slant) -onvalue italic -offvalue roman
11118         pack $top.g.size $top.g.bold $top.g.ital -side left
11119         pack $top.g -side top
11120         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11121             -background white
11122         $top.c create text 100 25 -anchor center -text $which -font sample \
11123             -fill black -tags text
11124         bind $top.c <Configure> [list centertext $top.c]
11125         pack $top.c -side top -fill x
11126         ${NS}::frame $top.buts
11127         ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11128         ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11129         bind $top <Key-Return> fontok
11130         bind $top <Key-Escape> fontcan
11131         grid $top.buts.ok $top.buts.can
11132         grid columnconfigure $top.buts 0 -weight 1 -uniform a
11133         grid columnconfigure $top.buts 1 -weight 1 -uniform a
11134         pack $top.buts -side bottom -fill x
11135         trace add variable fontparam write chg_fontparam
11136     } else {
11137         raise $top
11138         $top.c itemconf text -text $which
11139     }
11140     set i [lsearch -exact $fontlist $fontparam(family)]
11141     if {$i >= 0} {
11142         $top.f.fam selection set $i
11143         $top.f.fam see $i
11144     }
11145 }
11146
11147 proc centertext {w} {
11148     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11149 }
11150
11151 proc fontok {} {
11152     global fontparam fontpref prefstop
11153
11154     set f $fontparam(font)
11155     set fontpref($f) [list $fontparam(family) $fontparam(size)]
11156     if {$fontparam(weight) eq "bold"} {
11157         lappend fontpref($f) "bold"
11158     }
11159     if {$fontparam(slant) eq "italic"} {
11160         lappend fontpref($f) "italic"
11161     }
11162     set w $prefstop.notebook.fonts.$f
11163     $w conf -text $fontparam(family) -font $fontpref($f)
11164
11165     fontcan
11166 }
11167
11168 proc fontcan {} {
11169     global fonttop fontparam
11170
11171     if {[info exists fonttop]} {
11172         catch {destroy $fonttop}
11173         catch {font delete sample}
11174         unset fonttop
11175         unset fontparam
11176     }
11177 }
11178
11179 if {[package vsatisfies [package provide Tk] 8.6]} {
11180     # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11181     # function to make use of it.
11182     proc choosefont {font which} {
11183         tk fontchooser configure -title $which -font $font \
11184             -command [list on_choosefont $font $which]
11185         tk fontchooser show
11186     }
11187     proc on_choosefont {font which newfont} {
11188         global fontparam
11189         puts stderr "$font $newfont"
11190         array set f [font actual $newfont]
11191         set fontparam(which) $which
11192         set fontparam(font) $font
11193         set fontparam(family) $f(-family)
11194         set fontparam(size) $f(-size)
11195         set fontparam(weight) $f(-weight)
11196         set fontparam(slant) $f(-slant)
11197         fontok
11198     }
11199 }
11200
11201 proc selfontfam {} {
11202     global fonttop fontparam
11203
11204     set i [$fonttop.f.fam curselection]
11205     if {$i ne {}} {
11206         set fontparam(family) [$fonttop.f.fam get $i]
11207     }
11208 }
11209
11210 proc chg_fontparam {v sub op} {
11211     global fontparam
11212
11213     font config sample -$sub $fontparam($sub)
11214 }
11215
11216 # Create a property sheet tab page
11217 proc create_prefs_page {w} {
11218     global NS
11219     set parent [join [lrange [split $w .] 0 end-1] .]
11220     if {[winfo class $parent] eq "TNotebook"} {
11221         ${NS}::frame $w
11222     } else {
11223         ${NS}::labelframe $w
11224     }
11225 }
11226
11227 proc prefspage_general {notebook} {
11228     global NS maxwidth maxgraphpct showneartags showlocalchanges
11229     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11230     global hideremotes want_ttk have_ttk maxrefs
11231
11232     set page [create_prefs_page $notebook.general]
11233
11234     ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11235     grid $page.ldisp - -sticky w -pady 10
11236     ${NS}::label $page.spacer -text " "
11237     ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11238     spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11239     grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11240     ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11241     spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11242     grid x $page.maxpctl $page.maxpct -sticky w
11243     ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11244         -variable showlocalchanges
11245     grid x $page.showlocal -sticky w
11246     ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11247         -variable autoselect
11248     spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11249     grid x $page.autoselect $page.autosellen -sticky w
11250     ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11251         -variable hideremotes
11252     grid x $page.hideremotes -sticky w
11253
11254     ${NS}::label $page.ddisp -text [mc "Diff display options"]
11255     grid $page.ddisp - -sticky w -pady 10
11256     ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11257     spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11258     grid x $page.tabstopl $page.tabstop -sticky w
11259     ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11260         -variable showneartags
11261     grid x $page.ntag -sticky w
11262     ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11263     spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11264     grid x $page.maxrefsl $page.maxrefs -sticky w
11265     ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11266         -variable limitdiffs
11267     grid x $page.ldiff -sticky w
11268     ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11269         -variable perfile_attrs
11270     grid x $page.lattr -sticky w
11271
11272     ${NS}::entry $page.extdifft -textvariable extdifftool
11273     ${NS}::frame $page.extdifff
11274     ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11275     ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11276     pack $page.extdifff.l $page.extdifff.b -side left
11277     pack configure $page.extdifff.l -padx 10
11278     grid x $page.extdifff $page.extdifft -sticky ew
11279
11280     ${NS}::label $page.lgen -text [mc "General options"]
11281     grid $page.lgen - -sticky w -pady 10
11282     ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11283         -text [mc "Use themed widgets"]
11284     if {$have_ttk} {
11285         ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11286     } else {
11287         ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11288     }
11289     grid x $page.want_ttk $page.ttk_note -sticky w
11290     return $page
11291 }
11292
11293 proc prefspage_colors {notebook} {
11294     global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11295
11296     set page [create_prefs_page $notebook.colors]
11297
11298     ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11299     grid $page.cdisp - -sticky w -pady 10
11300     label $page.ui -padx 40 -relief sunk -background $uicolor
11301     ${NS}::button $page.uibut -text [mc "Interface"] \
11302        -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11303     grid x $page.uibut $page.ui -sticky w
11304     label $page.bg -padx 40 -relief sunk -background $bgcolor
11305     ${NS}::button $page.bgbut -text [mc "Background"] \
11306         -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11307     grid x $page.bgbut $page.bg -sticky w
11308     label $page.fg -padx 40 -relief sunk -background $fgcolor
11309     ${NS}::button $page.fgbut -text [mc "Foreground"] \
11310         -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11311     grid x $page.fgbut $page.fg -sticky w
11312     label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11313     ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11314         -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11315                       [list $ctext tag conf d0 -foreground]]
11316     grid x $page.diffoldbut $page.diffold -sticky w
11317     label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11318     ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11319         -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11320                       [list $ctext tag conf dresult -foreground]]
11321     grid x $page.diffnewbut $page.diffnew -sticky w
11322     label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11323     ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11324         -command [list choosecolor diffcolors 2 $page.hunksep \
11325                       [mc "diff hunk header"] \
11326                       [list $ctext tag conf hunksep -foreground]]
11327     grid x $page.hunksepbut $page.hunksep -sticky w
11328     label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11329     ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11330         -command [list choosecolor markbgcolor {} $page.markbgsep \
11331                       [mc "marked line background"] \
11332                       [list $ctext tag conf omark -background]]
11333     grid x $page.markbgbut $page.markbgsep -sticky w
11334     label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11335     ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11336         -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11337     grid x $page.selbgbut $page.selbgsep -sticky w
11338     return $page
11339 }
11340
11341 proc prefspage_fonts {notebook} {
11342     global NS
11343     set page [create_prefs_page $notebook.fonts]
11344     ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11345     grid $page.cfont - -sticky w -pady 10
11346     mkfontdisp mainfont $page [mc "Main font"]
11347     mkfontdisp textfont $page [mc "Diff display font"]
11348     mkfontdisp uifont $page [mc "User interface font"]
11349     return $page
11350 }
11351
11352 proc doprefs {} {
11353     global maxwidth maxgraphpct use_ttk NS
11354     global oldprefs prefstop showneartags showlocalchanges
11355     global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11356     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11357     global hideremotes want_ttk have_ttk
11358
11359     set top .gitkprefs
11360     set prefstop $top
11361     if {[winfo exists $top]} {
11362         raise $top
11363         return
11364     }
11365     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11366                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11367         set oldprefs($v) [set $v]
11368     }
11369     ttk_toplevel $top
11370     wm title $top [mc "Gitk preferences"]
11371     make_transient $top .
11372
11373     if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11374         set notebook [ttk::notebook $top.notebook]
11375     } else {
11376         set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11377     }
11378
11379     lappend pages [prefspage_general $notebook] [mc "General"]
11380     lappend pages [prefspage_colors $notebook] [mc "Colors"]
11381     lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11382     set col 0
11383     foreach {page title} $pages {
11384         if {$use_notebook} {
11385             $notebook add $page -text $title
11386         } else {
11387             set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11388                          -text $title -command [list raise $page]]
11389             $page configure -text $title
11390             grid $btn -row 0 -column [incr col] -sticky w
11391             grid $page -row 1 -column 0 -sticky news -columnspan 100
11392         }
11393     }
11394
11395     if {!$use_notebook} {
11396         grid columnconfigure $notebook 0 -weight 1
11397         grid rowconfigure $notebook 1 -weight 1
11398         raise [lindex $pages 0]
11399     }
11400
11401     grid $notebook -sticky news -padx 2 -pady 2
11402     grid rowconfigure $top 0 -weight 1
11403     grid columnconfigure $top 0 -weight 1
11404
11405     ${NS}::frame $top.buts
11406     ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11407     ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11408     bind $top <Key-Return> prefsok
11409     bind $top <Key-Escape> prefscan
11410     grid $top.buts.ok $top.buts.can
11411     grid columnconfigure $top.buts 0 -weight 1 -uniform a
11412     grid columnconfigure $top.buts 1 -weight 1 -uniform a
11413     grid $top.buts - - -pady 10 -sticky ew
11414     grid columnconfigure $top 2 -weight 1
11415     bind $top <Visibility> [list focus $top.buts.ok]
11416 }
11417
11418 proc choose_extdiff {} {
11419     global extdifftool
11420
11421     set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11422     if {$prog ne {}} {
11423         set extdifftool $prog
11424     }
11425 }
11426
11427 proc choosecolor {v vi w x cmd} {
11428     global $v
11429
11430     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11431                -title [mc "Gitk: choose color for %s" $x]]
11432     if {$c eq {}} return
11433     $w conf -background $c
11434     lset $v $vi $c
11435     eval $cmd $c
11436 }
11437
11438 proc setselbg {c} {
11439     global bglist cflist
11440     foreach w $bglist {
11441         $w configure -selectbackground $c
11442     }
11443     $cflist tag configure highlight \
11444         -background [$cflist cget -selectbackground]
11445     allcanvs itemconf secsel -fill $c
11446 }
11447
11448 # This sets the background color and the color scheme for the whole UI.
11449 # For some reason, tk_setPalette chooses a nasty dark red for selectColor
11450 # if we don't specify one ourselves, which makes the checkbuttons and
11451 # radiobuttons look bad.  This chooses white for selectColor if the
11452 # background color is light, or black if it is dark.
11453 proc setui {c} {
11454     if {[tk windowingsystem] eq "win32"} { return }
11455     set bg [winfo rgb . $c]
11456     set selc black
11457     if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11458         set selc white
11459     }
11460     tk_setPalette background $c selectColor $selc
11461 }
11462
11463 proc setbg {c} {
11464     global bglist
11465
11466     foreach w $bglist {
11467         $w conf -background $c
11468     }
11469 }
11470
11471 proc setfg {c} {
11472     global fglist canv
11473
11474     foreach w $fglist {
11475         $w conf -foreground $c
11476     }
11477     allcanvs itemconf text -fill $c
11478     $canv itemconf circle -outline $c
11479     $canv itemconf markid -outline $c
11480 }
11481
11482 proc prefscan {} {
11483     global oldprefs prefstop
11484
11485     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11486                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11487         global $v
11488         set $v $oldprefs($v)
11489     }
11490     catch {destroy $prefstop}
11491     unset prefstop
11492     fontcan
11493 }
11494
11495 proc prefsok {} {
11496     global maxwidth maxgraphpct
11497     global oldprefs prefstop showneartags showlocalchanges
11498     global fontpref mainfont textfont uifont
11499     global limitdiffs treediffs perfile_attrs
11500     global hideremotes
11501
11502     catch {destroy $prefstop}
11503     unset prefstop
11504     fontcan
11505     set fontchanged 0
11506     if {$mainfont ne $fontpref(mainfont)} {
11507         set mainfont $fontpref(mainfont)
11508         parsefont mainfont $mainfont
11509         eval font configure mainfont [fontflags mainfont]
11510         eval font configure mainfontbold [fontflags mainfont 1]
11511         setcoords
11512         set fontchanged 1
11513     }
11514     if {$textfont ne $fontpref(textfont)} {
11515         set textfont $fontpref(textfont)
11516         parsefont textfont $textfont
11517         eval font configure textfont [fontflags textfont]
11518         eval font configure textfontbold [fontflags textfont 1]
11519     }
11520     if {$uifont ne $fontpref(uifont)} {
11521         set uifont $fontpref(uifont)
11522         parsefont uifont $uifont
11523         eval font configure uifont [fontflags uifont]
11524     }
11525     settabs
11526     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11527         if {$showlocalchanges} {
11528             doshowlocalchanges
11529         } else {
11530             dohidelocalchanges
11531         }
11532     }
11533     if {$limitdiffs != $oldprefs(limitdiffs) ||
11534         ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11535         # treediffs elements are limited by path;
11536         # won't have encodings cached if perfile_attrs was just turned on
11537         catch {unset treediffs}
11538     }
11539     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11540         || $maxgraphpct != $oldprefs(maxgraphpct)} {
11541         redisplay
11542     } elseif {$showneartags != $oldprefs(showneartags) ||
11543           $limitdiffs != $oldprefs(limitdiffs)} {
11544         reselectline
11545     }
11546     if {$hideremotes != $oldprefs(hideremotes)} {
11547         rereadrefs
11548     }
11549 }
11550
11551 proc formatdate {d} {
11552     global datetimeformat
11553     if {$d ne {}} {
11554         # If $datetimeformat includes a timezone, display in the
11555         # timezone of the argument.  Otherwise, display in local time.
11556         if {[string match {*%[zZ]*} $datetimeformat]} {
11557             if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11558                 # Tcl < 8.5 does not support -timezone.  Emulate it by
11559                 # setting TZ (e.g. TZ=<-0430>+04:30).
11560                 global env
11561                 if {[info exists env(TZ)]} {
11562                     set savedTZ $env(TZ)
11563                 }
11564                 set zone [lindex $d 1]
11565                 set sign [string map {+ - - +} [string index $zone 0]]
11566                 set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11567                 set d [clock format [lindex $d 0] -format $datetimeformat]
11568                 if {[info exists savedTZ]} {
11569                     set env(TZ) $savedTZ
11570                 } else {
11571                     unset env(TZ)
11572                 }
11573             }
11574         } else {
11575             set d [clock format [lindex $d 0] -format $datetimeformat]
11576         }
11577     }
11578     return $d
11579 }
11580
11581 # This list of encoding names and aliases is distilled from
11582 # http://www.iana.org/assignments/character-sets.
11583 # Not all of them are supported by Tcl.
11584 set encoding_aliases {
11585     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11586       ISO646-US US-ASCII us IBM367 cp367 csASCII }
11587     { ISO-10646-UTF-1 csISO10646UTF1 }
11588     { ISO_646.basic:1983 ref csISO646basic1983 }
11589     { INVARIANT csINVARIANT }
11590     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11591     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11592     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11593     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11594     { NATS-DANO iso-ir-9-1 csNATSDANO }
11595     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11596     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11597     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11598     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11599     { ISO-2022-KR csISO2022KR }
11600     { EUC-KR csEUCKR }
11601     { ISO-2022-JP csISO2022JP }
11602     { ISO-2022-JP-2 csISO2022JP2 }
11603     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11604       csISO13JISC6220jp }
11605     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11606     { IT iso-ir-15 ISO646-IT csISO15Italian }
11607     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11608     { ES iso-ir-17 ISO646-ES csISO17Spanish }
11609     { greek7-old iso-ir-18 csISO18Greek7Old }
11610     { latin-greek iso-ir-19 csISO19LatinGreek }
11611     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11612     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11613     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11614     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11615     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11616     { BS_viewdata iso-ir-47 csISO47BSViewdata }
11617     { INIS iso-ir-49 csISO49INIS }
11618     { INIS-8 iso-ir-50 csISO50INIS8 }
11619     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11620     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11621     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11622     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11623     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11624     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11625       csISO60Norwegian1 }
11626     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11627     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11628     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11629     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11630     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11631     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11632     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11633     { greek7 iso-ir-88 csISO88Greek7 }
11634     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11635     { iso-ir-90 csISO90 }
11636     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11637     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11638       csISO92JISC62991984b }
11639     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11640     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11641     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11642       csISO95JIS62291984handadd }
11643     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11644     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11645     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11646     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11647       CP819 csISOLatin1 }
11648     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11649     { T.61-7bit iso-ir-102 csISO102T617bit }
11650     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11651     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11652     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11653     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11654     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11655     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11656     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11657     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11658       arabic csISOLatinArabic }
11659     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11660     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11661     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11662       greek greek8 csISOLatinGreek }
11663     { T.101-G2 iso-ir-128 csISO128T101G2 }
11664     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11665       csISOLatinHebrew }
11666     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11667     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11668     { CSN_369103 iso-ir-139 csISO139CSN369103 }
11669     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11670     { ISO_6937-2-add iso-ir-142 csISOTextComm }
11671     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11672     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11673       csISOLatinCyrillic }
11674     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11675     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11676     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11677     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11678     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11679     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11680     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11681     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11682     { ISO_10367-box iso-ir-155 csISO10367Box }
11683     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11684     { latin-lap lap iso-ir-158 csISO158Lap }
11685     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11686     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11687     { us-dk csUSDK }
11688     { dk-us csDKUS }
11689     { JIS_X0201 X0201 csHalfWidthKatakana }
11690     { KSC5636 ISO646-KR csKSC5636 }
11691     { ISO-10646-UCS-2 csUnicode }
11692     { ISO-10646-UCS-4 csUCS4 }
11693     { DEC-MCS dec csDECMCS }
11694     { hp-roman8 roman8 r8 csHPRoman8 }
11695     { macintosh mac csMacintosh }
11696     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11697       csIBM037 }
11698     { IBM038 EBCDIC-INT cp038 csIBM038 }
11699     { IBM273 CP273 csIBM273 }
11700     { IBM274 EBCDIC-BE CP274 csIBM274 }
11701     { IBM275 EBCDIC-BR cp275 csIBM275 }
11702     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11703     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11704     { IBM280 CP280 ebcdic-cp-it csIBM280 }
11705     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11706     { IBM284 CP284 ebcdic-cp-es csIBM284 }
11707     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11708     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11709     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11710     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11711     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11712     { IBM424 cp424 ebcdic-cp-he csIBM424 }
11713     { IBM437 cp437 437 csPC8CodePage437 }
11714     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11715     { IBM775 cp775 csPC775Baltic }
11716     { IBM850 cp850 850 csPC850Multilingual }
11717     { IBM851 cp851 851 csIBM851 }
11718     { IBM852 cp852 852 csPCp852 }
11719     { IBM855 cp855 855 csIBM855 }
11720     { IBM857 cp857 857 csIBM857 }
11721     { IBM860 cp860 860 csIBM860 }
11722     { IBM861 cp861 861 cp-is csIBM861 }
11723     { IBM862 cp862 862 csPC862LatinHebrew }
11724     { IBM863 cp863 863 csIBM863 }
11725     { IBM864 cp864 csIBM864 }
11726     { IBM865 cp865 865 csIBM865 }
11727     { IBM866 cp866 866 csIBM866 }
11728     { IBM868 CP868 cp-ar csIBM868 }
11729     { IBM869 cp869 869 cp-gr csIBM869 }
11730     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11731     { IBM871 CP871 ebcdic-cp-is csIBM871 }
11732     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11733     { IBM891 cp891 csIBM891 }
11734     { IBM903 cp903 csIBM903 }
11735     { IBM904 cp904 904 csIBBM904 }
11736     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11737     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11738     { IBM1026 CP1026 csIBM1026 }
11739     { EBCDIC-AT-DE csIBMEBCDICATDE }
11740     { EBCDIC-AT-DE-A csEBCDICATDEA }
11741     { EBCDIC-CA-FR csEBCDICCAFR }
11742     { EBCDIC-DK-NO csEBCDICDKNO }
11743     { EBCDIC-DK-NO-A csEBCDICDKNOA }
11744     { EBCDIC-FI-SE csEBCDICFISE }
11745     { EBCDIC-FI-SE-A csEBCDICFISEA }
11746     { EBCDIC-FR csEBCDICFR }
11747     { EBCDIC-IT csEBCDICIT }
11748     { EBCDIC-PT csEBCDICPT }
11749     { EBCDIC-ES csEBCDICES }
11750     { EBCDIC-ES-A csEBCDICESA }
11751     { EBCDIC-ES-S csEBCDICESS }
11752     { EBCDIC-UK csEBCDICUK }
11753     { EBCDIC-US csEBCDICUS }
11754     { UNKNOWN-8BIT csUnknown8BiT }
11755     { MNEMONIC csMnemonic }
11756     { MNEM csMnem }
11757     { VISCII csVISCII }
11758     { VIQR csVIQR }
11759     { KOI8-R csKOI8R }
11760     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11761     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11762     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11763     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11764     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11765     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11766     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11767     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11768     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11769     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11770     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11771     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11772     { IBM1047 IBM-1047 }
11773     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11774     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11775     { UNICODE-1-1 csUnicode11 }
11776     { CESU-8 csCESU-8 }
11777     { BOCU-1 csBOCU-1 }
11778     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11779     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11780       l8 }
11781     { ISO-8859-15 ISO_8859-15 Latin-9 }
11782     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11783     { GBK CP936 MS936 windows-936 }
11784     { JIS_Encoding csJISEncoding }
11785     { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11786     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11787       EUC-JP }
11788     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11789     { ISO-10646-UCS-Basic csUnicodeASCII }
11790     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11791     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11792     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11793     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11794     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11795     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11796     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11797     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11798     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11799     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11800     { Adobe-Standard-Encoding csAdobeStandardEncoding }
11801     { Ventura-US csVenturaUS }
11802     { Ventura-International csVenturaInternational }
11803     { PC8-Danish-Norwegian csPC8DanishNorwegian }
11804     { PC8-Turkish csPC8Turkish }
11805     { IBM-Symbols csIBMSymbols }
11806     { IBM-Thai csIBMThai }
11807     { HP-Legal csHPLegal }
11808     { HP-Pi-font csHPPiFont }
11809     { HP-Math8 csHPMath8 }
11810     { Adobe-Symbol-Encoding csHPPSMath }
11811     { HP-DeskTop csHPDesktop }
11812     { Ventura-Math csVenturaMath }
11813     { Microsoft-Publishing csMicrosoftPublishing }
11814     { Windows-31J csWindows31J }
11815     { GB2312 csGB2312 }
11816     { Big5 csBig5 }
11817 }
11818
11819 proc tcl_encoding {enc} {
11820     global encoding_aliases tcl_encoding_cache
11821     if {[info exists tcl_encoding_cache($enc)]} {
11822         return $tcl_encoding_cache($enc)
11823     }
11824     set names [encoding names]
11825     set lcnames [string tolower $names]
11826     set enc [string tolower $enc]
11827     set i [lsearch -exact $lcnames $enc]
11828     if {$i < 0} {
11829         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11830         if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11831             set i [lsearch -exact $lcnames $encx]
11832         }
11833     }
11834     if {$i < 0} {
11835         foreach l $encoding_aliases {
11836             set ll [string tolower $l]
11837             if {[lsearch -exact $ll $enc] < 0} continue
11838             # look through the aliases for one that tcl knows about
11839             foreach e $ll {
11840                 set i [lsearch -exact $lcnames $e]
11841                 if {$i < 0} {
11842                     if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11843                         set i [lsearch -exact $lcnames $ex]
11844                     }
11845                 }
11846                 if {$i >= 0} break
11847             }
11848             break
11849         }
11850     }
11851     set tclenc {}
11852     if {$i >= 0} {
11853         set tclenc [lindex $names $i]
11854     }
11855     set tcl_encoding_cache($enc) $tclenc
11856     return $tclenc
11857 }
11858
11859 proc gitattr {path attr default} {
11860     global path_attr_cache
11861     if {[info exists path_attr_cache($attr,$path)]} {
11862         set r $path_attr_cache($attr,$path)
11863     } else {
11864         set r "unspecified"
11865         if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11866             regexp "(.*): $attr: (.*)" $line m f r
11867         }
11868         set path_attr_cache($attr,$path) $r
11869     }
11870     if {$r eq "unspecified"} {
11871         return $default
11872     }
11873     return $r
11874 }
11875
11876 proc cache_gitattr {attr pathlist} {
11877     global path_attr_cache
11878     set newlist {}
11879     foreach path $pathlist {
11880         if {![info exists path_attr_cache($attr,$path)]} {
11881             lappend newlist $path
11882         }
11883     }
11884     set lim 1000
11885     if {[tk windowingsystem] == "win32"} {
11886         # windows has a 32k limit on the arguments to a command...
11887         set lim 30
11888     }
11889     while {$newlist ne {}} {
11890         set head [lrange $newlist 0 [expr {$lim - 1}]]
11891         set newlist [lrange $newlist $lim end]
11892         if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11893             foreach row [split $rlist "\n"] {
11894                 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11895                     if {[string index $path 0] eq "\""} {
11896                         set path [encoding convertfrom [lindex $path 0]]
11897                     }
11898                     set path_attr_cache($attr,$path) $value
11899                 }
11900             }
11901         }
11902     }
11903 }
11904
11905 proc get_path_encoding {path} {
11906     global gui_encoding perfile_attrs
11907     set tcl_enc $gui_encoding
11908     if {$path ne {} && $perfile_attrs} {
11909         set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11910         if {$enc2 ne {}} {
11911             set tcl_enc $enc2
11912         }
11913     }
11914     return $tcl_enc
11915 }
11916
11917 # First check that Tcl/Tk is recent enough
11918 if {[catch {package require Tk 8.4} err]} {
11919     show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11920                      Gitk requires at least Tcl/Tk 8.4." list
11921     exit 1
11922 }
11923
11924 # on OSX bring the current Wish process window to front
11925 if {[tk windowingsystem] eq "aqua"} {
11926     exec osascript -e [format {
11927         tell application "System Events"
11928             set frontmost of processes whose unix id is %d to true
11929         end tell
11930     } [pid] ]
11931 }
11932
11933 # Unset GIT_TRACE var if set
11934 if { [info exists ::env(GIT_TRACE)] } {
11935     unset ::env(GIT_TRACE)
11936 }
11937
11938 # defaults...
11939 set wrcomcmd "git diff-tree --stdin -p --pretty"
11940
11941 set gitencoding {}
11942 catch {
11943     set gitencoding [exec git config --get i18n.commitencoding]
11944 }
11945 catch {
11946     set gitencoding [exec git config --get i18n.logoutputencoding]
11947 }
11948 if {$gitencoding == ""} {
11949     set gitencoding "utf-8"
11950 }
11951 set tclencoding [tcl_encoding $gitencoding]
11952 if {$tclencoding == {}} {
11953     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11954 }
11955
11956 set gui_encoding [encoding system]
11957 catch {
11958     set enc [exec git config --get gui.encoding]
11959     if {$enc ne {}} {
11960         set tclenc [tcl_encoding $enc]
11961         if {$tclenc ne {}} {
11962             set gui_encoding $tclenc
11963         } else {
11964             puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11965         }
11966     }
11967 }
11968
11969 set log_showroot true
11970 catch {
11971     set log_showroot [exec git config --bool --get log.showroot]
11972 }
11973
11974 if {[tk windowingsystem] eq "aqua"} {
11975     set mainfont {{Lucida Grande} 9}
11976     set textfont {Monaco 9}
11977     set uifont {{Lucida Grande} 9 bold}
11978 } elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
11979     # fontconfig!
11980     set mainfont {sans 9}
11981     set textfont {monospace 9}
11982     set uifont {sans 9 bold}
11983 } else {
11984     set mainfont {Helvetica 9}
11985     set textfont {Courier 9}
11986     set uifont {Helvetica 9 bold}
11987 }
11988 set tabstop 8
11989 set findmergefiles 0
11990 set maxgraphpct 50
11991 set maxwidth 16
11992 set revlistorder 0
11993 set fastdate 0
11994 set uparrowlen 5
11995 set downarrowlen 5
11996 set mingaplen 100
11997 set cmitmode "patch"
11998 set wrapcomment "none"
11999 set showneartags 1
12000 set hideremotes 0
12001 set maxrefs 20
12002 set visiblerefs {"master"}
12003 set maxlinelen 200
12004 set showlocalchanges 1
12005 set limitdiffs 1
12006 set datetimeformat "%Y-%m-%d %H:%M:%S"
12007 set autoselect 1
12008 set autosellen 40
12009 set perfile_attrs 0
12010 set want_ttk 1
12011
12012 if {[tk windowingsystem] eq "aqua"} {
12013     set extdifftool "opendiff"
12014 } else {
12015     set extdifftool "meld"
12016 }
12017
12018 set colors {green red blue magenta darkgrey brown orange}
12019 if {[tk windowingsystem] eq "win32"} {
12020     set uicolor SystemButtonFace
12021     set uifgcolor SystemButtonText
12022     set uifgdisabledcolor SystemDisabledText
12023     set bgcolor SystemWindow
12024     set fgcolor SystemWindowText
12025     set selectbgcolor SystemHighlight
12026 } else {
12027     set uicolor grey85
12028     set uifgcolor black
12029     set uifgdisabledcolor "#999"
12030     set bgcolor white
12031     set fgcolor black
12032     set selectbgcolor gray85
12033 }
12034 set diffcolors {red "#00a000" blue}
12035 set diffcontext 3
12036 set mergecolors {red blue green purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12037 set ignorespace 0
12038 set worddiff ""
12039 set markbgcolor "#e0e0ff"
12040
12041 set headbgcolor green
12042 set headfgcolor black
12043 set headoutlinecolor black
12044 set remotebgcolor #ffddaa
12045 set tagbgcolor yellow
12046 set tagfgcolor black
12047 set tagoutlinecolor black
12048 set reflinecolor black
12049 set filesepbgcolor #aaaaaa
12050 set filesepfgcolor black
12051 set linehoverbgcolor #ffff80
12052 set linehoverfgcolor black
12053 set linehoveroutlinecolor black
12054 set mainheadcirclecolor yellow
12055 set workingfilescirclecolor red
12056 set indexcirclecolor green
12057 set circlecolors {white blue gray blue blue}
12058 set linkfgcolor blue
12059 set circleoutlinecolor $fgcolor
12060 set foundbgcolor yellow
12061 set currentsearchhitbgcolor orange
12062
12063 # button for popping up context menus
12064 if {[tk windowingsystem] eq "aqua"} {
12065     set ctxbut <Button-2>
12066 } else {
12067     set ctxbut <Button-3>
12068 }
12069
12070 ## For msgcat loading, first locate the installation location.
12071 if { [info exists ::env(GITK_MSGSDIR)] } {
12072     ## Msgsdir was manually set in the environment.
12073     set gitk_msgsdir $::env(GITK_MSGSDIR)
12074 } else {
12075     ## Let's guess the prefix from argv0.
12076     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12077     set gitk_libdir [file join $gitk_prefix share gitk lib]
12078     set gitk_msgsdir [file join $gitk_libdir msgs]
12079     unset gitk_prefix
12080 }
12081
12082 ## Internationalization (i18n) through msgcat and gettext. See
12083 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12084 package require msgcat
12085 namespace import ::msgcat::mc
12086 ## And eventually load the actual message catalog
12087 ::msgcat::mcload $gitk_msgsdir
12088
12089 catch {
12090     # follow the XDG base directory specification by default. See
12091     # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
12092     if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
12093         # XDG_CONFIG_HOME environment variable is set
12094         set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12095         set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
12096     } else {
12097         # default XDG_CONFIG_HOME
12098         set config_file "~/.config/git/gitk"
12099         set config_file_tmp "~/.config/git/gitk-tmp"
12100     }
12101     if {![file exists $config_file]} {
12102         # for backward compatibility use the old config file if it exists
12103         if {[file exists "~/.gitk"]} {
12104             set config_file "~/.gitk"
12105             set config_file_tmp "~/.gitk-tmp"
12106         } elseif {![file exists [file dirname $config_file]]} {
12107             file mkdir [file dirname $config_file]
12108         }
12109     }
12110     source $config_file
12111 }
12112
12113 set config_variables {
12114     mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
12115     cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
12116     hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
12117     bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
12118     markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
12119     extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
12120     remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
12121     filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
12122     linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
12123     indexcirclecolor circlecolors linkfgcolor circleoutlinecolor
12124 }
12125
12126 parsefont mainfont $mainfont
12127 eval font create mainfont [fontflags mainfont]
12128 eval font create mainfontbold [fontflags mainfont 1]
12129
12130 parsefont textfont $textfont
12131 eval font create textfont [fontflags textfont]
12132 eval font create textfontbold [fontflags textfont 1]
12133
12134 parsefont uifont $uifont
12135 eval font create uifont [fontflags uifont]
12136
12137 setui $uicolor
12138
12139 setoptions
12140
12141 # check that we can find a .git directory somewhere...
12142 if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12143     show_error {} . [mc "Cannot find a git repository here."]
12144     exit 1
12145 }
12146
12147 set selecthead {}
12148 set selectheadid {}
12149
12150 set revtreeargs {}
12151 set cmdline_files {}
12152 set i 0
12153 set revtreeargscmd {}
12154 foreach arg $argv {
12155     switch -glob -- $arg {
12156         "" { }
12157         "--" {
12158             set cmdline_files [lrange $argv [expr {$i + 1}] end]
12159             break
12160         }
12161         "--select-commit=*" {
12162             set selecthead [string range $arg 16 end]
12163         }
12164         "--argscmd=*" {
12165             set revtreeargscmd [string range $arg 10 end]
12166         }
12167         default {
12168             lappend revtreeargs $arg
12169         }
12170     }
12171     incr i
12172 }
12173
12174 if {$selecthead eq "HEAD"} {
12175     set selecthead {}
12176 }
12177
12178 if {$i >= [llength $argv] && $revtreeargs ne {}} {
12179     # no -- on command line, but some arguments (other than --argscmd)
12180     if {[catch {
12181         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12182         set cmdline_files [split $f "\n"]
12183         set n [llength $cmdline_files]
12184         set revtreeargs [lrange $revtreeargs 0 end-$n]
12185         # Unfortunately git rev-parse doesn't produce an error when
12186         # something is both a revision and a filename.  To be consistent
12187         # with git log and git rev-list, check revtreeargs for filenames.
12188         foreach arg $revtreeargs {
12189             if {[file exists $arg]} {
12190                 show_error {} . [mc "Ambiguous argument '%s': both revision\
12191                                  and filename" $arg]
12192                 exit 1
12193             }
12194         }
12195     } err]} {
12196         # unfortunately we get both stdout and stderr in $err,
12197         # so look for "fatal:".
12198         set i [string first "fatal:" $err]
12199         if {$i > 0} {
12200             set err [string range $err [expr {$i + 6}] end]
12201         }
12202         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12203         exit 1
12204     }
12205 }
12206
12207 set nullid "0000000000000000000000000000000000000000"
12208 set nullid2 "0000000000000000000000000000000000000001"
12209 set nullfile "/dev/null"
12210
12211 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12212 if {![info exists have_ttk]} {
12213     set have_ttk [llength [info commands ::ttk::style]]
12214 }
12215 set use_ttk [expr {$have_ttk && $want_ttk}]
12216 set NS [expr {$use_ttk ? "ttk" : ""}]
12217
12218 regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12219
12220 set show_notes {}
12221 if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12222     set show_notes "--show-notes"
12223 }
12224
12225 set appname "gitk"
12226
12227 set runq {}
12228 set history {}
12229 set historyindex 0
12230 set fh_serial 0
12231 set nhl_names {}
12232 set highlight_paths {}
12233 set findpattern {}
12234 set searchdirn -forwards
12235 set boldids {}
12236 set boldnameids {}
12237 set diffelide {0 0}
12238 set markingmatches 0
12239 set linkentercount 0
12240 set need_redisplay 0
12241 set nrows_drawn 0
12242 set firsttabstop 0
12243
12244 set nextviewnum 1
12245 set curview 0
12246 set selectedview 0
12247 set selectedhlview [mc "None"]
12248 set highlight_related [mc "None"]
12249 set highlight_files {}
12250 set viewfiles(0) {}
12251 set viewperm(0) 0
12252 set viewargs(0) {}
12253 set viewargscmd(0) {}
12254
12255 set selectedline {}
12256 set numcommits 0
12257 set loginstance 0
12258 set cmdlineok 0
12259 set stopped 0
12260 set stuffsaved 0
12261 set patchnum 0
12262 set lserial 0
12263 set hasworktree [hasworktree]
12264 set cdup {}
12265 if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12266     set cdup [exec git rev-parse --show-cdup]
12267 }
12268 set worktree [exec git rev-parse --show-toplevel]
12269 setcoords
12270 makewindow
12271 catch {
12272     image create photo gitlogo      -width 16 -height 16
12273
12274     image create photo gitlogominus -width  4 -height  2
12275     gitlogominus put #C00000 -to 0 0 4 2
12276     gitlogo copy gitlogominus -to  1 5
12277     gitlogo copy gitlogominus -to  6 5
12278     gitlogo copy gitlogominus -to 11 5
12279     image delete gitlogominus
12280
12281     image create photo gitlogoplus  -width  4 -height  4
12282     gitlogoplus  put #008000 -to 1 0 3 4
12283     gitlogoplus  put #008000 -to 0 1 4 3
12284     gitlogo copy gitlogoplus  -to  1 9
12285     gitlogo copy gitlogoplus  -to  6 9
12286     gitlogo copy gitlogoplus  -to 11 9
12287     image delete gitlogoplus
12288
12289     image create photo gitlogo32    -width 32 -height 32
12290     gitlogo32 copy gitlogo -zoom 2 2
12291
12292     wm iconphoto . -default gitlogo gitlogo32
12293 }
12294 # wait for the window to become visible
12295 tkwait visibility .
12296 wm title . "$appname: [reponame]"
12297 update
12298 readrefs
12299
12300 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12301     # create a view for the files/dirs specified on the command line
12302     set curview 1
12303     set selectedview 1
12304     set nextviewnum 2
12305     set viewname(1) [mc "Command line"]
12306     set viewfiles(1) $cmdline_files
12307     set viewargs(1) $revtreeargs
12308     set viewargscmd(1) $revtreeargscmd
12309     set viewperm(1) 0
12310     set vdatemode(1) 0
12311     addviewmenu 1
12312     .bar.view entryconf [mca "Edit view..."] -state normal
12313     .bar.view entryconf [mca "Delete view"] -state normal
12314 }
12315
12316 if {[info exists permviews]} {
12317     foreach v $permviews {
12318         set n $nextviewnum
12319         incr nextviewnum
12320         set viewname($n) [lindex $v 0]
12321         set viewfiles($n) [lindex $v 1]
12322         set viewargs($n) [lindex $v 2]
12323         set viewargscmd($n) [lindex $v 3]
12324         set viewperm($n) 1
12325         addviewmenu $n
12326     }
12327 }
12328
12329 if {[tk windowingsystem] eq "win32"} {
12330     focus -force .
12331 }
12332
12333 getcommits {}
12334
12335 # Local variables:
12336 # mode: tcl
12337 # indent-tabs-mode: t
12338 # tab-width: 8
12339 # End: