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