git.oblomov.eu Git - git/blob - gitk-git/gitk

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 # Copyright © 2005-2016 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             if {[catch {set _gitworktree [exec git config --get core.worktree]}]} {
  38                 set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]]
  39             }
  40         }
  41     }
  42     return $_gitworktree
  43 }
  44
  45 # A simple scheduler for compute-intensive stuff.
  46 # The aim is to make sure that event handlers for GUI actions can
  47 # run at least every 50-100 ms.  Unfortunately fileevent handlers are
  48 # run before X event handlers, so reading from a fast source can
  49 # make the GUI completely unresponsive.
  50 proc run args {
  51     global isonrunq runq currunq
  52
  53     set script $args
  54     if {[info exists isonrunq($script)]} return
  55     if {$runq eq {} && ![info exists currunq]} {
  56         after idle dorunq
  57     }
  58     lappend runq [list {} $script]
  59     set isonrunq($script) 1
  60 }
  61
  62 proc filerun {fd script} {
  63     fileevent $fd readable [list filereadable $fd $script]
  64 }
  65
  66 proc filereadable {fd script} {
  67     global runq currunq
  68
  69     fileevent $fd readable {}
  70     if {$runq eq {} && ![info exists currunq]} {
  71         after idle dorunq
  72     }
  73     lappend runq [list $fd $script]
  74 }
  75
  76 proc nukefile {fd} {
  77     global runq
  78
  79     for {set i 0} {$i < [llength $runq]} {} {
  80         if {[lindex $runq $i 0] eq $fd} {
  81             set runq [lreplace $runq $i $i]
  82         } else {
  83             incr i
  84         }
  85     }
  86 }
  87
  88 proc dorunq {} {
  89     global isonrunq runq currunq
  90
  91     set tstart [clock clicks -milliseconds]
  92     set t0 $tstart
  93     while {[llength $runq] > 0} {
  94         set fd [lindex $runq 0 0]
  95         set script [lindex $runq 0 1]
  96         set currunq [lindex $runq 0]
  97         set runq [lrange $runq 1 end]
  98         set repeat [eval $script]
  99         unset currunq
 100         set t1 [clock clicks -milliseconds]
 101         set t [expr {$t1 - $t0}]
 102         if {$repeat ne {} && $repeat} {
 103             if {$fd eq {} || $repeat == 2} {
 104                 # script returns 1 if it wants to be readded
 105                 # file readers return 2 if they could do more straight away
 106                 lappend runq [list $fd $script]
 107             } else {
 108                 fileevent $fd readable [list filereadable $fd $script]
 109             }
 110         } elseif {$fd eq {}} {
 111             unset isonrunq($script)
 112         }
 113         set t0 $t1
 114         if {$t1 - $tstart >= 80} break
 115     }
 116     if {$runq ne {}} {
 117         after idle dorunq
 118     }
 119 }
 120
 121 proc reg_instance {fd} {
 122     global commfd leftover loginstance
 123
 124     set i [incr loginstance]
 125     set commfd($i) $fd
 126     set leftover($i) {}
 127     return $i
 128 }
 129
 130 proc unmerged_files {files} {
 131     global nr_unmerged
 132
 133     # find the list of unmerged files
 134     set mlist {}
 135     set nr_unmerged 0
 136     if {[catch {
 137         set fd [open "| git ls-files -u" r]
 138     } err]} {
 139         show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
 140         exit 1
 141     }
 142     while {[gets $fd line] >= 0} {
 143         set i [string first "\t" $line]
 144         if {$i < 0} continue
 145         set fname [string range $line [expr {$i+1}] end]
 146         if {[lsearch -exact $mlist $fname] >= 0} continue
 147         incr nr_unmerged
 148         if {$files eq {} || [path_filter $files $fname]} {
 149             lappend mlist $fname
 150         }
 151     }
 152     catch {close $fd}
 153     return $mlist
 154 }
 155
 156 proc parseviewargs {n arglist} {
 157     global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
 158     global vinlinediff
 159     global worddiff git_version
 160
 161     set vdatemode($n) 0
 162     set vmergeonly($n) 0
 163     set vinlinediff($n) 0
 164     set glflags {}
 165     set diffargs {}
 166     set nextisval 0
 167     set revargs {}
 168     set origargs $arglist
 169     set allknown 1
 170     set filtered 0
 171     set i -1
 172     foreach arg $arglist {
 173         incr i
 174         if {$nextisval} {
 175             lappend glflags $arg
 176             set nextisval 0
 177             continue
 178         }
 179         switch -glob -- $arg {
 180             "-d" -
 181             "--date-order" {
 182                 set vdatemode($n) 1
 183                 # remove from origargs in case we hit an unknown option
 184                 set origargs [lreplace $origargs $i $i]
 185                 incr i -1
 186             }
 187             "-[puabwcrRBMC]" -
 188             "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
 189             "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
 190             "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
 191             "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
 192             "--ignore-space-change" - "-U*" - "--unified=*" {
 193                 # These request or affect diff output, which we don't want.
 194                 # Some could be used to set our defaults for diff display.
 195                 lappend diffargs $arg
 196             }
 197             "--raw" - "--patch-with-raw" - "--patch-with-stat" -
 198             "--name-only" - "--name-status" - "--color" -
 199             "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
 200             "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
 201             "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
 202             "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
 203             "--objects" - "--objects-edge" - "--reverse" {
 204                 # These cause our parsing of git log's output to fail, or else
 205                 # they're options we want to set ourselves, so ignore them.
 206             }
 207             "--color-words*" - "--word-diff=color" {
 208                 # These trigger a word diff in the console interface,
 209                 # so help the user by enabling our own support
 210                 if {[package vcompare $git_version "1.7.2"] >= 0} {
 211                     set worddiff [mc "Color words"]
 212                 }
 213             }
 214             "--word-diff*" {
 215                 if {[package vcompare $git_version "1.7.2"] >= 0} {
 216                     set worddiff [mc "Markup words"]
 217                 }
 218             }
 219             "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
 220             "--check" - "--exit-code" - "--quiet" - "--topo-order" -
 221             "--full-history" - "--dense" - "--sparse" -
 222             "--follow" - "--left-right" - "--encoding=*" {
 223                 # These are harmless, and some are even useful
 224                 lappend glflags $arg
 225             }
 226             "--diff-filter=*" - "--no-merges" - "--unpacked" -
 227             "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
 228             "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
 229             "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
 230             "--remove-empty" - "--first-parent" - "--cherry-pick" -
 231             "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
 232             "--simplify-by-decoration" {
 233                 # These mean that we get a subset of the commits
 234                 set filtered 1
 235                 lappend glflags $arg
 236             }
 237             "-L*" {
 238                 # Line-log with 'stuck' argument (unstuck form is
 239                 # not supported)
 240                 set filtered 1
 241                 set vinlinediff($n) 1
 242                 set allknown 0
 243                 lappend glflags $arg
 244             }
 245             "-n" {
 246                 # This appears to be the only one that has a value as a
 247                 # separate word following it
 248                 set filtered 1
 249                 set nextisval 1
 250                 lappend glflags $arg
 251             }
 252             "--not" - "--all" {
 253                 lappend revargs $arg
 254             }
 255             "--merge" {
 256                 set vmergeonly($n) 1
 257                 # git rev-parse doesn't understand --merge
 258                 lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
 259             }
 260             "--no-replace-objects" {
 261                 set env(GIT_NO_REPLACE_OBJECTS) "1"
 262             }
 263             "-*" {
 264                 # Other flag arguments including -<n>
 265                 if {[string is digit -strict [string range $arg 1 end]]} {
 266                     set filtered 1
 267                 } else {
 268                     # a flag argument that we don't recognize;
 269                     # that means we can't optimize
 270                     set allknown 0
 271                 }
 272                 lappend glflags $arg
 273             }
 274             default {
 275                 # Non-flag arguments specify commits or ranges of commits
 276                 if {[string match "*...*" $arg]} {
 277                     lappend revargs --gitk-symmetric-diff-marker
 278                 }
 279                 lappend revargs $arg
 280             }
 281         }
 282     }
 283     set vdflags($n) $diffargs
 284     set vflags($n) $glflags
 285     set vrevs($n) $revargs
 286     set vfiltered($n) $filtered
 287     set vorigargs($n) $origargs
 288     return $allknown
 289 }
 290
 291 proc parseviewrevs {view revs} {
 292     global vposids vnegids
 293
 294     if {$revs eq {}} {
 295         set revs HEAD
 296     } elseif {[lsearch -exact $revs --all] >= 0} {
 297         lappend revs HEAD
 298     }
 299     if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
 300         # we get stdout followed by stderr in $err
 301         # for an unknown rev, git rev-parse echoes it and then errors out
 302         set errlines [split $err "\n"]
 303         set badrev {}
 304         for {set l 0} {$l < [llength $errlines]} {incr l} {
 305             set line [lindex $errlines $l]
 306             if {!([string length $line] == 40 && [string is xdigit $line])} {
 307                 if {[string match "fatal:*" $line]} {
 308                     if {[string match "fatal: ambiguous argument*" $line]
 309                         && $badrev ne {}} {
 310                         if {[llength $badrev] == 1} {
 311                             set err "unknown revision $badrev"
 312                         } else {
 313                             set err "unknown revisions: [join $badrev ", "]"
 314                         }
 315                     } else {
 316                         set err [join [lrange $errlines $l end] "\n"]
 317                     }
 318                     break
 319                 }
 320                 lappend badrev $line
 321             }
 322         }
 323         error_popup "[mc "Error parsing revisions:"] $err"
 324         return {}
 325     }
 326     set ret {}
 327     set pos {}
 328     set neg {}
 329     set sdm 0
 330     foreach id [split $ids "\n"] {
 331         if {$id eq "--gitk-symmetric-diff-marker"} {
 332             set sdm 4
 333         } elseif {[string match "^*" $id]} {
 334             if {$sdm != 1} {
 335                 lappend ret $id
 336                 if {$sdm == 3} {
 337                     set sdm 0
 338                 }
 339             }
 340             lappend neg [string range $id 1 end]
 341         } else {
 342             if {$sdm != 2} {
 343                 lappend ret $id
 344             } else {
 345                 lset ret end $id...[lindex $ret end]
 346             }
 347             lappend pos $id
 348         }
 349         incr sdm -1
 350     }
 351     set vposids($view) $pos
 352     set vnegids($view) $neg
 353     return $ret
 354 }
 355
 356 # Start off a git log process and arrange to read its output
 357 proc start_rev_list {view} {
 358     global startmsecs commitidx viewcomplete curview
 359     global tclencoding
 360     global viewargs viewargscmd viewfiles vfilelimit
 361     global showlocalchanges
 362     global viewactive viewinstances vmergeonly
 363     global mainheadid viewmainheadid viewmainheadid_orig
 364     global vcanopt vflags vrevs vorigargs
 365     global show_notes
 366
 367     set startmsecs [clock clicks -milliseconds]
 368     set commitidx($view) 0
 369     # these are set this way for the error exits
 370     set viewcomplete($view) 1
 371     set viewactive($view) 0
 372     varcinit $view
 373
 374     set args $viewargs($view)
 375     if {$viewargscmd($view) ne {}} {
 376         if {[catch {
 377             set str [exec sh -c $viewargscmd($view)]
 378         } err]} {
 379             error_popup "[mc "Error executing --argscmd command:"] $err"
 380             return 0
 381         }
 382         set args [concat $args [split $str "\n"]]
 383     }
 384     set vcanopt($view) [parseviewargs $view $args]
 385
 386     set files $viewfiles($view)
 387     if {$vmergeonly($view)} {
 388         set files [unmerged_files $files]
 389         if {$files eq {}} {
 390             global nr_unmerged
 391             if {$nr_unmerged == 0} {
 392                 error_popup [mc "No files selected: --merge specified but\
 393                              no files are unmerged."]
 394             } else {
 395                 error_popup [mc "No files selected: --merge specified but\
 396                              no unmerged files are within file limit."]
 397             }
 398             return 0
 399         }
 400     }
 401     set vfilelimit($view) $files
 402
 403     if {$vcanopt($view)} {
 404         set revs [parseviewrevs $view $vrevs($view)]
 405         if {$revs eq {}} {
 406             return 0
 407         }
 408         set args [concat $vflags($view) $revs]
 409     } else {
 410         set args $vorigargs($view)
 411     }
 412
 413     if {[catch {
 414         set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 415                         --parents --boundary $args "--" $files] r]
 416     } err]} {
 417         error_popup "[mc "Error executing git log:"] $err"
 418         return 0
 419     }
 420     set i [reg_instance $fd]
 421     set viewinstances($view) [list $i]
 422     set viewmainheadid($view) $mainheadid
 423     set viewmainheadid_orig($view) $mainheadid
 424     if {$files ne {} && $mainheadid ne {}} {
 425         get_viewmainhead $view
 426     }
 427     if {$showlocalchanges && $viewmainheadid($view) ne {}} {
 428         interestedin $viewmainheadid($view) dodiffindex
 429     }
 430     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 431     if {$tclencoding != {}} {
 432         fconfigure $fd -encoding $tclencoding
 433     }
 434     filerun $fd [list getcommitlines $fd $i $view 0]
 435     nowbusy $view [mc "Reading"]
 436     set viewcomplete($view) 0
 437     set viewactive($view) 1
 438     return 1
 439 }
 440
 441 proc stop_instance {inst} {
 442     global commfd leftover
 443
 444     set fd $commfd($inst)
 445     catch {
 446         set pid [pid $fd]
 447
 448         if {$::tcl_platform(platform) eq {windows}} {
 449             exec taskkill /pid $pid
 450         } else {
 451             exec kill $pid
 452         }
 453     }
 454     catch {close $fd}
 455     nukefile $fd
 456     unset commfd($inst)
 457     unset leftover($inst)
 458 }
 459
 460 proc stop_backends {} {
 461     global commfd
 462
 463     foreach inst [array names commfd] {
 464         stop_instance $inst
 465     }
 466 }
 467
 468 proc stop_rev_list {view} {
 469     global viewinstances
 470
 471     foreach inst $viewinstances($view) {
 472         stop_instance $inst
 473     }
 474     set viewinstances($view) {}
 475 }
 476
 477 proc reset_pending_select {selid} {
 478     global pending_select mainheadid selectheadid
 479
 480     if {$selid ne {}} {
 481         set pending_select $selid
 482     } elseif {$selectheadid ne {}} {
 483         set pending_select $selectheadid
 484     } else {
 485         set pending_select $mainheadid
 486     }
 487 }
 488
 489 proc getcommits {selid} {
 490     global canv curview need_redisplay viewactive
 491
 492     initlayout
 493     if {[start_rev_list $curview]} {
 494         reset_pending_select $selid
 495         show_status [mc "Reading commits..."]
 496         set need_redisplay 1
 497     } else {
 498         show_status [mc "No commits selected"]
 499     }
 500 }
 501
 502 proc updatecommits {} {
 503     global curview vcanopt vorigargs vfilelimit viewinstances
 504     global viewactive viewcomplete tclencoding
 505     global startmsecs showneartags showlocalchanges
 506     global mainheadid viewmainheadid viewmainheadid_orig pending_select
 507     global hasworktree
 508     global varcid vposids vnegids vflags vrevs
 509     global show_notes
 510
 511     set hasworktree [hasworktree]
 512     rereadrefs
 513     set view $curview
 514     if {$mainheadid ne $viewmainheadid_orig($view)} {
 515         if {$showlocalchanges} {
 516             dohidelocalchanges
 517         }
 518         set viewmainheadid($view) $mainheadid
 519         set viewmainheadid_orig($view) $mainheadid
 520         if {$vfilelimit($view) ne {}} {
 521             get_viewmainhead $view
 522         }
 523     }
 524     if {$showlocalchanges} {
 525         doshowlocalchanges
 526     }
 527     if {$vcanopt($view)} {
 528         set oldpos $vposids($view)
 529         set oldneg $vnegids($view)
 530         set revs [parseviewrevs $view $vrevs($view)]
 531         if {$revs eq {}} {
 532             return
 533         }
 534         # note: getting the delta when negative refs change is hard,
 535         # and could require multiple git log invocations, so in that
 536         # case we ask git log for all the commits (not just the delta)
 537         if {$oldneg eq $vnegids($view)} {
 538             set newrevs {}
 539             set npos 0
 540             # take out positive refs that we asked for before or
 541             # that we have already seen
 542             foreach rev $revs {
 543                 if {[string length $rev] == 40} {
 544                     if {[lsearch -exact $oldpos $rev] < 0
 545                         && ![info exists varcid($view,$rev)]} {
 546                         lappend newrevs $rev
 547                         incr npos
 548                     }
 549                 } else {
 550                     lappend $newrevs $rev
 551                 }
 552             }
 553             if {$npos == 0} return
 554             set revs $newrevs
 555             set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
 556         }
 557         set args [concat $vflags($view) $revs --not $oldpos]
 558     } else {
 559         set args $vorigargs($view)
 560     }
 561     if {[catch {
 562         set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 563                         --parents --boundary $args "--" $vfilelimit($view)] r]
 564     } err]} {
 565         error_popup "[mc "Error executing git log:"] $err"
 566         return
 567     }
 568     if {$viewactive($view) == 0} {
 569         set startmsecs [clock clicks -milliseconds]
 570     }
 571     set i [reg_instance $fd]
 572     lappend viewinstances($view) $i
 573     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 574     if {$tclencoding != {}} {
 575         fconfigure $fd -encoding $tclencoding
 576     }
 577     filerun $fd [list getcommitlines $fd $i $view 1]
 578     incr viewactive($view)
 579     set viewcomplete($view) 0
 580     reset_pending_select {}
 581     nowbusy $view [mc "Reading"]
 582     if {$showneartags} {
 583         getallcommits
 584     }
 585 }
 586
 587 proc reloadcommits {} {
 588     global curview viewcomplete selectedline currentid thickerline
 589     global showneartags treediffs commitinterest cached_commitrow
 590     global targetid commitinfo
 591
 592     set selid {}
 593     if {$selectedline ne {}} {
 594         set selid $currentid
 595     }
 596
 597     if {!$viewcomplete($curview)} {
 598         stop_rev_list $curview
 599     }
 600     resetvarcs $curview
 601     set selectedline {}
 602     unset -nocomplain currentid
 603     unset -nocomplain thickerline
 604     unset -nocomplain treediffs
 605     readrefs
 606     changedrefs
 607     if {$showneartags} {
 608         getallcommits
 609     }
 610     clear_display
 611     unset -nocomplain commitinfo
 612     unset -nocomplain commitinterest
 613     unset -nocomplain cached_commitrow
 614     unset -nocomplain targetid
 615     setcanvscroll
 616     getcommits $selid
 617     return 0
 618 }
 619
 620 # This makes a string representation of a positive integer which
 621 # sorts as a string in numerical order
 622 proc strrep {n} {
 623     if {$n < 16} {
 624         return [format "%x" $n]
 625     } elseif {$n < 256} {
 626         return [format "x%.2x" $n]
 627     } elseif {$n < 65536} {
 628         return [format "y%.4x" $n]
 629     }
 630     return [format "z%.8x" $n]
 631 }
 632
 633 # Procedures used in reordering commits from git log (without
 634 # --topo-order) into the order for display.
 635
 636 proc varcinit {view} {
 637     global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
 638     global vtokmod varcmod vrowmod varcix vlastins
 639
 640     set varcstart($view) {{}}
 641     set vupptr($view) {0}
 642     set vdownptr($view) {0}
 643     set vleftptr($view) {0}
 644     set vbackptr($view) {0}
 645     set varctok($view) {{}}
 646     set varcrow($view) {{}}
 647     set vtokmod($view) {}
 648     set varcmod($view) 0
 649     set vrowmod($view) 0
 650     set varcix($view) {{}}
 651     set vlastins($view) {0}
 652 }
 653
 654 proc resetvarcs {view} {
 655     global varcid varccommits parents children vseedcount ordertok
 656     global vshortids
 657
 658     foreach vid [array names varcid $view,*] {
 659         unset varcid($vid)
 660         unset children($vid)
 661         unset parents($vid)
 662     }
 663     foreach vid [array names vshortids $view,*] {
 664         unset vshortids($vid)
 665     }
 666     # some commits might have children but haven't been seen yet
 667     foreach vid [array names children $view,*] {
 668         unset children($vid)
 669     }
 670     foreach va [array names varccommits $view,*] {
 671         unset varccommits($va)
 672     }
 673     foreach vd [array names vseedcount $view,*] {
 674         unset vseedcount($vd)
 675     }
 676     unset -nocomplain ordertok
 677 }
 678
 679 # returns a list of the commits with no children
 680 proc seeds {v} {
 681     global vdownptr vleftptr varcstart
 682
 683     set ret {}
 684     set a [lindex $vdownptr($v) 0]
 685     while {$a != 0} {
 686         lappend ret [lindex $varcstart($v) $a]
 687         set a [lindex $vleftptr($v) $a]
 688     }
 689     return $ret
 690 }
 691
 692 proc newvarc {view id} {
 693     global varcid varctok parents children vdatemode
 694     global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
 695     global commitdata commitinfo vseedcount varccommits vlastins
 696
 697     set a [llength $varctok($view)]
 698     set vid $view,$id
 699     if {[llength $children($vid)] == 0 || $vdatemode($view)} {
 700         if {![info exists commitinfo($id)]} {
 701             parsecommit $id $commitdata($id) 1
 702         }
 703         set cdate [lindex [lindex $commitinfo($id) 4] 0]
 704         if {![string is integer -strict $cdate]} {
 705             set cdate 0
 706         }
 707         if {![info exists vseedcount($view,$cdate)]} {
 708             set vseedcount($view,$cdate) -1
 709         }
 710         set c [incr vseedcount($view,$cdate)]
 711         set cdate [expr {$cdate ^ 0xffffffff}]
 712         set tok "s[strrep $cdate][strrep $c]"
 713     } else {
 714         set tok {}
 715     }
 716     set ka 0
 717     if {[llength $children($vid)] > 0} {
 718         set kid [lindex $children($vid) end]
 719         set k $varcid($view,$kid)
 720         if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
 721             set ki $kid
 722             set ka $k
 723             set tok [lindex $varctok($view) $k]
 724         }
 725     }
 726     if {$ka != 0} {
 727         set i [lsearch -exact $parents($view,$ki) $id]
 728         set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 729         append tok [strrep $j]
 730     }
 731     set c [lindex $vlastins($view) $ka]
 732     if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
 733         set c $ka
 734         set b [lindex $vdownptr($view) $ka]
 735     } else {
 736         set b [lindex $vleftptr($view) $c]
 737     }
 738     while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 739         set c $b
 740         set b [lindex $vleftptr($view) $c]
 741     }
 742     if {$c == $ka} {
 743         lset vdownptr($view) $ka $a
 744         lappend vbackptr($view) 0
 745     } else {
 746         lset vleftptr($view) $c $a
 747         lappend vbackptr($view) $c
 748     }
 749     lset vlastins($view) $ka $a
 750     lappend vupptr($view) $ka
 751     lappend vleftptr($view) $b
 752     if {$b != 0} {
 753         lset vbackptr($view) $b $a
 754     }
 755     lappend varctok($view) $tok
 756     lappend varcstart($view) $id
 757     lappend vdownptr($view) 0
 758     lappend varcrow($view) {}
 759     lappend varcix($view) {}
 760     set varccommits($view,$a) {}
 761     lappend vlastins($view) 0
 762     return $a
 763 }
 764
 765 proc splitvarc {p v} {
 766     global varcid varcstart varccommits varctok vtokmod
 767     global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
 768
 769     set oa $varcid($v,$p)
 770     set otok [lindex $varctok($v) $oa]
 771     set ac $varccommits($v,$oa)
 772     set i [lsearch -exact $varccommits($v,$oa) $p]
 773     if {$i <= 0} return
 774     set na [llength $varctok($v)]
 775     # "%" sorts before "0"...
 776     set tok "$otok%[strrep $i]"
 777     lappend varctok($v) $tok
 778     lappend varcrow($v) {}
 779     lappend varcix($v) {}
 780     set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 781     set varccommits($v,$na) [lrange $ac $i end]
 782     lappend varcstart($v) $p
 783     foreach id $varccommits($v,$na) {
 784         set varcid($v,$id) $na
 785     }
 786     lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 787     lappend vlastins($v) [lindex $vlastins($v) $oa]
 788     lset vdownptr($v) $oa $na
 789     lset vlastins($v) $oa 0
 790     lappend vupptr($v) $oa
 791     lappend vleftptr($v) 0
 792     lappend vbackptr($v) 0
 793     for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 794         lset vupptr($v) $b $na
 795     }
 796     if {[string compare $otok $vtokmod($v)] <= 0} {
 797         modify_arc $v $oa
 798     }
 799 }
 800
 801 proc renumbervarc {a v} {
 802     global parents children varctok varcstart varccommits
 803     global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
 804
 805     set t1 [clock clicks -milliseconds]
 806     set todo {}
 807     set isrelated($a) 1
 808     set kidchanged($a) 1
 809     set ntot 0
 810     while {$a != 0} {
 811         if {[info exists isrelated($a)]} {
 812             lappend todo $a
 813             set id [lindex $varccommits($v,$a) end]
 814             foreach p $parents($v,$id) {
 815                 if {[info exists varcid($v,$p)]} {
 816                     set isrelated($varcid($v,$p)) 1
 817                 }
 818             }
 819         }
 820         incr ntot
 821         set b [lindex $vdownptr($v) $a]
 822         if {$b == 0} {
 823             while {$a != 0} {
 824                 set b [lindex $vleftptr($v) $a]
 825                 if {$b != 0} break
 826                 set a [lindex $vupptr($v) $a]
 827             }
 828         }
 829         set a $b
 830     }
 831     foreach a $todo {
 832         if {![info exists kidchanged($a)]} continue
 833         set id [lindex $varcstart($v) $a]
 834         if {[llength $children($v,$id)] > 1} {
 835             set children($v,$id) [lsort -command [list vtokcmp $v] \
 836                                       $children($v,$id)]
 837         }
 838         set oldtok [lindex $varctok($v) $a]
 839         if {!$vdatemode($v)} {
 840             set tok {}
 841         } else {
 842             set tok $oldtok
 843         }
 844         set ka 0
 845         set kid [last_real_child $v,$id]
 846         if {$kid ne {}} {
 847             set k $varcid($v,$kid)
 848             if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
 849                 set ki $kid
 850                 set ka $k
 851                 set tok [lindex $varctok($v) $k]
 852             }
 853         }
 854         if {$ka != 0} {
 855             set i [lsearch -exact $parents($v,$ki) $id]
 856             set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 857             append tok [strrep $j]
 858         }
 859         if {$tok eq $oldtok} {
 860             continue
 861         }
 862         set id [lindex $varccommits($v,$a) end]
 863         foreach p $parents($v,$id) {
 864             if {[info exists varcid($v,$p)]} {
 865                 set kidchanged($varcid($v,$p)) 1
 866             } else {
 867                 set sortkids($p) 1
 868             }
 869         }
 870         lset varctok($v) $a $tok
 871         set b [lindex $vupptr($v) $a]
 872         if {$b != $ka} {
 873             if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
 874                 modify_arc $v $ka
 875             }
 876             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 877                 modify_arc $v $b
 878             }
 879             set c [lindex $vbackptr($v) $a]
 880             set d [lindex $vleftptr($v) $a]
 881             if {$c == 0} {
 882                 lset vdownptr($v) $b $d
 883             } else {
 884                 lset vleftptr($v) $c $d
 885             }
 886             if {$d != 0} {
 887                 lset vbackptr($v) $d $c
 888             }
 889             if {[lindex $vlastins($v) $b] == $a} {
 890                 lset vlastins($v) $b $c
 891             }
 892             lset vupptr($v) $a $ka
 893             set c [lindex $vlastins($v) $ka]
 894             if {$c == 0 || \
 895                     [string compare $tok [lindex $varctok($v) $c]] < 0} {
 896                 set c $ka
 897                 set b [lindex $vdownptr($v) $ka]
 898             } else {
 899                 set b [lindex $vleftptr($v) $c]
 900             }
 901             while {$b != 0 && \
 902                       [string compare $tok [lindex $varctok($v) $b]] >= 0} {
 903                 set c $b
 904                 set b [lindex $vleftptr($v) $c]
 905             }
 906             if {$c == $ka} {
 907                 lset vdownptr($v) $ka $a
 908                 lset vbackptr($v) $a 0
 909             } else {
 910                 lset vleftptr($v) $c $a
 911                 lset vbackptr($v) $a $c
 912             }
 913             lset vleftptr($v) $a $b
 914             if {$b != 0} {
 915                 lset vbackptr($v) $b $a
 916             }
 917             lset vlastins($v) $ka $a
 918         }
 919     }
 920     foreach id [array names sortkids] {
 921         if {[llength $children($v,$id)] > 1} {
 922             set children($v,$id) [lsort -command [list vtokcmp $v] \
 923                                       $children($v,$id)]
 924         }
 925     }
 926     set t2 [clock clicks -milliseconds]
 927     #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 928 }
 929
 930 # Fix up the graph after we have found out that in view $v,
 931 # $p (a commit that we have already seen) is actually the parent
 932 # of the last commit in arc $a.
 933 proc fix_reversal {p a v} {
 934     global varcid varcstart varctok vupptr
 935
 936     set pa $varcid($v,$p)
 937     if {$p ne [lindex $varcstart($v) $pa]} {
 938         splitvarc $p $v
 939         set pa $varcid($v,$p)
 940     }
 941     # seeds always need to be renumbered
 942     if {[lindex $vupptr($v) $pa] == 0 ||
 943         [string compare [lindex $varctok($v) $a] \
 944              [lindex $varctok($v) $pa]] > 0} {
 945         renumbervarc $pa $v
 946     }
 947 }
 948
 949 proc insertrow {id p v} {
 950     global cmitlisted children parents varcid varctok vtokmod
 951     global varccommits ordertok commitidx numcommits curview
 952     global targetid targetrow vshortids
 953
 954     readcommit $id
 955     set vid $v,$id
 956     set cmitlisted($vid) 1
 957     set children($vid) {}
 958     set parents($vid) [list $p]
 959     set a [newvarc $v $id]
 960     set varcid($vid) $a
 961     lappend vshortids($v,[string range $id 0 3]) $id
 962     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
 963         modify_arc $v $a
 964     }
 965     lappend varccommits($v,$a) $id
 966     set vp $v,$p
 967     if {[llength [lappend children($vp) $id]] > 1} {
 968         set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
 969         unset -nocomplain ordertok
 970     }
 971     fix_reversal $p $a $v
 972     incr commitidx($v)
 973     if {$v == $curview} {
 974         set numcommits $commitidx($v)
 975         setcanvscroll
 976         if {[info exists targetid]} {
 977             if {![comes_before $targetid $p]} {
 978                 incr targetrow
 979             }
 980         }
 981     }
 982 }
 983
 984 proc insertfakerow {id p} {
 985     global varcid varccommits parents children cmitlisted
 986     global commitidx varctok vtokmod targetid targetrow curview numcommits
 987
 988     set v $curview
 989     set a $varcid($v,$p)
 990     set i [lsearch -exact $varccommits($v,$a) $p]
 991     if {$i < 0} {
 992         puts "oops: insertfakerow can't find [shortids $p] on arc $a"
 993         return
 994     }
 995     set children($v,$id) {}
 996     set parents($v,$id) [list $p]
 997     set varcid($v,$id) $a
 998     lappend children($v,$p) $id
 999     set cmitlisted($v,$id) 1
1000     set numcommits [incr commitidx($v)]
1001     # note we deliberately don't update varcstart($v) even if $i == 0
1002     set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
1003     modify_arc $v $a $i
1004     if {[info exists targetid]} {
1005         if {![comes_before $targetid $p]} {
1006             incr targetrow
1007         }
1008     }
1009     setcanvscroll
1010     drawvisible
1011 }
1012
1013 proc removefakerow {id} {
1014     global varcid varccommits parents children commitidx
1015     global varctok vtokmod cmitlisted currentid selectedline
1016     global targetid curview numcommits
1017
1018     set v $curview
1019     if {[llength $parents($v,$id)] != 1} {
1020         puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1021         return
1022     }
1023     set p [lindex $parents($v,$id) 0]
1024     set a $varcid($v,$id)
1025     set i [lsearch -exact $varccommits($v,$a) $id]
1026     if {$i < 0} {
1027         puts "oops: removefakerow can't find [shortids $id] on arc $a"
1028         return
1029     }
1030     unset varcid($v,$id)
1031     set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1032     unset parents($v,$id)
1033     unset children($v,$id)
1034     unset cmitlisted($v,$id)
1035     set numcommits [incr commitidx($v) -1]
1036     set j [lsearch -exact $children($v,$p) $id]
1037     if {$j >= 0} {
1038         set children($v,$p) [lreplace $children($v,$p) $j $j]
1039     }
1040     modify_arc $v $a $i
1041     if {[info exist currentid] && $id eq $currentid} {
1042         unset currentid
1043         set selectedline {}
1044     }
1045     if {[info exists targetid] && $targetid eq $id} {
1046         set targetid $p
1047     }
1048     setcanvscroll
1049     drawvisible
1050 }
1051
1052 proc real_children {vp} {
1053     global children nullid nullid2
1054
1055     set kids {}
1056     foreach id $children($vp) {
1057         if {$id ne $nullid && $id ne $nullid2} {
1058             lappend kids $id
1059         }
1060     }
1061     return $kids
1062 }
1063
1064 proc first_real_child {vp} {
1065     global children nullid nullid2
1066
1067     foreach id $children($vp) {
1068         if {$id ne $nullid && $id ne $nullid2} {
1069             return $id
1070         }
1071     }
1072     return {}
1073 }
1074
1075 proc last_real_child {vp} {
1076     global children nullid nullid2
1077
1078     set kids $children($vp)
1079     for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1080         set id [lindex $kids $i]
1081         if {$id ne $nullid && $id ne $nullid2} {
1082             return $id
1083         }
1084     }
1085     return {}
1086 }
1087
1088 proc vtokcmp {v a b} {
1089     global varctok varcid
1090
1091     return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1092                 [lindex $varctok($v) $varcid($v,$b)]]
1093 }
1094
1095 # This assumes that if lim is not given, the caller has checked that
1096 # arc a's token is less than $vtokmod($v)
1097 proc modify_arc {v a {lim {}}} {
1098     global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1099
1100     if {$lim ne {}} {
1101         set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1102         if {$c > 0} return
1103         if {$c == 0} {
1104             set r [lindex $varcrow($v) $a]
1105             if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1106         }
1107     }
1108     set vtokmod($v) [lindex $varctok($v) $a]
1109     set varcmod($v) $a
1110     if {$v == $curview} {
1111         while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1112             set a [lindex $vupptr($v) $a]
1113             set lim {}
1114         }
1115         set r 0
1116         if {$a != 0} {
1117             if {$lim eq {}} {
1118                 set lim [llength $varccommits($v,$a)]
1119             }
1120             set r [expr {[lindex $varcrow($v) $a] + $lim}]
1121         }
1122         set vrowmod($v) $r
1123         undolayout $r
1124     }
1125 }
1126
1127 proc update_arcrows {v} {
1128     global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1129     global varcid vrownum varcorder varcix varccommits
1130     global vupptr vdownptr vleftptr varctok
1131     global displayorder parentlist curview cached_commitrow
1132
1133     if {$vrowmod($v) == $commitidx($v)} return
1134     if {$v == $curview} {
1135         if {[llength $displayorder] > $vrowmod($v)} {
1136             set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1137             set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1138         }
1139         unset -nocomplain cached_commitrow
1140     }
1141     set narctot [expr {[llength $varctok($v)] - 1}]
1142     set a $varcmod($v)
1143     while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1144         # go up the tree until we find something that has a row number,
1145         # or we get to a seed
1146         set a [lindex $vupptr($v) $a]
1147     }
1148     if {$a == 0} {
1149         set a [lindex $vdownptr($v) 0]
1150         if {$a == 0} return
1151         set vrownum($v) {0}
1152         set varcorder($v) [list $a]
1153         lset varcix($v) $a 0
1154         lset varcrow($v) $a 0
1155         set arcn 0
1156         set row 0
1157     } else {
1158         set arcn [lindex $varcix($v) $a]
1159         if {[llength $vrownum($v)] > $arcn + 1} {
1160             set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1161             set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1162         }
1163         set row [lindex $varcrow($v) $a]
1164     }
1165     while {1} {
1166         set p $a
1167         incr row [llength $varccommits($v,$a)]
1168         # go down if possible
1169         set b [lindex $vdownptr($v) $a]
1170         if {$b == 0} {
1171             # if not, go left, or go up until we can go left
1172             while {$a != 0} {
1173                 set b [lindex $vleftptr($v) $a]
1174                 if {$b != 0} break
1175                 set a [lindex $vupptr($v) $a]
1176             }
1177             if {$a == 0} break
1178         }
1179         set a $b
1180         incr arcn
1181         lappend vrownum($v) $row
1182         lappend varcorder($v) $a
1183         lset varcix($v) $a $arcn
1184         lset varcrow($v) $a $row
1185     }
1186     set vtokmod($v) [lindex $varctok($v) $p]
1187     set varcmod($v) $p
1188     set vrowmod($v) $row
1189     if {[info exists currentid]} {
1190         set selectedline [rowofcommit $currentid]
1191     }
1192 }
1193
1194 # Test whether view $v contains commit $id
1195 proc commitinview {id v} {
1196     global varcid
1197
1198     return [info exists varcid($v,$id)]
1199 }
1200
1201 # Return the row number for commit $id in the current view
1202 proc rowofcommit {id} {
1203     global varcid varccommits varcrow curview cached_commitrow
1204     global varctok vtokmod
1205
1206     set v $curview
1207     if {![info exists varcid($v,$id)]} {
1208         puts "oops rowofcommit no arc for [shortids $id]"
1209         return {}
1210     }
1211     set a $varcid($v,$id)
1212     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1213         update_arcrows $v
1214     }
1215     if {[info exists cached_commitrow($id)]} {
1216         return $cached_commitrow($id)
1217     }
1218     set i [lsearch -exact $varccommits($v,$a) $id]
1219     if {$i < 0} {
1220         puts "oops didn't find commit [shortids $id] in arc $a"
1221         return {}
1222     }
1223     incr i [lindex $varcrow($v) $a]
1224     set cached_commitrow($id) $i
1225     return $i
1226 }
1227
1228 # Returns 1 if a is on an earlier row than b, otherwise 0
1229 proc comes_before {a b} {
1230     global varcid varctok curview
1231
1232     set v $curview
1233     if {$a eq $b || ![info exists varcid($v,$a)] || \
1234             ![info exists varcid($v,$b)]} {
1235         return 0
1236     }
1237     if {$varcid($v,$a) != $varcid($v,$b)} {
1238         return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1239                            [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1240     }
1241     return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1242 }
1243
1244 proc bsearch {l elt} {
1245     if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1246         return 0
1247     }
1248     set lo 0
1249     set hi [llength $l]
1250     while {$hi - $lo > 1} {
1251         set mid [expr {int(($lo + $hi) / 2)}]
1252         set t [lindex $l $mid]
1253         if {$elt < $t} {
1254             set hi $mid
1255         } elseif {$elt > $t} {
1256             set lo $mid
1257         } else {
1258             return $mid
1259         }
1260     }
1261     return $lo
1262 }
1263
1264 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
1265 proc make_disporder {start end} {
1266     global vrownum curview commitidx displayorder parentlist
1267     global varccommits varcorder parents vrowmod varcrow
1268     global d_valid_start d_valid_end
1269
1270     if {$end > $vrowmod($curview)} {
1271         update_arcrows $curview
1272     }
1273     set ai [bsearch $vrownum($curview) $start]
1274     set start [lindex $vrownum($curview) $ai]
1275     set narc [llength $vrownum($curview)]
1276     for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1277         set a [lindex $varcorder($curview) $ai]
1278         set l [llength $displayorder]
1279         set al [llength $varccommits($curview,$a)]
1280         if {$l < $r + $al} {
1281             if {$l < $r} {
1282                 set pad [ntimes [expr {$r - $l}] {}]
1283                 set displayorder [concat $displayorder $pad]
1284                 set parentlist [concat $parentlist $pad]
1285             } elseif {$l > $r} {
1286                 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1287                 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1288             }
1289             foreach id $varccommits($curview,$a) {
1290                 lappend displayorder $id
1291                 lappend parentlist $parents($curview,$id)
1292             }
1293         } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1294             set i $r
1295             foreach id $varccommits($curview,$a) {
1296                 lset displayorder $i $id
1297                 lset parentlist $i $parents($curview,$id)
1298                 incr i
1299             }
1300         }
1301         incr r $al
1302     }
1303 }
1304
1305 proc commitonrow {row} {
1306     global displayorder
1307
1308     set id [lindex $displayorder $row]
1309     if {$id eq {}} {
1310         make_disporder $row [expr {$row + 1}]
1311         set id [lindex $displayorder $row]
1312     }
1313     return $id
1314 }
1315
1316 proc closevarcs {v} {
1317     global varctok varccommits varcid parents children
1318     global cmitlisted commitidx vtokmod curview numcommits
1319
1320     set missing_parents 0
1321     set scripts {}
1322     set narcs [llength $varctok($v)]
1323     for {set a 1} {$a < $narcs} {incr a} {
1324         set id [lindex $varccommits($v,$a) end]
1325         foreach p $parents($v,$id) {
1326             if {[info exists varcid($v,$p)]} continue
1327             # add p as a new commit
1328             incr missing_parents
1329             set cmitlisted($v,$p) 0
1330             set parents($v,$p) {}
1331             if {[llength $children($v,$p)] == 1 &&
1332                 [llength $parents($v,$id)] == 1} {
1333                 set b $a
1334             } else {
1335                 set b [newvarc $v $p]
1336             }
1337             set varcid($v,$p) $b
1338             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1339                 modify_arc $v $b
1340             }
1341             lappend varccommits($v,$b) $p
1342             incr commitidx($v)
1343             if {$v == $curview} {
1344                 set numcommits $commitidx($v)
1345             }
1346             set scripts [check_interest $p $scripts]
1347         }
1348     }
1349     if {$missing_parents > 0} {
1350         foreach s $scripts {
1351             eval $s
1352         }
1353     }
1354 }
1355
1356 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1357 # Assumes we already have an arc for $rwid.
1358 proc rewrite_commit {v id rwid} {
1359     global children parents varcid varctok vtokmod varccommits
1360
1361     foreach ch $children($v,$id) {
1362         # make $rwid be $ch's parent in place of $id
1363         set i [lsearch -exact $parents($v,$ch) $id]
1364         if {$i < 0} {
1365             puts "oops rewrite_commit didn't find $id in parent list for $ch"
1366         }
1367         set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1368         # add $ch to $rwid's children and sort the list if necessary
1369         if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1370             set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1371                                         $children($v,$rwid)]
1372         }
1373         # fix the graph after joining $id to $rwid
1374         set a $varcid($v,$ch)
1375         fix_reversal $rwid $a $v
1376         # parentlist is wrong for the last element of arc $a
1377         # even if displayorder is right, hence the 3rd arg here
1378         modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1379     }
1380 }
1381
1382 # Mechanism for registering a command to be executed when we come
1383 # across a particular commit.  To handle the case when only the
1384 # prefix of the commit is known, the commitinterest array is now
1385 # indexed by the first 4 characters of the ID.  Each element is a
1386 # list of id, cmd pairs.
1387 proc interestedin {id cmd} {
1388     global commitinterest
1389
1390     lappend commitinterest([string range $id 0 3]) $id $cmd
1391 }
1392
1393 proc check_interest {id scripts} {
1394     global commitinterest
1395
1396     set prefix [string range $id 0 3]
1397     if {[info exists commitinterest($prefix)]} {
1398         set newlist {}
1399         foreach {i script} $commitinterest($prefix) {
1400             if {[string match "$i*" $id]} {
1401                 lappend scripts [string map [list "%I" $id "%P" $i] $script]
1402             } else {
1403                 lappend newlist $i $script
1404             }
1405         }
1406         if {$newlist ne {}} {
1407             set commitinterest($prefix) $newlist
1408         } else {
1409             unset commitinterest($prefix)
1410         }
1411     }
1412     return $scripts
1413 }
1414
1415 proc getcommitlines {fd inst view updating}  {
1416     global cmitlisted leftover
1417     global commitidx commitdata vdatemode
1418     global parents children curview hlview
1419     global idpending ordertok
1420     global varccommits varcid varctok vtokmod vfilelimit vshortids
1421
1422     set stuff [read $fd 500000]
1423     # git log doesn't terminate the last commit with a null...
1424     if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1425         set stuff "\0"
1426     }
1427     if {$stuff == {}} {
1428         if {![eof $fd]} {
1429             return 1
1430         }
1431         global commfd viewcomplete viewactive viewname
1432         global viewinstances
1433         unset commfd($inst)
1434         set i [lsearch -exact $viewinstances($view) $inst]
1435         if {$i >= 0} {
1436             set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1437         }
1438         # set it blocking so we wait for the process to terminate
1439         fconfigure $fd -blocking 1
1440         if {[catch {close $fd} err]} {
1441             set fv {}
1442             if {$view != $curview} {
1443                 set fv " for the \"$viewname($view)\" view"
1444             }
1445             if {[string range $err 0 4] == "usage"} {
1446                 set err "Gitk: error reading commits$fv:\
1447                         bad arguments to git log."
1448                 if {$viewname($view) eq [mc "Command line"]} {
1449                     append err \
1450                         "  (Note: arguments to gitk are passed to git log\
1451                          to allow selection of commits to be displayed.)"
1452                 }
1453             } else {
1454                 set err "Error reading commits$fv: $err"
1455             }
1456             error_popup $err
1457         }
1458         if {[incr viewactive($view) -1] <= 0} {
1459             set viewcomplete($view) 1
1460             # Check if we have seen any ids listed as parents that haven't
1461             # appeared in the list
1462             closevarcs $view
1463             notbusy $view
1464         }
1465         if {$view == $curview} {
1466             run chewcommits
1467         }
1468         return 0
1469     }
1470     set start 0
1471     set gotsome 0
1472     set scripts {}
1473     while 1 {
1474         set i [string first "\0" $stuff $start]
1475         if {$i < 0} {
1476             append leftover($inst) [string range $stuff $start end]
1477             break
1478         }
1479         if {$start == 0} {
1480             set cmit $leftover($inst)
1481             append cmit [string range $stuff 0 [expr {$i - 1}]]
1482             set leftover($inst) {}
1483         } else {
1484             set cmit [string range $stuff $start [expr {$i - 1}]]
1485         }
1486         set start [expr {$i + 1}]
1487         set j [string first "\n" $cmit]
1488         set ok 0
1489         set listed 1
1490         if {$j >= 0 && [string match "commit *" $cmit]} {
1491             set ids [string range $cmit 7 [expr {$j - 1}]]
1492             if {[string match {[-^<>]*} $ids]} {
1493                 switch -- [string index $ids 0] {
1494                     "-" {set listed 0}
1495                     "^" {set listed 2}
1496                     "<" {set listed 3}
1497                     ">" {set listed 4}
1498                 }
1499                 set ids [string range $ids 1 end]
1500             }
1501             set ok 1
1502             foreach id $ids {
1503                 if {[string length $id] != 40} {
1504                     set ok 0
1505                     break
1506                 }
1507             }
1508         }
1509         if {!$ok} {
1510             set shortcmit $cmit
1511             if {[string length $shortcmit] > 80} {
1512                 set shortcmit "[string range $shortcmit 0 80]..."
1513             }
1514             error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1515             exit 1
1516         }
1517         set id [lindex $ids 0]
1518         set vid $view,$id
1519
1520         lappend vshortids($view,[string range $id 0 3]) $id
1521
1522         if {!$listed && $updating && ![info exists varcid($vid)] &&
1523             $vfilelimit($view) ne {}} {
1524             # git log doesn't rewrite parents for unlisted commits
1525             # when doing path limiting, so work around that here
1526             # by working out the rewritten parent with git rev-list
1527             # and if we already know about it, using the rewritten
1528             # parent as a substitute parent for $id's children.
1529             if {![catch {
1530                 set rwid [exec git rev-list --first-parent --max-count=1 \
1531                               $id -- $vfilelimit($view)]
1532             }]} {
1533                 if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1534                     # use $rwid in place of $id
1535                     rewrite_commit $view $id $rwid
1536                     continue
1537                 }
1538             }
1539         }
1540
1541         set a 0
1542         if {[info exists varcid($vid)]} {
1543             if {$cmitlisted($vid) || !$listed} continue
1544             set a $varcid($vid)
1545         }
1546         if {$listed} {
1547             set olds [lrange $ids 1 end]
1548         } else {
1549             set olds {}
1550         }
1551         set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1552         set cmitlisted($vid) $listed
1553         set parents($vid) $olds
1554         if {![info exists children($vid)]} {
1555             set children($vid) {}
1556         } elseif {$a == 0 && [llength $children($vid)] == 1} {
1557             set k [lindex $children($vid) 0]
1558             if {[llength $parents($view,$k)] == 1 &&
1559                 (!$vdatemode($view) ||
1560                  $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1561                 set a $varcid($view,$k)
1562             }
1563         }
1564         if {$a == 0} {
1565             # new arc
1566             set a [newvarc $view $id]
1567         }
1568         if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1569             modify_arc $view $a
1570         }
1571         if {![info exists varcid($vid)]} {
1572             set varcid($vid) $a
1573             lappend varccommits($view,$a) $id
1574             incr commitidx($view)
1575         }
1576
1577         set i 0
1578         foreach p $olds {
1579             if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1580                 set vp $view,$p
1581                 if {[llength [lappend children($vp) $id]] > 1 &&
1582                     [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1583                     set children($vp) [lsort -command [list vtokcmp $view] \
1584                                            $children($vp)]
1585                     unset -nocomplain ordertok
1586                 }
1587                 if {[info exists varcid($view,$p)]} {
1588                     fix_reversal $p $a $view
1589                 }
1590             }
1591             incr i
1592         }
1593
1594         set scripts [check_interest $id $scripts]
1595         set gotsome 1
1596     }
1597     if {$gotsome} {
1598         global numcommits hlview
1599
1600         if {$view == $curview} {
1601             set numcommits $commitidx($view)
1602             run chewcommits
1603         }
1604         if {[info exists hlview] && $view == $hlview} {
1605             # we never actually get here...
1606             run vhighlightmore
1607         }
1608         foreach s $scripts {
1609             eval $s
1610         }
1611     }
1612     return 2
1613 }
1614
1615 proc chewcommits {} {
1616     global curview hlview viewcomplete
1617     global pending_select
1618
1619     layoutmore
1620     if {$viewcomplete($curview)} {
1621         global commitidx varctok
1622         global numcommits startmsecs
1623
1624         if {[info exists pending_select]} {
1625             update
1626             reset_pending_select {}
1627
1628             if {[commitinview $pending_select $curview]} {
1629                 selectline [rowofcommit $pending_select] 1
1630             } else {
1631                 set row [first_real_row]
1632                 selectline $row 1
1633             }
1634         }
1635         if {$commitidx($curview) > 0} {
1636             #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1637             #puts "overall $ms ms for $numcommits commits"
1638             #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1639         } else {
1640             show_status [mc "No commits selected"]
1641         }
1642         notbusy layout
1643     }
1644     return 0
1645 }
1646
1647 proc do_readcommit {id} {
1648     global tclencoding
1649
1650     # Invoke git-log to handle automatic encoding conversion
1651     set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1652     # Read the results using i18n.logoutputencoding
1653     fconfigure $fd -translation lf -eofchar {}
1654     if {$tclencoding != {}} {
1655         fconfigure $fd -encoding $tclencoding
1656     }
1657     set contents [read $fd]
1658     close $fd
1659     # Remove the heading line
1660     regsub {^commit [0-9a-f]+\n} $contents {} contents
1661
1662     return $contents
1663 }
1664
1665 proc readcommit {id} {
1666     if {[catch {set contents [do_readcommit $id]}]} return
1667     parsecommit $id $contents 1
1668 }
1669
1670 proc parsecommit {id contents listed} {
1671     global commitinfo
1672
1673     set inhdr 1
1674     set comment {}
1675     set headline {}
1676     set auname {}
1677     set audate {}
1678     set comname {}
1679     set comdate {}
1680     set hdrend [string first "\n\n" $contents]
1681     if {$hdrend < 0} {
1682         # should never happen...
1683         set hdrend [string length $contents]
1684     }
1685     set header [string range $contents 0 [expr {$hdrend - 1}]]
1686     set comment [string range $contents [expr {$hdrend + 2}] end]
1687     foreach line [split $header "\n"] {
1688         set line [split $line " "]
1689         set tag [lindex $line 0]
1690         if {$tag == "author"} {
1691             set audate [lrange $line end-1 end]
1692             set auname [join [lrange $line 1 end-2] " "]
1693         } elseif {$tag == "committer"} {
1694             set comdate [lrange $line end-1 end]
1695             set comname [join [lrange $line 1 end-2] " "]
1696         }
1697     }
1698     set headline {}
1699     # take the first non-blank line of the comment as the headline
1700     set headline [string trimleft $comment]
1701     set i [string first "\n" $headline]
1702     if {$i >= 0} {
1703         set headline [string range $headline 0 $i]
1704     }
1705     set headline [string trimright $headline]
1706     set i [string first "\r" $headline]
1707     if {$i >= 0} {
1708         set headline [string trimright [string range $headline 0 $i]]
1709     }
1710     if {!$listed} {
1711         # git log indents the comment by 4 spaces;
1712         # if we got this via git cat-file, add the indentation
1713         set newcomment {}
1714         foreach line [split $comment "\n"] {
1715             append newcomment "    "
1716             append newcomment $line
1717             append newcomment "\n"
1718         }
1719         set comment $newcomment
1720     }
1721     set hasnote [string first "\nNotes:\n" $contents]
1722     set diff ""
1723     # If there is diff output shown in the git-log stream, split it
1724     # out.  But get rid of the empty line that always precedes the
1725     # diff.
1726     set i [string first "\n\ndiff" $comment]
1727     if {$i >= 0} {
1728         set diff [string range $comment $i+1 end]
1729         set comment [string range $comment 0 $i-1]
1730     }
1731     set commitinfo($id) [list $headline $auname $audate \
1732                              $comname $comdate $comment $hasnote $diff]
1733 }
1734
1735 proc getcommit {id} {
1736     global commitdata commitinfo
1737
1738     if {[info exists commitdata($id)]} {
1739         parsecommit $id $commitdata($id) 1
1740     } else {
1741         readcommit $id
1742         if {![info exists commitinfo($id)]} {
1743             set commitinfo($id) [list [mc "No commit information available"]]
1744         }
1745     }
1746     return 1
1747 }
1748
1749 # Expand an abbreviated commit ID to a list of full 40-char IDs that match
1750 # and are present in the current view.
1751 # This is fairly slow...
1752 proc longid {prefix} {
1753     global varcid curview vshortids
1754
1755     set ids {}
1756     if {[string length $prefix] >= 4} {
1757         set vshortid $curview,[string range $prefix 0 3]
1758         if {[info exists vshortids($vshortid)]} {
1759             foreach id $vshortids($vshortid) {
1760                 if {[string match "$prefix*" $id]} {
1761                     if {[lsearch -exact $ids $id] < 0} {
1762                         lappend ids $id
1763                         if {[llength $ids] >= 2} break
1764                     }
1765                 }
1766             }
1767         }
1768     } else {
1769         foreach match [array names varcid "$curview,$prefix*"] {
1770             lappend ids [lindex [split $match ","] 1]
1771             if {[llength $ids] >= 2} break
1772         }
1773     }
1774     return $ids
1775 }
1776
1777 proc readrefs {} {
1778     global tagids idtags headids idheads tagobjid
1779     global otherrefids idotherrefs mainhead mainheadid
1780     global selecthead selectheadid
1781     global hideremotes
1782     global tclencoding
1783
1784     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1785         unset -nocomplain $v
1786     }
1787     set refd [open [list | git show-ref -d] r]
1788     if {$tclencoding != {}} {
1789         fconfigure $refd -encoding $tclencoding
1790     }
1791     while {[gets $refd line] >= 0} {
1792         if {[string index $line 40] ne " "} continue
1793         set id [string range $line 0 39]
1794         set ref [string range $line 41 end]
1795         if {![string match "refs/*" $ref]} continue
1796         set name [string range $ref 5 end]
1797         if {[string match "remotes/*" $name]} {
1798             if {![string match "*/HEAD" $name] && !$hideremotes} {
1799                 set headids($name) $id
1800                 lappend idheads($id) $name
1801             }
1802         } elseif {[string match "heads/*" $name]} {
1803             set name [string range $name 6 end]
1804             set headids($name) $id
1805             lappend idheads($id) $name
1806         } elseif {[string match "tags/*" $name]} {
1807             # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1808             # which is what we want since the former is the commit ID
1809             set name [string range $name 5 end]
1810             if {[string match "*^{}" $name]} {
1811                 set name [string range $name 0 end-3]
1812             } else {
1813                 set tagobjid($name) $id
1814             }
1815             set tagids($name) $id
1816             lappend idtags($id) $name
1817         } else {
1818             set otherrefids($name) $id
1819             lappend idotherrefs($id) $name
1820         }
1821     }
1822     catch {close $refd}
1823     set mainhead {}
1824     set mainheadid {}
1825     catch {
1826         set mainheadid [exec git rev-parse HEAD]
1827         set thehead [exec git symbolic-ref HEAD]
1828         if {[string match "refs/heads/*" $thehead]} {
1829             set mainhead [string range $thehead 11 end]
1830         }
1831     }
1832     set selectheadid {}
1833     if {$selecthead ne {}} {
1834         catch {
1835             set selectheadid [exec git rev-parse --verify $selecthead]
1836         }
1837     }
1838 }
1839
1840 # skip over fake commits
1841 proc first_real_row {} {
1842     global nullid nullid2 numcommits
1843
1844     for {set row 0} {$row < $numcommits} {incr row} {
1845         set id [commitonrow $row]
1846         if {$id ne $nullid && $id ne $nullid2} {
1847             break
1848         }
1849     }
1850     return $row
1851 }
1852
1853 # update things for a head moved to a child of its previous location
1854 proc movehead {id name} {
1855     global headids idheads
1856
1857     removehead $headids($name) $name
1858     set headids($name) $id
1859     lappend idheads($id) $name
1860 }
1861
1862 # update things when a head has been removed
1863 proc removehead {id name} {
1864     global headids idheads
1865
1866     if {$idheads($id) eq $name} {
1867         unset idheads($id)
1868     } else {
1869         set i [lsearch -exact $idheads($id) $name]
1870         if {$i >= 0} {
1871             set idheads($id) [lreplace $idheads($id) $i $i]
1872         }
1873     }
1874     unset headids($name)
1875 }
1876
1877 proc ttk_toplevel {w args} {
1878     global use_ttk
1879     eval [linsert $args 0 ::toplevel $w]
1880     if {$use_ttk} {
1881         place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1882     }
1883     return $w
1884 }
1885
1886 proc make_transient {window origin} {
1887     global have_tk85
1888
1889     # In MacOS Tk 8.4 transient appears to work by setting
1890     # overrideredirect, which is utterly useless, since the
1891     # windows get no border, and are not even kept above
1892     # the parent.
1893     if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1894
1895     wm transient $window $origin
1896
1897     # Windows fails to place transient windows normally, so
1898     # schedule a callback to center them on the parent.
1899     if {[tk windowingsystem] eq {win32}} {
1900         after idle [list tk::PlaceWindow $window widget $origin]
1901     }
1902 }
1903
1904 proc show_error {w top msg} {
1905     global NS
1906     if {![info exists NS]} {set NS ""}
1907     if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1908     message $w.m -text $msg -justify center -aspect 400
1909     pack $w.m -side top -fill x -padx 20 -pady 20
1910     ${NS}::button $w.ok -default active -text [mc OK] -command "destroy $top"
1911     pack $w.ok -side bottom -fill x
1912     bind $top <Visibility> "grab $top; focus $top"
1913     bind $top <Key-Return> "destroy $top"
1914     bind $top <Key-space>  "destroy $top"
1915     bind $top <Key-Escape> "destroy $top"
1916     tkwait window $top
1917 }
1918
1919 proc error_popup {msg {owner .}} {
1920     if {[tk windowingsystem] eq "win32"} {
1921         tk_messageBox -icon error -type ok -title [wm title .] \
1922             -parent $owner -message $msg
1923     } else {
1924         set w .error
1925         ttk_toplevel $w
1926         make_transient $w $owner
1927         show_error $w $w $msg
1928     }
1929 }
1930
1931 proc confirm_popup {msg {owner .}} {
1932     global confirm_ok NS
1933     set confirm_ok 0
1934     set w .confirm
1935     ttk_toplevel $w
1936     make_transient $w $owner
1937     message $w.m -text $msg -justify center -aspect 400
1938     pack $w.m -side top -fill x -padx 20 -pady 20
1939     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1940     pack $w.ok -side left -fill x
1941     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1942     pack $w.cancel -side right -fill x
1943     bind $w <Visibility> "grab $w; focus $w"
1944     bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1945     bind $w <Key-space>  "set confirm_ok 1; destroy $w"
1946     bind $w <Key-Escape> "destroy $w"
1947     tk::PlaceWindow $w widget $owner
1948     tkwait window $w
1949     return $confirm_ok
1950 }
1951
1952 proc setoptions {} {
1953     global use_ttk
1954
1955     if {[tk windowingsystem] ne "win32"} {
1956         option add *Panedwindow.showHandle 1 startupFile
1957         option add *Panedwindow.sashRelief raised startupFile
1958         if {[tk windowingsystem] ne "aqua"} {
1959             option add *Menu.font uifont startupFile
1960         }
1961     } else {
1962         option add *Menu.TearOff 0 startupFile
1963     }
1964     option add *Button.font uifont startupFile
1965     option add *Checkbutton.font uifont startupFile
1966     option add *Radiobutton.font uifont startupFile
1967     option add *Menubutton.font uifont startupFile
1968     option add *Label.font uifont startupFile
1969     option add *Message.font uifont startupFile
1970     option add *Entry.font textfont startupFile
1971     option add *Text.font textfont startupFile
1972     option add *Labelframe.font uifont startupFile
1973     option add *Spinbox.font textfont startupFile
1974     option add *Listbox.font mainfont startupFile
1975 }
1976
1977 proc setttkstyle {} {
1978     eval font configure TkDefaultFont [fontflags mainfont]
1979     eval font configure TkTextFont [fontflags textfont]
1980     eval font configure TkHeadingFont [fontflags mainfont]
1981     eval font configure TkCaptionFont [fontflags mainfont] -weight bold
1982     eval font configure TkTooltipFont [fontflags uifont]
1983     eval font configure TkFixedFont   [fontflags textfont]
1984     eval font configure TkIconFont    [fontflags uifont]
1985     eval font configure TkMenuFont    [fontflags uifont]
1986     eval font configure TkSmallCaptionFont [fontflags uifont]
1987 }
1988
1989 # Make a menu and submenus.
1990 # m is the window name for the menu, items is the list of menu items to add.
1991 # Each item is a list {mc label type description options...}
1992 # mc is ignored; it's so we can put mc there to alert xgettext
1993 # label is the string that appears in the menu
1994 # type is cascade, command or radiobutton (should add checkbutton)
1995 # description depends on type; it's the sublist for cascade, the
1996 # command to invoke for command, or {variable value} for radiobutton
1997 proc makemenu {m items} {
1998     menu $m
1999     if {[tk windowingsystem] eq {aqua}} {
2000         set Meta1 Cmd
2001     } else {
2002         set Meta1 Ctrl
2003     }
2004     foreach i $items {
2005         set name [mc [lindex $i 1]]
2006         set type [lindex $i 2]
2007         set thing [lindex $i 3]
2008         set params [list $type]
2009         if {$name ne {}} {
2010             set u [string first "&" [string map {&& x} $name]]
2011             lappend params -label [string map {&& & & {}} $name]
2012             if {$u >= 0} {
2013                 lappend params -underline $u
2014             }
2015         }
2016         switch -- $type {
2017             "cascade" {
2018                 set submenu [string tolower [string map {& ""} [lindex $i 1]]]
2019                 lappend params -menu $m.$submenu
2020             }
2021             "command" {
2022                 lappend params -command $thing
2023             }
2024             "radiobutton" {
2025                 lappend params -variable [lindex $thing 0] \
2026                     -value [lindex $thing 1]
2027             }
2028         }
2029         set tail [lrange $i 4 end]
2030         regsub -all {\yMeta1\y} $tail $Meta1 tail
2031         eval $m add $params $tail
2032         if {$type eq "cascade"} {
2033             makemenu $m.$submenu $thing
2034         }
2035     }
2036 }
2037
2038 # translate string and remove ampersands
2039 proc mca {str} {
2040     return [string map {&& & & {}} [mc $str]]
2041 }
2042
2043 proc cleardropsel {w} {
2044     $w selection clear
2045 }
2046 proc makedroplist {w varname args} {
2047     global use_ttk
2048     if {$use_ttk} {
2049         set width 0
2050         foreach label $args {
2051             set cx [string length $label]
2052             if {$cx > $width} {set width $cx}
2053         }
2054         set gm [ttk::combobox $w -width $width -state readonly\
2055                     -textvariable $varname -values $args \
2056                     -exportselection false]
2057         bind $gm <<ComboboxSelected>> [list $gm selection clear]
2058     } else {
2059         set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2060     }
2061     return $gm
2062 }
2063
2064 proc makewindow {} {
2065     global canv canv2 canv3 linespc charspc ctext cflist cscroll
2066     global tabstop
2067     global findtype findtypemenu findloc findstring fstring geometry
2068     global entries sha1entry sha1string sha1but
2069     global diffcontextstring diffcontext
2070     global ignorespace
2071     global maincursor textcursor curtextcursor
2072     global rowctxmenu fakerowmenu mergemax wrapcomment
2073     global highlight_files gdttype
2074     global searchstring sstring
2075     global bgcolor fgcolor bglist fglist diffcolors diffbgcolors selectbgcolor
2076     global uifgcolor uifgdisabledcolor
2077     global filesepbgcolor filesepfgcolor
2078     global mergecolors foundbgcolor currentsearchhitbgcolor
2079     global headctxmenu progresscanv progressitem progresscoords statusw
2080     global fprogitem fprogcoord lastprogupdate progupdatepending
2081     global rprogitem rprogcoord rownumsel numcommits
2082     global have_tk85 use_ttk NS
2083     global git_version
2084     global worddiff
2085
2086     # The "mc" arguments here are purely so that xgettext
2087     # sees the following string as needing to be translated
2088     set file {
2089         mc "&File" cascade {
2090             {mc "&Update" command updatecommits -accelerator F5}
2091             {mc "&Reload" command reloadcommits -accelerator Shift-F5}
2092             {mc "Reread re&ferences" command rereadrefs}
2093             {mc "&List references" command showrefs -accelerator F2}
2094             {xx "" separator}
2095             {mc "Start git &gui" command {exec git gui &}}
2096             {xx "" separator}
2097             {mc "&Quit" command doquit -accelerator Meta1-Q}
2098         }}
2099     set edit {
2100         mc "&Edit" cascade {
2101             {mc "&Preferences" command doprefs}
2102         }}
2103     set view {
2104         mc "&View" cascade {
2105             {mc "&New view..." command {newview 0} -accelerator Shift-F4}
2106             {mc "&Edit view..." command editview -state disabled -accelerator F4}
2107             {mc "&Delete view" command delview -state disabled}
2108             {xx "" separator}
2109             {mc "&All files" radiobutton {selectedview 0} -command {showview 0}}
2110         }}
2111     if {[tk windowingsystem] ne "aqua"} {
2112         set help {
2113         mc "&Help" cascade {
2114             {mc "&About gitk" command about}
2115             {mc "&Key bindings" command keys}
2116         }}
2117         set bar [list $file $edit $view $help]
2118     } else {
2119         proc ::tk::mac::ShowPreferences {} {doprefs}
2120         proc ::tk::mac::Quit {} {doquit}
2121         lset file end [lreplace [lindex $file end] end-1 end]
2122         set apple {
2123         xx "&Apple" cascade {
2124             {mc "&About gitk" command about}
2125             {xx "" separator}
2126         }}
2127         set help {
2128         mc "&Help" cascade {
2129             {mc "&Key bindings" command keys}
2130         }}
2131         set bar [list $apple $file $view $help]
2132     }
2133     makemenu .bar $bar
2134     . configure -menu .bar
2135
2136     if {$use_ttk} {
2137         # cover the non-themed toplevel with a themed frame.
2138         place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2139     }
2140
2141     # the gui has upper and lower half, parts of a paned window.
2142     ${NS}::panedwindow .ctop -orient vertical
2143
2144     # possibly use assumed geometry
2145     if {![info exists geometry(pwsash0)]} {
2146         set geometry(topheight) [expr {15 * $linespc}]
2147         set geometry(topwidth) [expr {80 * $charspc}]
2148         set geometry(botheight) [expr {15 * $linespc}]
2149         set geometry(botwidth) [expr {50 * $charspc}]
2150         set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2151         set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2152     }
2153
2154     # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2155     ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2156     ${NS}::frame .tf.histframe
2157     ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2158     if {!$use_ttk} {
2159         .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2160     }
2161
2162     # create three canvases
2163     set cscroll .tf.histframe.csb
2164     set canv .tf.histframe.pwclist.canv
2165     canvas $canv \
2166         -selectbackground $selectbgcolor \
2167         -background $bgcolor -bd 0 \
2168         -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2169     .tf.histframe.pwclist add $canv
2170     set canv2 .tf.histframe.pwclist.canv2
2171     canvas $canv2 \
2172         -selectbackground $selectbgcolor \
2173         -background $bgcolor -bd 0 -yscrollincr $linespc
2174     .tf.histframe.pwclist add $canv2
2175     set canv3 .tf.histframe.pwclist.canv3
2176     canvas $canv3 \
2177         -selectbackground $selectbgcolor \
2178         -background $bgcolor -bd 0 -yscrollincr $linespc
2179     .tf.histframe.pwclist add $canv3
2180     if {$use_ttk} {
2181         bind .tf.histframe.pwclist <Map> {
2182             bind %W <Map> {}
2183             .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2184             .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2185         }
2186     } else {
2187         eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2188         eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2189     }
2190
2191     # a scroll bar to rule them
2192     ${NS}::scrollbar $cscroll -command {allcanvs yview}
2193     if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2194     pack $cscroll -side right -fill y
2195     bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2196     lappend bglist $canv $canv2 $canv3
2197     pack .tf.histframe.pwclist -fill both -expand 1 -side left
2198
2199     # we have two button bars at bottom of top frame. Bar 1
2200     ${NS}::frame .tf.bar
2201     ${NS}::frame .tf.lbar -height 15
2202
2203     set sha1entry .tf.bar.sha1
2204     set entries $sha1entry
2205     set sha1but .tf.bar.sha1label
2206     button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2207         -command gotocommit -width 8
2208     $sha1but conf -disabledforeground [$sha1but cget -foreground]
2209     pack .tf.bar.sha1label -side left
2210     ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2211     trace add variable sha1string write sha1change
2212     pack $sha1entry -side left -pady 2
2213
2214     set bm_left_data {
2215         #define left_width 16
2216         #define left_height 16
2217         static unsigned char left_bits[] = {
2218         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2219         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2220         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2221     }
2222     set bm_right_data {
2223         #define right_width 16
2224         #define right_height 16
2225         static unsigned char right_bits[] = {
2226         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2227         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2228         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2229     }
2230     image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2231     image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2232     image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2233     image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
2234
2235     ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2236     if {$use_ttk} {
2237         .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2238     } else {
2239         .tf.bar.leftbut configure -image bm-left
2240     }
2241     pack .tf.bar.leftbut -side left -fill y
2242     ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2243     if {$use_ttk} {
2244         .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2245     } else {
2246         .tf.bar.rightbut configure -image bm-right
2247     }
2248     pack .tf.bar.rightbut -side left -fill y
2249
2250     ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2251     set rownumsel {}
2252     ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2253         -relief sunken -anchor e
2254     ${NS}::label .tf.bar.rowlabel2 -text "/"
2255     ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2256         -relief sunken -anchor e
2257     pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2258         -side left
2259     if {!$use_ttk} {
2260         foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2261     }
2262     global selectedline
2263     trace add variable selectedline write selectedline_change
2264
2265     # Status label and progress bar
2266     set statusw .tf.bar.status
2267     ${NS}::label $statusw -width 15 -relief sunken
2268     pack $statusw -side left -padx 5
2269     if {$use_ttk} {
2270         set progresscanv [ttk::progressbar .tf.bar.progress]
2271     } else {
2272         set h [expr {[font metrics uifont -linespace] + 2}]
2273         set progresscanv .tf.bar.progress
2274         canvas $progresscanv -relief sunken -height $h -borderwidth 2
2275         set progressitem [$progresscanv create rect -1 0 0 $h -fill "#00ff00"]
2276         set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2277         set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2278     }
2279     pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2280     set progresscoords {0 0}
2281     set fprogcoord 0
2282     set rprogcoord 0
2283     bind $progresscanv <Configure> adjustprogress
2284     set lastprogupdate [clock clicks -milliseconds]
2285     set progupdatepending 0
2286
2287     # build up the bottom bar of upper window
2288     ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2289
2290     set bm_down_data {
2291         #define down_width 16
2292         #define down_height 16
2293         static unsigned char down_bits[] = {
2294         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2295         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2296         0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
2297         0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
2298     }
2299     image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
2300     ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
2301     .tf.lbar.fnext configure -image bm-down
2302
2303     set bm_up_data {
2304         #define up_width 16
2305         #define up_height 16
2306         static unsigned char up_bits[] = {
2307         0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
2308         0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
2309         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2310         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
2311     }
2312     image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
2313     ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
2314     .tf.lbar.fprev configure -image bm-up
2315
2316     ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2317
2318     pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2319         -side left -fill y
2320     set gdttype [mc "containing:"]
2321     set gm [makedroplist .tf.lbar.gdttype gdttype \
2322                 [mc "containing:"] \
2323                 [mc "touching paths:"] \
2324                 [mc "adding/removing string:"] \
2325                 [mc "changing lines matching:"]]
2326     trace add variable gdttype write gdttype_change
2327     pack .tf.lbar.gdttype -side left -fill y
2328
2329     set findstring {}
2330     set fstring .tf.lbar.findstring
2331     lappend entries $fstring
2332     ${NS}::entry $fstring -width 30 -textvariable findstring
2333     trace add variable findstring write find_change
2334     set findtype [mc "Exact"]
2335     set findtypemenu [makedroplist .tf.lbar.findtype \
2336                           findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2337     trace add variable findtype write findcom_change
2338     set findloc [mc "All fields"]
2339     makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2340         [mc "Comments"] [mc "Author"] [mc "Committer"]
2341     trace add variable findloc write find_change
2342     pack .tf.lbar.findloc -side right
2343     pack .tf.lbar.findtype -side right
2344     pack $fstring -side left -expand 1 -fill x
2345
2346     # Finish putting the upper half of the viewer together
2347     pack .tf.lbar -in .tf -side bottom -fill x
2348     pack .tf.bar -in .tf -side bottom -fill x
2349     pack .tf.histframe -fill both -side top -expand 1
2350     .ctop add .tf
2351     if {!$use_ttk} {
2352         .ctop paneconfigure .tf -height $geometry(topheight)
2353         .ctop paneconfigure .tf -width $geometry(topwidth)
2354     }
2355
2356     # now build up the bottom
2357     ${NS}::panedwindow .pwbottom -orient horizontal
2358
2359     # lower left, a text box over search bar, scroll bar to the right
2360     # if we know window height, then that will set the lower text height, otherwise
2361     # we set lower text height which will drive window height
2362     if {[info exists geometry(main)]} {
2363         ${NS}::frame .bleft -width $geometry(botwidth)
2364     } else {
2365         ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2366     }
2367     ${NS}::frame .bleft.top
2368     ${NS}::frame .bleft.mid
2369     ${NS}::frame .bleft.bottom
2370
2371     # gap between sub-widgets
2372     set wgap [font measure uifont "i"]
2373
2374     ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2375     pack .bleft.top.search -side left -padx 5
2376     set sstring .bleft.top.sstring
2377     set searchstring ""
2378     ${NS}::entry $sstring -width 20 -textvariable searchstring
2379     lappend entries $sstring
2380     trace add variable searchstring write incrsearch
2381     pack $sstring -side left -expand 1 -fill x
2382     ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2383         -command changediffdisp -variable diffelide -value {0 0}
2384     ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2385         -command changediffdisp -variable diffelide -value {0 1}
2386     ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2387         -command changediffdisp -variable diffelide -value {1 0}
2388
2389     ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2390     pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left -ipadx $wgap
2391     spinbox .bleft.mid.diffcontext -width 5 \
2392         -from 0 -increment 1 -to 10000000 \
2393         -validate all -validatecommand "diffcontextvalidate %P" \
2394         -textvariable diffcontextstring
2395     .bleft.mid.diffcontext set $diffcontext
2396     trace add variable diffcontextstring write diffcontextchange
2397     lappend entries .bleft.mid.diffcontext
2398     pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left -ipadx $wgap
2399     ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2400         -command changeignorespace -variable ignorespace
2401     pack .bleft.mid.ignspace -side left -padx 5
2402
2403     set worddiff [mc "Line diff"]
2404     if {[package vcompare $git_version "1.7.2"] >= 0} {
2405         makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2406             [mc "Markup words"] [mc "Color words"]
2407         trace add variable worddiff write changeworddiff
2408         pack .bleft.mid.worddiff -side left -padx 5
2409     }
2410
2411     set ctext .bleft.bottom.ctext
2412     text $ctext -background $bgcolor -foreground $fgcolor \
2413         -state disabled -undo 0 -font textfont \
2414         -yscrollcommand scrolltext -wrap none \
2415         -xscrollcommand ".bleft.bottom.sbhorizontal set"
2416     if {$have_tk85} {
2417         $ctext conf -tabstyle wordprocessor
2418     }
2419     ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2420     ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2421     pack .bleft.top -side top -fill x
2422     pack .bleft.mid -side top -fill x
2423     grid $ctext .bleft.bottom.sb -sticky nsew
2424     grid .bleft.bottom.sbhorizontal -sticky ew
2425     grid columnconfigure .bleft.bottom 0 -weight 1
2426     grid rowconfigure .bleft.bottom 0 -weight 1
2427     grid rowconfigure .bleft.bottom 1 -weight 0
2428     pack .bleft.bottom -side top -fill both -expand 1
2429     lappend bglist $ctext
2430     lappend fglist $ctext
2431
2432     $ctext tag conf comment -wrap $wrapcomment
2433     $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
2434     $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2435     $ctext tag conf d0 -fore [lindex $diffcolors 0]
2436     $ctext tag conf d0 -back [lindex $diffbgcolors 0]
2437     $ctext tag conf dresult -fore [lindex $diffcolors 1]
2438     $ctext tag conf dresult -back [lindex $diffbgcolors 1]
2439     $ctext tag conf m0 -fore [lindex $mergecolors 0]
2440     $ctext tag conf m1 -fore [lindex $mergecolors 1]
2441     $ctext tag conf m2 -fore [lindex $mergecolors 2]
2442     $ctext tag conf m3 -fore [lindex $mergecolors 3]
2443     $ctext tag conf m4 -fore [lindex $mergecolors 4]
2444     $ctext tag conf m5 -fore [lindex $mergecolors 5]
2445     $ctext tag conf m6 -fore [lindex $mergecolors 6]
2446     $ctext tag conf m7 -fore [lindex $mergecolors 7]
2447     $ctext tag conf m8 -fore [lindex $mergecolors 8]
2448     $ctext tag conf m9 -fore [lindex $mergecolors 9]
2449     $ctext tag conf m10 -fore [lindex $mergecolors 10]
2450     $ctext tag conf m11 -fore [lindex $mergecolors 11]
2451     $ctext tag conf m12 -fore [lindex $mergecolors 12]
2452     $ctext tag conf m13 -fore [lindex $mergecolors 13]
2453     $ctext tag conf m14 -fore [lindex $mergecolors 14]
2454     $ctext tag conf m15 -fore [lindex $mergecolors 15]
2455     $ctext tag conf mmax -fore darkgrey
2456     set mergemax 16
2457     $ctext tag conf mresult -font textfontbold
2458     $ctext tag conf msep -font textfontbold
2459     $ctext tag conf found -back $foundbgcolor
2460     $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
2461     $ctext tag conf wwrap -wrap word -lmargin2 1c
2462     $ctext tag conf bold -font textfontbold
2463     # set these to the lowest priority:
2464     $ctext tag lower currentsearchhit
2465     $ctext tag lower found
2466     $ctext tag lower filesep
2467     $ctext tag lower dresult
2468     $ctext tag lower d0
2469
2470     .pwbottom add .bleft
2471     if {!$use_ttk} {
2472         .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2473     }
2474
2475     # lower right
2476     ${NS}::frame .bright
2477     ${NS}::frame .bright.mode
2478     ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2479         -command reselectline -variable cmitmode -value "patch"
2480     ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2481         -command reselectline -variable cmitmode -value "tree"
2482     grid .bright.mode.patch .bright.mode.tree -sticky ew
2483     pack .bright.mode -side top -fill x
2484     set cflist .bright.cfiles
2485     set indent [font measure mainfont "nn"]
2486     text $cflist \
2487         -selectbackground $selectbgcolor \
2488         -background $bgcolor -foreground $fgcolor \
2489         -font mainfont \
2490         -tabs [list $indent [expr {2 * $indent}]] \
2491         -yscrollcommand ".bright.sb set" \
2492         -cursor [. cget -cursor] \
2493         -spacing1 1 -spacing3 1
2494     lappend bglist $cflist
2495     lappend fglist $cflist
2496     ${NS}::scrollbar .bright.sb -command "$cflist yview"
2497     pack .bright.sb -side right -fill y
2498     pack $cflist -side left -fill both -expand 1
2499     $cflist tag configure highlight \
2500         -background [$cflist cget -selectbackground]
2501     $cflist tag configure bold -font mainfontbold
2502
2503     .pwbottom add .bright
2504     .ctop add .pwbottom
2505
2506     # restore window width & height if known
2507     if {[info exists geometry(main)]} {
2508         if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2509             if {$w > [winfo screenwidth .]} {
2510                 set w [winfo screenwidth .]
2511             }
2512             if {$h > [winfo screenheight .]} {
2513                 set h [winfo screenheight .]
2514             }
2515             wm geometry . "${w}x$h"
2516         }
2517     }
2518
2519     if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2520         wm state . $geometry(state)
2521     }
2522
2523     if {[tk windowingsystem] eq {aqua}} {
2524         set M1B M1
2525         set ::BM "3"
2526     } else {
2527         set M1B Control
2528         set ::BM "2"
2529     }
2530
2531     if {$use_ttk} {
2532         bind .ctop <Map> {
2533             bind %W <Map> {}
2534             %W sashpos 0 $::geometry(topheight)
2535         }
2536         bind .pwbottom <Map> {
2537             bind %W <Map> {}
2538             %W sashpos 0 $::geometry(botwidth)
2539         }
2540         bind .pwbottom <Configure> {resizecdetpanes %W %w}
2541     }
2542
2543     pack .ctop -fill both -expand 1
2544     bindall <1> {selcanvline %W %x %y}
2545     #bindall <B1-Motion> {selcanvline %W %x %y}
2546     if {[tk windowingsystem] == "win32"} {
2547         bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2548         bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2549     } else {
2550         bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2551         bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2552         bind $ctext <Button> {
2553             if {"%b" eq 6} {
2554                 $ctext xview scroll -5 units
2555             } elseif {"%b" eq 7} {
2556                 $ctext xview scroll 5 units
2557             }
2558         }
2559         if {[tk windowingsystem] eq "aqua"} {
2560             bindall <MouseWheel> {
2561                 set delta [expr {- (%D)}]
2562                 allcanvs yview scroll $delta units
2563             }
2564             bindall <Shift-MouseWheel> {
2565                 set delta [expr {- (%D)}]
2566                 $canv xview scroll $delta units
2567             }
2568         }
2569     }
2570     bindall <$::BM> "canvscan mark %W %x %y"
2571     bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2572     bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2573     bind . <$M1B-Key-w> doquit
2574     bindkey <Home> selfirstline
2575     bindkey <End> sellastline
2576     bind . <Key-Up> "selnextline -1"
2577     bind . <Key-Down> "selnextline 1"
2578     bind . <Shift-Key-Up> "dofind -1 0"
2579     bind . <Shift-Key-Down> "dofind 1 0"
2580     bindkey <Key-Right> "goforw"
2581     bindkey <Key-Left> "goback"
2582     bind . <Key-Prior> "selnextpage -1"
2583     bind . <Key-Next> "selnextpage 1"
2584     bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2585     bind . <$M1B-End> "allcanvs yview moveto 1.0"
2586     bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2587     bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2588     bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2589     bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2590     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2591     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2592     bindkey <Key-space> "$ctext yview scroll 1 pages"
2593     bindkey p "selnextline -1"
2594     bindkey n "selnextline 1"
2595     bindkey z "goback"
2596     bindkey x "goforw"
2597     bindkey k "selnextline -1"
2598     bindkey j "selnextline 1"
2599     bindkey h "goback"
2600     bindkey l "goforw"
2601     bindkey b prevfile
2602     bindkey d "$ctext yview scroll 18 units"
2603     bindkey u "$ctext yview scroll -18 units"
2604     bindkey g {$sha1entry delete 0 end; focus $sha1entry}
2605     bindkey / {focus $fstring}
2606     bindkey <Key-KP_Divide> {focus $fstring}
2607     bindkey <Key-Return> {dofind 1 1}
2608     bindkey ? {dofind -1 1}
2609     bindkey f nextfile
2610     bind . <F5> updatecommits
2611     bindmodfunctionkey Shift 5 reloadcommits
2612     bind . <F2> showrefs
2613     bindmodfunctionkey Shift 4 {newview 0}
2614     bind . <F4> edit_or_newview
2615     bind . <$M1B-q> doquit
2616     bind . <$M1B-f> {dofind 1 1}
2617     bind . <$M1B-g> {dofind 1 0}
2618     bind . <$M1B-r> dosearchback
2619     bind . <$M1B-s> dosearch
2620     bind . <$M1B-equal> {incrfont 1}
2621     bind . <$M1B-plus> {incrfont 1}
2622     bind . <$M1B-KP_Add> {incrfont 1}
2623     bind . <$M1B-minus> {incrfont -1}
2624     bind . <$M1B-KP_Subtract> {incrfont -1}
2625     wm protocol . WM_DELETE_WINDOW doquit
2626     bind . <Destroy> {stop_backends}
2627     bind . <Button-1> "click %W"
2628     bind $fstring <Key-Return> {dofind 1 1}
2629     bind $sha1entry <Key-Return> {gotocommit; break}
2630     bind $sha1entry <<PasteSelection>> clearsha1
2631     bind $sha1entry <<Paste>> clearsha1
2632     bind $cflist <1> {sel_flist %W %x %y; break}
2633     bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2634     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2635     global ctxbut
2636     bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2637     bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2638     bind $ctext <Button-1> {focus %W}
2639     bind $ctext <<Selection>> rehighlight_search_results
2640     for {set i 1} {$i < 10} {incr i} {
2641         bind . <$M1B-Key-$i> [list go_to_parent $i]
2642     }
2643
2644     set maincursor [. cget -cursor]
2645     set textcursor [$ctext cget -cursor]
2646     set curtextcursor $textcursor
2647
2648     set rowctxmenu .rowctxmenu
2649     makemenu $rowctxmenu {
2650         {mc "Diff this -> selected" command {diffvssel 0}}
2651         {mc "Diff selected -> this" command {diffvssel 1}}
2652         {mc "Make patch" command mkpatch}
2653         {mc "Create tag" command mktag}
2654         {mc "Copy commit reference" command copyreference}
2655         {mc "Write commit to file" command writecommit}
2656         {mc "Create new branch" command mkbranch}
2657         {mc "Cherry-pick this commit" command cherrypick}
2658         {mc "Reset HEAD branch to here" command resethead}
2659         {mc "Mark this commit" command markhere}
2660         {mc "Return to mark" command gotomark}
2661         {mc "Find descendant of this and mark" command find_common_desc}
2662         {mc "Compare with marked commit" command compare_commits}
2663         {mc "Diff this -> marked commit" command {diffvsmark 0}}
2664         {mc "Diff marked commit -> this" command {diffvsmark 1}}
2665         {mc "Revert this commit" command revert}
2666     }
2667     $rowctxmenu configure -tearoff 0
2668
2669     set fakerowmenu .fakerowmenu
2670     makemenu $fakerowmenu {
2671         {mc "Diff this -> selected" command {diffvssel 0}}
2672         {mc "Diff selected -> this" command {diffvssel 1}}
2673         {mc "Make patch" command mkpatch}
2674         {mc "Diff this -> marked commit" command {diffvsmark 0}}
2675         {mc "Diff marked commit -> this" command {diffvsmark 1}}
2676     }
2677     $fakerowmenu configure -tearoff 0
2678
2679     set headctxmenu .headctxmenu
2680     makemenu $headctxmenu {
2681         {mc "Check out this branch" command cobranch}
2682         {mc "Rename this branch" command mvbranch}
2683         {mc "Remove this branch" command rmbranch}
2684         {mc "Copy branch name" command {clipboard clear; clipboard append $headmenuhead}}
2685     }
2686     $headctxmenu configure -tearoff 0
2687
2688     global flist_menu
2689     set flist_menu .flistctxmenu
2690     makemenu $flist_menu {
2691         {mc "Highlight this too" command {flist_hl 0}}
2692         {mc "Highlight this only" command {flist_hl 1}}
2693         {mc "External diff" command {external_diff}}
2694         {mc "Blame parent commit" command {external_blame 1}}
2695         {mc "Copy path" command {clipboard clear; clipboard append $flist_menu_file}}
2696     }
2697     $flist_menu configure -tearoff 0
2698
2699     global diff_menu
2700     set diff_menu .diffctxmenu
2701     makemenu $diff_menu {
2702         {mc "Show origin of this line" command show_line_source}
2703         {mc "Run git gui blame on this line" command {external_blame_diff}}
2704     }
2705     $diff_menu configure -tearoff 0
2706 }
2707
2708 # Windows sends all mouse wheel events to the current focused window, not
2709 # the one where the mouse hovers, so bind those events here and redirect
2710 # to the correct window
2711 proc windows_mousewheel_redirector {W X Y D} {
2712     global canv canv2 canv3
2713     set w [winfo containing -displayof $W $X $Y]
2714     if {$w ne ""} {
2715         set u [expr {$D < 0 ? 5 : -5}]
2716         if {$w == $canv || $w == $canv2 || $w == $canv3} {
2717             allcanvs yview scroll $u units
2718         } else {
2719             catch {
2720                 $w yview scroll $u units
2721             }
2722         }
2723     }
2724 }
2725
2726 # Update row number label when selectedline changes
2727 proc selectedline_change {n1 n2 op} {
2728     global selectedline rownumsel
2729
2730     if {$selectedline eq {}} {
2731         set rownumsel {}
2732     } else {
2733         set rownumsel [expr {$selectedline + 1}]
2734     }
2735 }
2736
2737 # mouse-2 makes all windows scan vertically, but only the one
2738 # the cursor is in scans horizontally
2739 proc canvscan {op w x y} {
2740     global canv canv2 canv3
2741     foreach c [list $canv $canv2 $canv3] {
2742         if {$c == $w} {
2743             $c scan $op $x $y
2744         } else {
2745             $c scan $op 0 $y
2746         }
2747     }
2748 }
2749
2750 proc scrollcanv {cscroll f0 f1} {
2751     $cscroll set $f0 $f1
2752     drawvisible
2753     flushhighlights
2754 }
2755
2756 # when we make a key binding for the toplevel, make sure
2757 # it doesn't get triggered when that key is pressed in the
2758 # find string entry widget.
2759 proc bindkey {ev script} {
2760     global entries
2761     bind . $ev $script
2762     set escript [bind Entry $ev]
2763     if {$escript == {}} {
2764         set escript [bind Entry <Key>]
2765     }
2766     foreach e $entries {
2767         bind $e $ev "$escript; break"
2768     }
2769 }
2770
2771 proc bindmodfunctionkey {mod n script} {
2772     bind . <$mod-F$n> $script
2773     catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2774 }
2775
2776 # set the focus back to the toplevel for any click outside
2777 # the entry widgets
2778 proc click {w} {
2779     global ctext entries
2780     foreach e [concat $entries $ctext] {
2781         if {$w == $e} return
2782     }
2783     focus .
2784 }
2785
2786 # Adjust the progress bar for a change in requested extent or canvas size
2787 proc adjustprogress {} {
2788     global progresscanv progressitem progresscoords
2789     global fprogitem fprogcoord lastprogupdate progupdatepending
2790     global rprogitem rprogcoord use_ttk
2791
2792     if {$use_ttk} {
2793         $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2794         return
2795     }
2796
2797     set w [expr {[winfo width $progresscanv] - 4}]
2798     set x0 [expr {$w * [lindex $progresscoords 0]}]
2799     set x1 [expr {$w * [lindex $progresscoords 1]}]
2800     set h [winfo height $progresscanv]
2801     $progresscanv coords $progressitem $x0 0 $x1 $h
2802     $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2803     $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2804     set now [clock clicks -milliseconds]
2805     if {$now >= $lastprogupdate + 100} {
2806         set progupdatepending 0
2807         update
2808     } elseif {!$progupdatepending} {
2809         set progupdatepending 1
2810         after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2811     }
2812 }
2813
2814 proc doprogupdate {} {
2815     global lastprogupdate progupdatepending
2816
2817     if {$progupdatepending} {
2818         set progupdatepending 0
2819         set lastprogupdate [clock clicks -milliseconds]
2820         update
2821     }
2822 }
2823
2824 proc config_check_tmp_exists {tries_left} {
2825     global config_file_tmp
2826
2827     if {[file exists $config_file_tmp]} {
2828         incr tries_left -1
2829         if {$tries_left > 0} {
2830             after 100 [list config_check_tmp_exists $tries_left]
2831         } else {
2832             error_popup "There appears to be a stale $config_file_tmp\
2833  file, which will prevent gitk from saving its configuration on exit.\
2834  Please remove it if it is not being used by any existing gitk process."
2835         }
2836     }
2837 }
2838
2839 proc config_init_trace {name} {
2840     global config_variable_changed config_variable_original
2841
2842     upvar #0 $name var
2843     set config_variable_changed($name) 0
2844     set config_variable_original($name) $var
2845 }
2846
2847 proc config_variable_change_cb {name name2 op} {
2848     global config_variable_changed config_variable_original
2849
2850     upvar #0 $name var
2851     if {$op eq "write" &&
2852         (![info exists config_variable_original($name)] ||
2853          $config_variable_original($name) ne $var)} {
2854         set config_variable_changed($name) 1
2855     }
2856 }
2857
2858 proc savestuff {w} {
2859     global stuffsaved
2860     global config_file config_file_tmp
2861     global config_variables config_variable_changed
2862     global viewchanged
2863
2864     upvar #0 viewname current_viewname
2865     upvar #0 viewfiles current_viewfiles
2866     upvar #0 viewargs current_viewargs
2867     upvar #0 viewargscmd current_viewargscmd
2868     upvar #0 viewperm current_viewperm
2869     upvar #0 nextviewnum current_nextviewnum
2870     upvar #0 use_ttk current_use_ttk
2871
2872     if {$stuffsaved} return
2873     if {![winfo viewable .]} return
2874     set remove_tmp 0
2875     if {[catch {
2876         set try_count 0
2877         while {[catch {set f [open $config_file_tmp {WRONLY CREAT EXCL}]}]} {
2878             if {[incr try_count] > 50} {
2879                 error "Unable to write config file: $config_file_tmp exists"
2880             }
2881             after 100
2882         }
2883         set remove_tmp 1
2884         if {$::tcl_platform(platform) eq {windows}} {
2885             file attributes $config_file_tmp -hidden true
2886         }
2887         if {[file exists $config_file]} {
2888             source $config_file
2889         }
2890         foreach var_name $config_variables {
2891             upvar #0 $var_name var
2892             upvar 0 $var_name old_var
2893             if {!$config_variable_changed($var_name) && [info exists old_var]} {
2894                 puts $f [list set $var_name $old_var]
2895             } else {
2896                 puts $f [list set $var_name $var]
2897             }
2898         }
2899
2900         puts $f "set geometry(main) [wm geometry .]"
2901         puts $f "set geometry(state) [wm state .]"
2902         puts $f "set geometry(topwidth) [winfo width .tf]"
2903         puts $f "set geometry(topheight) [winfo height .tf]"
2904         if {$current_use_ttk} {
2905             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2906             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2907         } else {
2908             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2909             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2910         }
2911         puts $f "set geometry(botwidth) [winfo width .bleft]"
2912         puts $f "set geometry(botheight) [winfo height .bleft]"
2913
2914         array set view_save {}
2915         array set views {}
2916         if {![info exists permviews]} { set permviews {} }
2917         foreach view $permviews {
2918             set view_save([lindex $view 0]) 1
2919             set views([lindex $view 0]) $view
2920         }
2921         puts -nonewline $f "set permviews {"
2922         for {set v 1} {$v < $current_nextviewnum} {incr v} {
2923             if {$viewchanged($v)} {
2924                 if {$current_viewperm($v)} {
2925                     set views($current_viewname($v)) [list $current_viewname($v) $current_viewfiles($v) $current_viewargs($v) $current_viewargscmd($v)]
2926                 } else {
2927                     set view_save($current_viewname($v)) 0
2928                 }
2929             }
2930         }
2931         # write old and updated view to their places and append remaining to the end
2932         foreach view $permviews {
2933             set view_name [lindex $view 0]
2934             if {$view_save($view_name)} {
2935                 puts $f "{$views($view_name)}"
2936             }
2937             unset views($view_name)
2938         }
2939         foreach view_name [array names views] {
2940             puts $f "{$views($view_name)}"
2941         }
2942         puts $f "}"
2943         close $f
2944         file rename -force $config_file_tmp $config_file
2945         set remove_tmp 0
2946     } err]} {
2947         puts "Error saving config: $err"
2948     }
2949     if {$remove_tmp} {
2950         file delete -force $config_file_tmp
2951     }
2952     set stuffsaved 1
2953 }
2954
2955 proc resizeclistpanes {win w} {
2956     global oldwidth oldsash use_ttk
2957     if {[info exists oldwidth($win)]} {
2958         if {[info exists oldsash($win)]} {
2959             set s0 [lindex $oldsash($win) 0]
2960             set s1 [lindex $oldsash($win) 1]
2961         } elseif {$use_ttk} {
2962             set s0 [$win sashpos 0]
2963             set s1 [$win sashpos 1]
2964         } else {
2965             set s0 [$win sash coord 0]
2966             set s1 [$win sash coord 1]
2967         }
2968         if {$w < 60} {
2969             set sash0 [expr {int($w/2 - 2)}]
2970             set sash1 [expr {int($w*5/6 - 2)}]
2971         } else {
2972             set factor [expr {1.0 * $w / $oldwidth($win)}]
2973             set sash0 [expr {int($factor * [lindex $s0 0])}]
2974             set sash1 [expr {int($factor * [lindex $s1 0])}]
2975             if {$sash0 < 30} {
2976                 set sash0 30
2977             }
2978             if {$sash1 < $sash0 + 20} {
2979                 set sash1 [expr {$sash0 + 20}]
2980             }
2981             if {$sash1 > $w - 10} {
2982                 set sash1 [expr {$w - 10}]
2983                 if {$sash0 > $sash1 - 20} {
2984                     set sash0 [expr {$sash1 - 20}]
2985                 }
2986             }
2987         }
2988         if {$use_ttk} {
2989             $win sashpos 0 $sash0
2990             $win sashpos 1 $sash1
2991         } else {
2992             $win sash place 0 $sash0 [lindex $s0 1]
2993             $win sash place 1 $sash1 [lindex $s1 1]
2994         }
2995         set oldsash($win) [list $sash0 $sash1]
2996     }
2997     set oldwidth($win) $w
2998 }
2999
3000 proc resizecdetpanes {win w} {
3001     global oldwidth oldsash use_ttk
3002     if {[info exists oldwidth($win)]} {
3003         if {[info exists oldsash($win)]} {
3004             set s0 $oldsash($win)
3005         } elseif {$use_ttk} {
3006             set s0 [$win sashpos 0]
3007         } else {
3008             set s0 [$win sash coord 0]
3009         }
3010         if {$w < 60} {
3011             set sash0 [expr {int($w*3/4 - 2)}]
3012         } else {
3013             set factor [expr {1.0 * $w / $oldwidth($win)}]
3014             set sash0 [expr {int($factor * [lindex $s0 0])}]
3015             if {$sash0 < 45} {
3016                 set sash0 45
3017             }
3018             if {$sash0 > $w - 15} {
3019                 set sash0 [expr {$w - 15}]
3020             }
3021         }
3022         if {$use_ttk} {
3023             $win sashpos 0 $sash0
3024         } else {
3025             $win sash place 0 $sash0 [lindex $s0 1]
3026         }
3027         set oldsash($win) $sash0
3028     }
3029     set oldwidth($win) $w
3030 }
3031
3032 proc allcanvs args {
3033     global canv canv2 canv3
3034     eval $canv $args
3035     eval $canv2 $args
3036     eval $canv3 $args
3037 }
3038
3039 proc bindall {event action} {
3040     global canv canv2 canv3
3041     bind $canv $event $action
3042     bind $canv2 $event $action
3043     bind $canv3 $event $action
3044 }
3045
3046 proc about {} {
3047     global bgcolor NS
3048     set w .about
3049     if {[winfo exists $w]} {
3050         raise $w
3051         return
3052     }
3053     ttk_toplevel $w
3054     wm title $w [mc "About gitk"]
3055     make_transient $w .
3056     message $w.m -text [mc "
3057 Gitk - a commit viewer for git
3058
3059 Copyright \u00a9 2005-2016 Paul Mackerras
3060
3061 Use and redistribute under the terms of the GNU General Public License"] \
3062             -justify center -aspect 400 -border 2 -bg $bgcolor -relief groove
3063     pack $w.m -side top -fill x -padx 2 -pady 2
3064     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3065     pack $w.ok -side bottom
3066     bind $w <Visibility> "focus $w.ok"
3067     bind $w <Key-Escape> "destroy $w"
3068     bind $w <Key-Return> "destroy $w"
3069     tk::PlaceWindow $w widget .
3070 }
3071
3072 proc keys {} {
3073     global bgcolor NS
3074     set w .keys
3075     if {[winfo exists $w]} {
3076         raise $w
3077         return
3078     }
3079     if {[tk windowingsystem] eq {aqua}} {
3080         set M1T Cmd
3081     } else {
3082         set M1T Ctrl
3083     }
3084     ttk_toplevel $w
3085     wm title $w [mc "Gitk key bindings"]
3086     make_transient $w .
3087     message $w.m -text "
3088 [mc "Gitk key bindings:"]
3089
3090 [mc "<%s-Q>             Quit" $M1T]
3091 [mc "<%s-W>             Close window" $M1T]
3092 [mc "<Home>             Move to first commit"]
3093 [mc "<End>              Move to last commit"]
3094 [mc "<Up>, p, k Move up one commit"]
3095 [mc "<Down>, n, j       Move down one commit"]
3096 [mc "<Left>, z, h       Go back in history list"]
3097 [mc "<Right>, x, l      Go forward in history list"]
3098 [mc "<%s-n>     Go to n-th parent of current commit in history list" $M1T]
3099 [mc "<PageUp>   Move up one page in commit list"]
3100 [mc "<PageDown> Move down one page in commit list"]
3101 [mc "<%s-Home>  Scroll to top of commit list" $M1T]
3102 [mc "<%s-End>   Scroll to bottom of commit list" $M1T]
3103 [mc "<%s-Up>    Scroll commit list up one line" $M1T]
3104 [mc "<%s-Down>  Scroll commit list down one line" $M1T]
3105 [mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
3106 [mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
3107 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
3108 [mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
3109 [mc "<Delete>, b        Scroll diff view up one page"]
3110 [mc "<Backspace>        Scroll diff view up one page"]
3111 [mc "<Space>            Scroll diff view down one page"]
3112 [mc "u          Scroll diff view up 18 lines"]
3113 [mc "d          Scroll diff view down 18 lines"]
3114 [mc "<%s-F>             Find" $M1T]
3115 [mc "<%s-G>             Move to next find hit" $M1T]
3116 [mc "<Return>   Move to next find hit"]
3117 [mc "g          Go to commit"]
3118 [mc "/          Focus the search box"]
3119 [mc "?          Move to previous find hit"]
3120 [mc "f          Scroll diff view to next file"]
3121 [mc "<%s-S>             Search for next hit in diff view" $M1T]
3122 [mc "<%s-R>             Search for previous hit in diff view" $M1T]
3123 [mc "<%s-KP+>   Increase font size" $M1T]
3124 [mc "<%s-plus>  Increase font size" $M1T]
3125 [mc "<%s-KP->   Decrease font size" $M1T]
3126 [mc "<%s-minus> Decrease font size" $M1T]
3127 [mc "<F5>               Update"]
3128 " \
3129             -justify left -bg $bgcolor -border 2 -relief groove
3130     pack $w.m -side top -fill both -padx 2 -pady 2
3131     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3132     bind $w <Key-Escape> [list destroy $w]
3133     pack $w.ok -side bottom
3134     bind $w <Visibility> "focus $w.ok"
3135     bind $w <Key-Escape> "destroy $w"
3136     bind $w <Key-Return> "destroy $w"
3137 }
3138
3139 # Procedures for manipulating the file list window at the
3140 # bottom right of the overall window.
3141
3142 proc treeview {w l openlevs} {
3143     global treecontents treediropen treeheight treeparent treeindex
3144
3145     set ix 0
3146     set treeindex() 0
3147     set lev 0
3148     set prefix {}
3149     set prefixend -1
3150     set prefendstack {}
3151     set htstack {}
3152     set ht 0
3153     set treecontents() {}
3154     $w conf -state normal
3155     foreach f $l {
3156         while {[string range $f 0 $prefixend] ne $prefix} {
3157             if {$lev <= $openlevs} {
3158                 $w mark set e:$treeindex($prefix) "end -1c"
3159                 $w mark gravity e:$treeindex($prefix) left
3160             }
3161             set treeheight($prefix) $ht
3162             incr ht [lindex $htstack end]
3163             set htstack [lreplace $htstack end end]
3164             set prefixend [lindex $prefendstack end]
3165             set prefendstack [lreplace $prefendstack end end]
3166             set prefix [string range $prefix 0 $prefixend]
3167             incr lev -1
3168         }
3169         set tail [string range $f [expr {$prefixend+1}] end]
3170         while {[set slash [string first "/" $tail]] >= 0} {
3171             lappend htstack $ht
3172             set ht 0
3173             lappend prefendstack $prefixend
3174             incr prefixend [expr {$slash + 1}]
3175             set d [string range $tail 0 $slash]
3176             lappend treecontents($prefix) $d
3177             set oldprefix $prefix
3178             append prefix $d
3179             set treecontents($prefix) {}
3180             set treeindex($prefix) [incr ix]
3181             set treeparent($prefix) $oldprefix
3182             set tail [string range $tail [expr {$slash+1}] end]
3183             if {$lev <= $openlevs} {
3184                 set ht 1
3185                 set treediropen($prefix) [expr {$lev < $openlevs}]
3186                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3187                 $w mark set d:$ix "end -1c"
3188                 $w mark gravity d:$ix left
3189                 set str "\n"
3190                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3191                 $w insert end $str
3192                 $w image create end -align center -image $bm -padx 1 \
3193                     -name a:$ix
3194                 $w insert end $d [highlight_tag $prefix]
3195                 $w mark set s:$ix "end -1c"
3196                 $w mark gravity s:$ix left
3197             }
3198             incr lev
3199         }
3200         if {$tail ne {}} {
3201             if {$lev <= $openlevs} {
3202                 incr ht
3203                 set str "\n"
3204                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3205                 $w insert end $str
3206                 $w insert end $tail [highlight_tag $f]
3207             }
3208             lappend treecontents($prefix) $tail
3209         }
3210     }
3211     while {$htstack ne {}} {
3212         set treeheight($prefix) $ht
3213         incr ht [lindex $htstack end]
3214         set htstack [lreplace $htstack end end]
3215         set prefixend [lindex $prefendstack end]
3216         set prefendstack [lreplace $prefendstack end end]
3217         set prefix [string range $prefix 0 $prefixend]
3218     }
3219     $w conf -state disabled
3220 }
3221
3222 proc linetoelt {l} {
3223     global treeheight treecontents
3224
3225     set y 2
3226     set prefix {}
3227     while {1} {
3228         foreach e $treecontents($prefix) {
3229             if {$y == $l} {
3230                 return "$prefix$e"
3231             }
3232             set n 1
3233             if {[string index $e end] eq "/"} {
3234                 set n $treeheight($prefix$e)
3235                 if {$y + $n > $l} {
3236                     append prefix $e
3237                     incr y
3238                     break
3239                 }
3240             }
3241             incr y $n
3242         }
3243     }
3244 }
3245
3246 proc highlight_tree {y prefix} {
3247     global treeheight treecontents cflist
3248
3249     foreach e $treecontents($prefix) {
3250         set path $prefix$e
3251         if {[highlight_tag $path] ne {}} {
3252             $cflist tag add bold $y.0 "$y.0 lineend"
3253         }
3254         incr y
3255         if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3256             set y [highlight_tree $y $path]
3257         }
3258     }
3259     return $y
3260 }
3261
3262 proc treeclosedir {w dir} {
3263     global treediropen treeheight treeparent treeindex
3264
3265     set ix $treeindex($dir)
3266     $w conf -state normal
3267     $w delete s:$ix e:$ix
3268     set treediropen($dir) 0
3269     $w image configure a:$ix -image tri-rt
3270     $w conf -state disabled
3271     set n [expr {1 - $treeheight($dir)}]
3272     while {$dir ne {}} {
3273         incr treeheight($dir) $n
3274         set dir $treeparent($dir)
3275     }
3276 }
3277
3278 proc treeopendir {w dir} {
3279     global treediropen treeheight treeparent treecontents treeindex
3280
3281     set ix $treeindex($dir)
3282     $w conf -state normal
3283     $w image configure a:$ix -image tri-dn
3284     $w mark set e:$ix s:$ix
3285     $w mark gravity e:$ix right
3286     set lev 0
3287     set str "\n"
3288     set n [llength $treecontents($dir)]
3289     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3290         incr lev
3291         append str "\t"
3292         incr treeheight($x) $n
3293     }
3294     foreach e $treecontents($dir) {
3295         set de $dir$e
3296         if {[string index $e end] eq "/"} {
3297             set iy $treeindex($de)
3298             $w mark set d:$iy e:$ix
3299             $w mark gravity d:$iy left
3300             $w insert e:$ix $str
3301             set treediropen($de) 0
3302             $w image create e:$ix -align center -image tri-rt -padx 1 \
3303                 -name a:$iy
3304             $w insert e:$ix $e [highlight_tag $de]
3305             $w mark set s:$iy e:$ix
3306             $w mark gravity s:$iy left
3307             set treeheight($de) 1
3308         } else {
3309             $w insert e:$ix $str
3310             $w insert e:$ix $e [highlight_tag $de]
3311         }
3312     }
3313     $w mark gravity e:$ix right
3314     $w conf -state disabled
3315     set treediropen($dir) 1
3316     set top [lindex [split [$w index @0,0] .] 0]
3317     set ht [$w cget -height]
3318     set l [lindex [split [$w index s:$ix] .] 0]
3319     if {$l < $top} {
3320         $w yview $l.0
3321     } elseif {$l + $n + 1 > $top + $ht} {
3322         set top [expr {$l + $n + 2 - $ht}]
3323         if {$l < $top} {
3324             set top $l
3325         }
3326         $w yview $top.0
3327     }
3328 }
3329
3330 proc treeclick {w x y} {
3331     global treediropen cmitmode ctext cflist cflist_top
3332
3333     if {$cmitmode ne "tree"} return
3334     if {![info exists cflist_top]} return
3335     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3336     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3337     $cflist tag add highlight $l.0 "$l.0 lineend"
3338     set cflist_top $l
3339     if {$l == 1} {
3340         $ctext yview 1.0
3341         return
3342     }
3343     set e [linetoelt $l]
3344     if {[string index $e end] ne "/"} {
3345         showfile $e
3346     } elseif {$treediropen($e)} {
3347         treeclosedir $w $e
3348     } else {
3349         treeopendir $w $e
3350     }
3351 }
3352
3353 proc setfilelist {id} {
3354     global treefilelist cflist jump_to_here
3355
3356     treeview $cflist $treefilelist($id) 0
3357     if {$jump_to_here ne {}} {
3358         set f [lindex $jump_to_here 0]
3359         if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3360             showfile $f
3361         }
3362     }
3363 }
3364
3365 image create bitmap tri-rt -background black -foreground blue -data {
3366     #define tri-rt_width 13
3367     #define tri-rt_height 13
3368     static unsigned char tri-rt_bits[] = {
3369        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3370        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3371        0x00, 0x00};
3372 } -maskdata {
3373     #define tri-rt-mask_width 13
3374     #define tri-rt-mask_height 13
3375     static unsigned char tri-rt-mask_bits[] = {
3376        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3377        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3378        0x08, 0x00};
3379 }
3380 image create bitmap tri-dn -background black -foreground blue -data {
3381     #define tri-dn_width 13
3382     #define tri-dn_height 13
3383     static unsigned char tri-dn_bits[] = {
3384        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3385        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3386        0x00, 0x00};
3387 } -maskdata {
3388     #define tri-dn-mask_width 13
3389     #define tri-dn-mask_height 13
3390     static unsigned char tri-dn-mask_bits[] = {
3391        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3392        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3393        0x00, 0x00};
3394 }
3395
3396 image create bitmap reficon-T -background black -foreground yellow -data {
3397     #define tagicon_width 13
3398     #define tagicon_height 9
3399     static unsigned char tagicon_bits[] = {
3400        0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3401        0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3402 } -maskdata {
3403     #define tagicon-mask_width 13
3404     #define tagicon-mask_height 9
3405     static unsigned char tagicon-mask_bits[] = {
3406        0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3407        0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3408 }
3409 set rectdata {
3410     #define headicon_width 13
3411     #define headicon_height 9
3412     static unsigned char headicon_bits[] = {
3413        0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3414        0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3415 }
3416 set rectmask {
3417     #define headicon-mask_width 13
3418     #define headicon-mask_height 9
3419     static unsigned char headicon-mask_bits[] = {
3420        0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3421        0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3422 }
3423 image create bitmap reficon-H -background black -foreground "#00ff00" \
3424     -data $rectdata -maskdata $rectmask
3425 image create bitmap reficon-R -background black -foreground "#ffddaa" \
3426     -data $rectdata -maskdata $rectmask
3427 image create bitmap reficon-o -background black -foreground "#ddddff" \
3428     -data $rectdata -maskdata $rectmask
3429
3430 proc init_flist {first} {
3431     global cflist cflist_top difffilestart
3432
3433     $cflist conf -state normal
3434     $cflist delete 0.0 end
3435     if {$first ne {}} {
3436         $cflist insert end $first
3437         set cflist_top 1
3438         $cflist tag add highlight 1.0 "1.0 lineend"
3439     } else {
3440         unset -nocomplain cflist_top
3441     }
3442     $cflist conf -state disabled
3443     set difffilestart {}
3444 }
3445
3446 proc highlight_tag {f} {
3447     global highlight_paths
3448
3449     foreach p $highlight_paths {
3450         if {[string match $p $f]} {
3451             return "bold"
3452         }
3453     }
3454     return {}
3455 }
3456
3457 proc highlight_filelist {} {
3458     global cmitmode cflist
3459
3460     $cflist conf -state normal
3461     if {$cmitmode ne "tree"} {
3462         set end [lindex [split [$cflist index end] .] 0]
3463         for {set l 2} {$l < $end} {incr l} {
3464             set line [$cflist get $l.0 "$l.0 lineend"]
3465             if {[highlight_tag $line] ne {}} {
3466                 $cflist tag add bold $l.0 "$l.0 lineend"
3467             }
3468         }
3469     } else {
3470         highlight_tree 2 {}
3471     }
3472     $cflist conf -state disabled
3473 }
3474
3475 proc unhighlight_filelist {} {
3476     global cflist
3477
3478     $cflist conf -state normal
3479     $cflist tag remove bold 1.0 end
3480     $cflist conf -state disabled
3481 }
3482
3483 proc add_flist {fl} {
3484     global cflist
3485
3486     $cflist conf -state normal
3487     foreach f $fl {
3488         $cflist insert end "\n"
3489         $cflist insert end $f [highlight_tag $f]
3490     }
3491     $cflist conf -state disabled
3492 }
3493
3494 proc sel_flist {w x y} {
3495     global ctext difffilestart cflist cflist_top cmitmode
3496
3497     if {$cmitmode eq "tree"} return
3498     if {![info exists cflist_top]} return
3499     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3500     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3501     $cflist tag add highlight $l.0 "$l.0 lineend"
3502     set cflist_top $l
3503     if {$l == 1} {
3504         $ctext yview 1.0
3505     } else {
3506         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3507     }
3508     suppress_highlighting_file_for_current_scrollpos
3509 }
3510
3511 proc pop_flist_menu {w X Y x y} {
3512     global ctext cflist cmitmode flist_menu flist_menu_file
3513     global treediffs diffids
3514
3515     stopfinding
3516     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3517     if {$l <= 1} return
3518     if {$cmitmode eq "tree"} {
3519         set e [linetoelt $l]
3520         if {[string index $e end] eq "/"} return
3521     } else {
3522         set e [lindex $treediffs($diffids) [expr {$l-2}]]
3523     }
3524     set flist_menu_file $e
3525     set xdiffstate "normal"
3526     if {$cmitmode eq "tree"} {
3527         set xdiffstate "disabled"
3528     }
3529     # Disable "External diff" item in tree mode
3530     $flist_menu entryconf 2 -state $xdiffstate
3531     tk_popup $flist_menu $X $Y
3532 }
3533
3534 proc find_ctext_fileinfo {line} {
3535     global ctext_file_names ctext_file_lines
3536
3537     set ok [bsearch $ctext_file_lines $line]
3538     set tline [lindex $ctext_file_lines $ok]
3539
3540     if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3541         return {}
3542     } else {
3543         return [list [lindex $ctext_file_names $ok] $tline]
3544     }
3545 }
3546
3547 proc pop_diff_menu {w X Y x y} {
3548     global ctext diff_menu flist_menu_file
3549     global diff_menu_txtpos diff_menu_line
3550     global diff_menu_filebase
3551
3552     set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3553     set diff_menu_line [lindex $diff_menu_txtpos 0]
3554     # don't pop up the menu on hunk-separator or file-separator lines
3555     if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3556         return
3557     }
3558     stopfinding
3559     set f [find_ctext_fileinfo $diff_menu_line]
3560     if {$f eq {}} return
3561     set flist_menu_file [lindex $f 0]
3562     set diff_menu_filebase [lindex $f 1]
3563     tk_popup $diff_menu $X $Y
3564 }
3565
3566 proc flist_hl {only} {
3567     global flist_menu_file findstring gdttype
3568
3569     set x [shellquote $flist_menu_file]
3570     if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3571         set findstring $x
3572     } else {
3573         append findstring " " $x
3574     }
3575     set gdttype [mc "touching paths:"]
3576 }
3577
3578 proc gitknewtmpdir {} {
3579     global diffnum gitktmpdir gitdir env
3580
3581     if {![info exists gitktmpdir]} {
3582         if {[info exists env(GITK_TMPDIR)]} {
3583             set tmpdir $env(GITK_TMPDIR)
3584         } elseif {[info exists env(TMPDIR)]} {
3585             set tmpdir $env(TMPDIR)
3586         } else {
3587             set tmpdir $gitdir
3588         }
3589         set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
3590         if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
3591             set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3592         }
3593         if {[catch {file mkdir $gitktmpdir} err]} {
3594             error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3595             unset gitktmpdir
3596             return {}
3597         }
3598         set diffnum 0
3599     }
3600     incr diffnum
3601     set diffdir [file join $gitktmpdir $diffnum]
3602     if {[catch {file mkdir $diffdir} err]} {
3603         error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3604         return {}
3605     }
3606     return $diffdir
3607 }
3608
3609 proc save_file_from_commit {filename output what} {
3610     global nullfile
3611
3612     if {[catch {exec git show $filename -- > $output} err]} {
3613         if {[string match "fatal: bad revision *" $err]} {
3614             return $nullfile
3615         }
3616         error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3617         return {}
3618     }
3619     return $output
3620 }
3621
3622 proc external_diff_get_one_file {diffid filename diffdir} {
3623     global nullid nullid2 nullfile
3624     global worktree
3625
3626     if {$diffid == $nullid} {
3627         set difffile [file join $worktree $filename]
3628         if {[file exists $difffile]} {
3629             return $difffile
3630         }
3631         return $nullfile
3632     }
3633     if {$diffid == $nullid2} {
3634         set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3635         return [save_file_from_commit :$filename $difffile index]
3636     }
3637     set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3638     return [save_file_from_commit $diffid:$filename $difffile \
3639                "revision $diffid"]
3640 }
3641
3642 proc external_diff {} {
3643     global nullid nullid2
3644     global flist_menu_file
3645     global diffids
3646     global extdifftool
3647
3648     if {[llength $diffids] == 1} {
3649         # no reference commit given
3650         set diffidto [lindex $diffids 0]
3651         if {$diffidto eq $nullid} {
3652             # diffing working copy with index
3653             set diffidfrom $nullid2
3654         } elseif {$diffidto eq $nullid2} {
3655             # diffing index with HEAD
3656             set diffidfrom "HEAD"
3657         } else {
3658             # use first parent commit
3659             global parentlist selectedline
3660             set diffidfrom [lindex $parentlist $selectedline 0]
3661         }
3662     } else {
3663         set diffidfrom [lindex $diffids 0]
3664         set diffidto [lindex $diffids 1]
3665     }
3666
3667     # make sure that several diffs wont collide
3668     set diffdir [gitknewtmpdir]
3669     if {$diffdir eq {}} return
3670
3671     # gather files to diff
3672     set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3673     set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3674
3675     if {$difffromfile ne {} && $difftofile ne {}} {
3676         set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3677         if {[catch {set fl [open |$cmd r]} err]} {
3678             file delete -force $diffdir
3679             error_popup "$extdifftool: [mc "command failed:"] $err"
3680         } else {
3681             fconfigure $fl -blocking 0
3682             filerun $fl [list delete_at_eof $fl $diffdir]
3683         }
3684     }
3685 }
3686
3687 proc find_hunk_blamespec {base line} {
3688     global ctext
3689
3690     # Find and parse the hunk header
3691     set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3692     if {$s_lix eq {}} return
3693
3694     set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3695     if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3696             s_line old_specs osz osz1 new_line nsz]} {
3697         return
3698     }
3699
3700     # base lines for the parents
3701     set base_lines [list $new_line]
3702     foreach old_spec [lrange [split $old_specs " "] 1 end] {
3703         if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3704                 old_spec old_line osz]} {
3705             return
3706         }
3707         lappend base_lines $old_line
3708     }
3709
3710     # Now scan the lines to determine offset within the hunk
3711     set max_parent [expr {[llength $base_lines]-2}]
3712     set dline 0
3713     set s_lno [lindex [split $s_lix "."] 0]
3714
3715     # Determine if the line is removed
3716     set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3717     if {[string match {[-+ ]*} $chunk]} {
3718         set removed_idx [string first "-" $chunk]
3719         # Choose a parent index
3720         if {$removed_idx >= 0} {
3721             set parent $removed_idx
3722         } else {
3723             set unchanged_idx [string first " " $chunk]
3724             if {$unchanged_idx >= 0} {
3725                 set parent $unchanged_idx
3726             } else {
3727                 # blame the current commit
3728                 set parent -1
3729             }
3730         }
3731         # then count other lines that belong to it
3732         for {set i $line} {[incr i -1] > $s_lno} {} {
3733             set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3734             # Determine if the line is removed
3735             set removed_idx [string first "-" $chunk]
3736             if {$parent >= 0} {
3737                 set code [string index $chunk $parent]
3738                 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3739                     incr dline
3740                 }
3741             } else {
3742                 if {$removed_idx < 0} {
3743                     incr dline
3744                 }
3745             }
3746         }
3747         incr parent
3748     } else {
3749         set parent 0
3750     }
3751
3752     incr dline [lindex $base_lines $parent]
3753     return [list $parent $dline]
3754 }
3755
3756 proc external_blame_diff {} {
3757     global currentid cmitmode
3758     global diff_menu_txtpos diff_menu_line
3759     global diff_menu_filebase flist_menu_file
3760
3761     if {$cmitmode eq "tree"} {
3762         set parent_idx 0
3763         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3764     } else {
3765         set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3766         if {$hinfo ne {}} {
3767             set parent_idx [lindex $hinfo 0]
3768             set line [lindex $hinfo 1]
3769         } else {
3770             set parent_idx 0
3771             set line 0
3772         }
3773     }
3774
3775     external_blame $parent_idx $line
3776 }
3777
3778 # Find the SHA1 ID of the blob for file $fname in the index
3779 # at stage 0 or 2
3780 proc index_sha1 {fname} {
3781     set f [open [list | git ls-files -s $fname] r]
3782     while {[gets $f line] >= 0} {
3783         set info [lindex [split $line "\t"] 0]
3784         set stage [lindex $info 2]
3785         if {$stage eq "0" || $stage eq "2"} {
3786             close $f
3787             return [lindex $info 1]
3788         }
3789     }
3790     close $f
3791     return {}
3792 }
3793
3794 # Turn an absolute path into one relative to the current directory
3795 proc make_relative {f} {
3796     if {[file pathtype $f] eq "relative"} {
3797         return $f
3798     }
3799     set elts [file split $f]
3800     set here [file split [pwd]]
3801     set ei 0
3802     set hi 0
3803     set res {}
3804     foreach d $here {
3805         if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3806             lappend res ".."
3807         } else {
3808             incr ei
3809         }
3810         incr hi
3811     }
3812     set elts [concat $res [lrange $elts $ei end]]
3813     return [eval file join $elts]
3814 }
3815
3816 proc external_blame {parent_idx {line {}}} {
3817     global flist_menu_file cdup
3818     global nullid nullid2
3819     global parentlist selectedline currentid
3820
3821     if {$parent_idx > 0} {
3822         set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3823     } else {
3824         set base_commit $currentid
3825     }
3826
3827     if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3828         error_popup [mc "No such commit"]
3829         return
3830     }
3831
3832     set cmdline [list git gui blame]
3833     if {$line ne {} && $line > 1} {
3834         lappend cmdline "--line=$line"
3835     }
3836     set f [file join $cdup $flist_menu_file]
3837     # Unfortunately it seems git gui blame doesn't like
3838     # being given an absolute path...
3839     set f [make_relative $f]
3840     lappend cmdline $base_commit $f
3841     if {[catch {eval exec $cmdline &} err]} {
3842         error_popup "[mc "git gui blame: command failed:"] $err"
3843     }
3844 }
3845
3846 proc show_line_source {} {
3847     global cmitmode currentid parents curview blamestuff blameinst
3848     global diff_menu_line diff_menu_filebase flist_menu_file
3849     global nullid nullid2 gitdir cdup
3850
3851     set from_index {}
3852     if {$cmitmode eq "tree"} {
3853         set id $currentid
3854         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3855     } else {
3856         set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3857         if {$h eq {}} return
3858         set pi [lindex $h 0]
3859         if {$pi == 0} {
3860             mark_ctext_line $diff_menu_line
3861             return
3862         }
3863         incr pi -1
3864         if {$currentid eq $nullid} {
3865             if {$pi > 0} {
3866                 # must be a merge in progress...
3867                 if {[catch {
3868                     # get the last line from .git/MERGE_HEAD
3869                     set f [open [file join $gitdir MERGE_HEAD] r]
3870                     set id [lindex [split [read $f] "\n"] end-1]
3871                     close $f
3872                 } err]} {
3873                     error_popup [mc "Couldn't read merge head: %s" $err]
3874                     return
3875                 }
3876             } elseif {$parents($curview,$currentid) eq $nullid2} {
3877                 # need to do the blame from the index
3878                 if {[catch {
3879                     set from_index [index_sha1 $flist_menu_file]
3880                 } err]} {
3881                     error_popup [mc "Error reading index: %s" $err]
3882                     return
3883                 }
3884             } else {
3885                 set id $parents($curview,$currentid)
3886             }
3887         } else {
3888             set id [lindex $parents($curview,$currentid) $pi]
3889         }
3890         set line [lindex $h 1]
3891     }
3892     set blameargs {}
3893     if {$from_index ne {}} {
3894         lappend blameargs | git cat-file blob $from_index
3895     }
3896     lappend blameargs | git blame -p -L$line,+1
3897     if {$from_index ne {}} {
3898         lappend blameargs --contents -
3899     } else {
3900         lappend blameargs $id
3901     }
3902     lappend blameargs -- [file join $cdup $flist_menu_file]
3903     if {[catch {
3904         set f [open $blameargs r]
3905     } err]} {
3906         error_popup [mc "Couldn't start git blame: %s" $err]
3907         return
3908     }
3909     nowbusy blaming [mc "Searching"]
3910     fconfigure $f -blocking 0
3911     set i [reg_instance $f]
3912     set blamestuff($i) {}
3913     set blameinst $i
3914     filerun $f [list read_line_source $f $i]
3915 }
3916
3917 proc stopblaming {} {
3918     global blameinst
3919
3920     if {[info exists blameinst]} {
3921         stop_instance $blameinst
3922         unset blameinst
3923         notbusy blaming
3924     }
3925 }
3926
3927 proc read_line_source {fd inst} {
3928     global blamestuff curview commfd blameinst nullid nullid2
3929
3930     while {[gets $fd line] >= 0} {
3931         lappend blamestuff($inst) $line
3932     }
3933     if {![eof $fd]} {
3934         return 1
3935     }
3936     unset commfd($inst)
3937     unset blameinst
3938     notbusy blaming
3939     fconfigure $fd -blocking 1
3940     if {[catch {close $fd} err]} {
3941         error_popup [mc "Error running git blame: %s" $err]
3942         return 0
3943     }
3944
3945     set fname {}
3946     set line [split [lindex $blamestuff($inst) 0] " "]
3947     set id [lindex $line 0]
3948     set lnum [lindex $line 1]
3949     if {[string length $id] == 40 && [string is xdigit $id] &&
3950         [string is digit -strict $lnum]} {
3951         # look for "filename" line
3952         foreach l $blamestuff($inst) {
3953             if {[string match "filename *" $l]} {
3954                 set fname [string range $l 9 end]
3955                 break
3956             }
3957         }
3958     }
3959     if {$fname ne {}} {
3960         # all looks good, select it
3961         if {$id eq $nullid} {
3962             # blame uses all-zeroes to mean not committed,
3963             # which would mean a change in the index
3964             set id $nullid2
3965         }
3966         if {[commitinview $id $curview]} {
3967             selectline [rowofcommit $id] 1 [list $fname $lnum] 1
3968         } else {
3969             error_popup [mc "That line comes from commit %s, \
3970                              which is not in this view" [shortids $id]]
3971         }
3972     } else {
3973         puts "oops couldn't parse git blame output"
3974     }
3975     return 0
3976 }
3977
3978 # delete $dir when we see eof on $f (presumably because the child has exited)
3979 proc delete_at_eof {f dir} {
3980     while {[gets $f line] >= 0} {}
3981     if {[eof $f]} {
3982         if {[catch {close $f} err]} {
3983             error_popup "[mc "External diff viewer failed:"] $err"
3984         }
3985         file delete -force $dir
3986         return 0
3987     }
3988     return 1
3989 }
3990
3991 # Functions for adding and removing shell-type quoting
3992
3993 proc shellquote {str} {
3994     if {![string match "*\['\"\\ \t]*" $str]} {
3995         return $str
3996     }
3997     if {![string match "*\['\"\\]*" $str]} {
3998         return "\"$str\""
3999     }
4000     if {![string match "*'*" $str]} {
4001         return "'$str'"
4002     }
4003     return "\"[string map {\" \\\" \\ \\\\} $str]\""
4004 }
4005
4006 proc shellarglist {l} {
4007     set str {}
4008     foreach a $l {
4009         if {$str ne {}} {
4010             append str " "
4011         }
4012         append str [shellquote $a]
4013     }
4014     return $str
4015 }
4016
4017 proc shelldequote {str} {
4018     set ret {}
4019     set used -1
4020     while {1} {
4021         incr used
4022         if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
4023             append ret [string range $str $used end]
4024             set used [string length $str]
4025             break
4026         }
4027         set first [lindex $first 0]
4028         set ch [string index $str $first]
4029         if {$first > $used} {
4030             append ret [string range $str $used [expr {$first - 1}]]
4031             set used $first
4032         }
4033         if {$ch eq " " || $ch eq "\t"} break
4034         incr used
4035         if {$ch eq "'"} {
4036             set first [string first "'" $str $used]
4037             if {$first < 0} {
4038                 error "unmatched single-quote"
4039             }
4040             append ret [string range $str $used [expr {$first - 1}]]
4041             set used $first
4042             continue
4043         }
4044         if {$ch eq "\\"} {
4045             if {$used >= [string length $str]} {
4046                 error "trailing backslash"
4047             }
4048             append ret [string index $str $used]
4049             continue
4050         }
4051         # here ch == "\""
4052         while {1} {
4053             if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
4054                 error "unmatched double-quote"
4055             }
4056             set first [lindex $first 0]
4057             set ch [string index $str $first]
4058             if {$first > $used} {
4059                 append ret [string range $str $used [expr {$first - 1}]]
4060                 set used $first
4061             }
4062             if {$ch eq "\""} break
4063             incr used
4064             append ret [string index $str $used]
4065             incr used
4066         }
4067     }
4068     return [list $used $ret]
4069 }
4070
4071 proc shellsplit {str} {
4072     set l {}
4073     while {1} {
4074         set str [string trimleft $str]
4075         if {$str eq {}} break
4076         set dq [shelldequote $str]
4077         set n [lindex $dq 0]
4078         set word [lindex $dq 1]
4079         set str [string range $str $n end]
4080         lappend l $word
4081     }
4082     return $l
4083 }
4084
4085 proc set_window_title {} {
4086     global appname curview viewname vrevs
4087     set rev [mc "All files"]
4088     if {$curview ne 0} {
4089         if {$viewname($curview) eq [mc "Command line"]} {
4090             set rev [string map {"--gitk-symmetric-diff-marker" "--merge"} $vrevs($curview)]
4091         } else {
4092             set rev $viewname($curview)
4093         }
4094     }
4095     wm title . "[reponame]: $rev - $appname"
4096 }
4097
4098 # Code to implement multiple views
4099
4100 proc newview {ishighlight} {
4101     global nextviewnum newviewname newishighlight
4102     global revtreeargs viewargscmd newviewopts curview
4103
4104     set newishighlight $ishighlight
4105     set top .gitkview
4106     if {[winfo exists $top]} {
4107         raise $top
4108         return
4109     }
4110     decode_view_opts $nextviewnum $revtreeargs
4111     set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
4112     set newviewopts($nextviewnum,perm) 0
4113     set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
4114     vieweditor $top $nextviewnum [mc "Gitk view definition"]
4115 }
4116
4117 set known_view_options {
4118     {perm      b    .  {}               {mc "Remember this view"}}
4119     {reflabel  l    +  {}               {mc "References (space separated list):"}}
4120     {refs      t15  .. {}               {mc "Branches & tags:"}}
4121     {allrefs   b    *. "--all"          {mc "All refs"}}
4122     {branches  b    .  "--branches"     {mc "All (local) branches"}}
4123     {tags      b    .  "--tags"         {mc "All tags"}}
4124     {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
4125     {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
4126     {author    t15  .. "--author=*"     {mc "Author:"}}
4127     {committer t15  .  "--committer=*"  {mc "Committer:"}}
4128     {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
4129     {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
4130     {igrep     b    .. "--invert-grep"  {mc "Matches no Commit Info criteria"}}
4131     {changes_l l    +  {}               {mc "Changes to Files:"}}
4132     {pickaxe_s r0   .  {}               {mc "Fixed String"}}
4133     {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
4134     {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
4135     {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
4136     {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
4137     {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
4138     {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
4139     {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
4140     {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
4141     {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
4142     {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
4143     {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
4144     {first     b    .  "--first-parent" {mc "Limit to first parent"}}
4145     {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
4146     {args      t50  *. {}               {mc "Additional arguments to git log:"}}
4147     {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
4148     {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
4149     }
4150
4151 # Convert $newviewopts($n, ...) into args for git log.
4152 proc encode_view_opts {n} {
4153     global known_view_options newviewopts
4154
4155     set rargs [list]
4156     foreach opt $known_view_options {
4157         set patterns [lindex $opt 3]
4158         if {$patterns eq {}} continue
4159         set pattern [lindex $patterns 0]
4160
4161         if {[lindex $opt 1] eq "b"} {
4162             set val $newviewopts($n,[lindex $opt 0])
4163             if {$val} {
4164                 lappend rargs $pattern
4165             }
4166         } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4167             regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4168             set val $newviewopts($n,$button_id)
4169             if {$val eq $value} {
4170                 lappend rargs $pattern
4171             }
4172         } else {
4173             set val $newviewopts($n,[lindex $opt 0])
4174             set val [string trim $val]
4175             if {$val ne {}} {
4176                 set pfix [string range $pattern 0 end-1]
4177                 lappend rargs $pfix$val
4178             }
4179         }
4180     }
4181     set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4182     return [concat $rargs [shellsplit $newviewopts($n,args)]]
4183 }
4184
4185 # Fill $newviewopts($n, ...) based on args for git log.
4186 proc decode_view_opts {n view_args} {
4187     global known_view_options newviewopts
4188
4189     foreach opt $known_view_options {
4190         set id [lindex $opt 0]
4191         if {[lindex $opt 1] eq "b"} {
4192             # Checkboxes
4193             set val 0
4194         } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4195             # Radiobuttons
4196             regexp {^(.*_)} $id uselessvar id
4197             set val 0
4198         } else {
4199             # Text fields
4200             set val {}
4201         }
4202         set newviewopts($n,$id) $val
4203     }
4204     set oargs [list]
4205     set refargs [list]
4206     foreach arg $view_args {
4207         if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4208             && ![info exists found(limit)]} {
4209             set newviewopts($n,limit) $cnt
4210             set found(limit) 1
4211             continue
4212         }
4213         catch { unset val }
4214         foreach opt $known_view_options {
4215             set id [lindex $opt 0]
4216             if {[info exists found($id)]} continue
4217             foreach pattern [lindex $opt 3] {
4218                 if {![string match $pattern $arg]} continue
4219                 if {[lindex $opt 1] eq "b"} {
4220                     # Check buttons
4221                     set val 1
4222                 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4223                     # Radio buttons
4224                     regexp {^(.*_)} $id uselessvar id
4225                     set val $num
4226                 } else {
4227                     # Text input fields
4228                     set size [string length $pattern]
4229                     set val [string range $arg [expr {$size-1}] end]
4230                 }
4231                 set newviewopts($n,$id) $val
4232                 set found($id) 1
4233                 break
4234             }
4235             if {[info exists val]} break
4236         }
4237         if {[info exists val]} continue
4238         if {[regexp {^-} $arg]} {
4239             lappend oargs $arg
4240         } else {
4241             lappend refargs $arg
4242         }
4243     }
4244     set newviewopts($n,refs) [shellarglist $refargs]
4245     set newviewopts($n,args) [shellarglist $oargs]
4246 }
4247
4248 proc edit_or_newview {} {
4249     global curview
4250
4251     if {$curview > 0} {
4252         editview
4253     } else {
4254         newview 0
4255     }
4256 }
4257
4258 proc editview {} {
4259     global curview
4260     global viewname viewperm newviewname newviewopts
4261     global viewargs viewargscmd
4262
4263     set top .gitkvedit-$curview
4264     if {[winfo exists $top]} {
4265         raise $top
4266         return
4267     }
4268     decode_view_opts $curview $viewargs($curview)
4269     set newviewname($curview)      $viewname($curview)
4270     set newviewopts($curview,perm) $viewperm($curview)
4271     set newviewopts($curview,cmd)  $viewargscmd($curview)
4272     vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4273 }
4274
4275 proc vieweditor {top n title} {
4276     global newviewname newviewopts viewfiles bgcolor
4277     global known_view_options NS
4278
4279     ttk_toplevel $top
4280     wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4281     make_transient $top .
4282
4283     # View name
4284     ${NS}::frame $top.nfr
4285     ${NS}::label $top.nl -text [mc "View Name"]
4286     ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4287     pack $top.nfr -in $top -fill x -pady 5 -padx 3
4288     pack $top.nl -in $top.nfr -side left -padx {0 5}
4289     pack $top.name -in $top.nfr -side left -padx {0 25}
4290
4291     # View options
4292     set cframe $top.nfr
4293     set cexpand 0
4294     set cnt 0
4295     foreach opt $known_view_options {
4296         set id [lindex $opt 0]
4297         set type [lindex $opt 1]
4298         set flags [lindex $opt 2]
4299         set title [eval [lindex $opt 4]]
4300         set lxpad 0
4301
4302         if {$flags eq "+" || $flags eq "*"} {
4303             set cframe $top.fr$cnt
4304             incr cnt
4305             ${NS}::frame $cframe
4306             pack $cframe -in $top -fill x -pady 3 -padx 3
4307             set cexpand [expr {$flags eq "*"}]
4308         } elseif {$flags eq ".." || $flags eq "*."} {
4309             set cframe $top.fr$cnt
4310             incr cnt
4311             ${NS}::frame $cframe
4312             pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4313             set cexpand [expr {$flags eq "*."}]
4314         } else {
4315             set lxpad 5
4316         }
4317
4318         if {$type eq "l"} {
4319             ${NS}::label $cframe.l_$id -text $title
4320             pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4321         } elseif {$type eq "b"} {
4322             ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4323             pack $cframe.c_$id -in $cframe -side left \
4324                 -padx [list $lxpad 0] -expand $cexpand -anchor w
4325         } elseif {[regexp {^r(\d+)$} $type type sz]} {
4326             regexp {^(.*_)} $id uselessvar button_id
4327             ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4328             pack $cframe.c_$id -in $cframe -side left \
4329                 -padx [list $lxpad 0] -expand $cexpand -anchor w
4330         } elseif {[regexp {^t(\d+)$} $type type sz]} {
4331             ${NS}::label $cframe.l_$id -text $title
4332             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4333                 -textvariable newviewopts($n,$id)
4334             pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4335             pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4336         } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4337             ${NS}::label $cframe.l_$id -text $title
4338             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4339                 -textvariable newviewopts($n,$id)
4340             pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4341             pack $cframe.e_$id -in $cframe -side top -fill x
4342         } elseif {$type eq "path"} {
4343             ${NS}::label $top.l -text $title
4344             pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4345             text $top.t -width 40 -height 5 -background $bgcolor
4346             if {[info exists viewfiles($n)]} {
4347                 foreach f $viewfiles($n) {
4348                     $top.t insert end $f
4349                     $top.t insert end "\n"
4350                 }
4351                 $top.t delete {end - 1c} end
4352                 $top.t mark set insert 0.0
4353             }
4354             pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4355         }
4356     }
4357
4358     ${NS}::frame $top.buts
4359     ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4360     ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4361     ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4362     bind $top <Control-Return> [list newviewok $top $n]
4363     bind $top <F5> [list newviewok $top $n 1]
4364     bind $top <Escape> [list destroy $top]
4365     grid $top.buts.ok $top.buts.apply $top.buts.can
4366     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4367     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4368     grid columnconfigure $top.buts 2 -weight 1 -uniform a
4369     pack $top.buts -in $top -side top -fill x
4370     focus $top.t
4371 }
4372
4373 proc doviewmenu {m first cmd op argv} {
4374     set nmenu [$m index end]
4375     for {set i $first} {$i <= $nmenu} {incr i} {
4376         if {[$m entrycget $i -command] eq $cmd} {
4377             eval $m $op $i $argv
4378             break
4379         }
4380     }
4381 }
4382
4383 proc allviewmenus {n op args} {
4384     # global viewhlmenu
4385
4386     doviewmenu .bar.view 5 [list showview $n] $op $args
4387     # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4388 }
4389
4390 proc newviewok {top n {apply 0}} {
4391     global nextviewnum newviewperm newviewname newishighlight
4392     global viewname viewfiles viewperm viewchanged selectedview curview
4393     global viewargs viewargscmd newviewopts viewhlmenu
4394
4395     if {[catch {
4396         set newargs [encode_view_opts $n]
4397     } err]} {
4398         error_popup "[mc "Error in commit selection arguments:"] $err" $top
4399         return
4400     }
4401     set files {}
4402     foreach f [split [$top.t get 0.0 end] "\n"] {
4403         set ft [string trim $f]
4404         if {$ft ne {}} {
4405             lappend files $ft
4406         }
4407     }
4408     if {![info exists viewfiles($n)]} {
4409         # creating a new view
4410         incr nextviewnum
4411         set viewname($n) $newviewname($n)
4412         set viewperm($n) $newviewopts($n,perm)
4413         set viewchanged($n) 1
4414         set viewfiles($n) $files
4415         set viewargs($n) $newargs
4416         set viewargscmd($n) $newviewopts($n,cmd)
4417         addviewmenu $n
4418         if {!$newishighlight} {
4419             run showview $n
4420         } else {
4421             run addvhighlight $n
4422         }
4423     } else {
4424         # editing an existing view
4425         set viewperm($n) $newviewopts($n,perm)
4426         set viewchanged($n) 1
4427         if {$newviewname($n) ne $viewname($n)} {
4428             set viewname($n) $newviewname($n)
4429             doviewmenu .bar.view 5 [list showview $n] \
4430                 entryconf [list -label $viewname($n)]
4431             # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4432                 # entryconf [list -label $viewname($n) -value $viewname($n)]
4433         }
4434         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4435                 $newviewopts($n,cmd) ne $viewargscmd($n)} {
4436             set viewfiles($n) $files
4437             set viewargs($n) $newargs
4438             set viewargscmd($n) $newviewopts($n,cmd)
4439             if {$curview == $n} {
4440                 run reloadcommits
4441             }
4442         }
4443     }
4444     if {$apply} return
4445     catch {destroy $top}
4446 }
4447
4448 proc delview {} {
4449     global curview viewperm hlview selectedhlview viewchanged
4450
4451     if {$curview == 0} return
4452     if {[info exists hlview] && $hlview == $curview} {
4453         set selectedhlview [mc "None"]
4454         unset hlview
4455     }
4456     allviewmenus $curview delete
4457     set viewperm($curview) 0
4458     set viewchanged($curview) 1
4459     showview 0
4460 }
4461
4462 proc addviewmenu {n} {
4463     global viewname viewhlmenu
4464
4465     .bar.view add radiobutton -label $viewname($n) \
4466         -command [list showview $n] -variable selectedview -value $n
4467     #$viewhlmenu add radiobutton -label $viewname($n) \
4468     #   -command [list addvhighlight $n] -variable selectedhlview
4469 }
4470
4471 proc showview {n} {
4472     global curview cached_commitrow ordertok
4473     global displayorder parentlist rowidlist rowisopt rowfinal
4474     global colormap rowtextx nextcolor canvxmax
4475     global numcommits viewcomplete
4476     global selectedline currentid canv canvy0
4477     global treediffs
4478     global pending_select mainheadid
4479     global commitidx
4480     global selectedview
4481     global hlview selectedhlview commitinterest
4482
4483     if {$n == $curview} return
4484     set selid {}
4485     set ymax [lindex [$canv cget -scrollregion] 3]
4486     set span [$canv yview]
4487     set ytop [expr {[lindex $span 0] * $ymax}]
4488     set ybot [expr {[lindex $span 1] * $ymax}]
4489     set yscreen [expr {($ybot - $ytop) / 2}]
4490     if {$selectedline ne {}} {
4491         set selid $currentid
4492         set y [yc $selectedline]
4493         if {$ytop < $y && $y < $ybot} {
4494             set yscreen [expr {$y - $ytop}]
4495         }
4496     } elseif {[info exists pending_select]} {
4497         set selid $pending_select
4498         unset pending_select
4499     }
4500     unselectline
4501     normalline
4502     unset -nocomplain treediffs
4503     clear_display
4504     if {[info exists hlview] && $hlview == $n} {
4505         unset hlview
4506         set selectedhlview [mc "None"]
4507     }
4508     unset -nocomplain commitinterest
4509     unset -nocomplain cached_commitrow
4510     unset -nocomplain ordertok
4511
4512     set curview $n
4513     set selectedview $n
4514     .bar.view entryconf [mca "&Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4515     .bar.view entryconf [mca "&Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4516
4517     run refill_reflist
4518     if {![info exists viewcomplete($n)]} {
4519         getcommits $selid
4520         return
4521     }
4522
4523     set displayorder {}
4524     set parentlist {}
4525     set rowidlist {}
4526     set rowisopt {}
4527     set rowfinal {}
4528     set numcommits $commitidx($n)
4529
4530     unset -nocomplain colormap
4531     unset -nocomplain rowtextx
4532     set nextcolor 0
4533     set canvxmax [$canv cget -width]
4534     set curview $n
4535     set row 0
4536     setcanvscroll
4537     set yf 0
4538     set row {}
4539     if {$selid ne {} && [commitinview $selid $n]} {
4540         set row [rowofcommit $selid]
4541         # try to get the selected row in the same position on the screen
4542         set ymax [lindex [$canv cget -scrollregion] 3]
4543         set ytop [expr {[yc $row] - $yscreen}]
4544         if {$ytop < 0} {
4545             set ytop 0
4546         }
4547         set yf [expr {$ytop * 1.0 / $ymax}]
4548     }
4549     allcanvs yview moveto $yf
4550     drawvisible
4551     if {$row ne {}} {
4552         selectline $row 0
4553     } elseif {!$viewcomplete($n)} {
4554         reset_pending_select $selid
4555     } else {
4556         reset_pending_select {}
4557
4558         if {[commitinview $pending_select $curview]} {
4559             selectline [rowofcommit $pending_select] 1
4560         } else {
4561             set row [first_real_row]
4562             if {$row < $numcommits} {
4563                 selectline $row 0
4564             }
4565         }
4566     }
4567     if {!$viewcomplete($n)} {
4568         if {$numcommits == 0} {
4569             show_status [mc "Reading commits..."]
4570         }
4571     } elseif {$numcommits == 0} {
4572         show_status [mc "No commits selected"]
4573     }
4574     set_window_title
4575 }
4576
4577 # Stuff relating to the highlighting facility
4578
4579 proc ishighlighted {id} {
4580     global vhighlights fhighlights nhighlights rhighlights
4581
4582     if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4583         return $nhighlights($id)
4584     }
4585     if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4586         return $vhighlights($id)
4587     }
4588     if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4589         return $fhighlights($id)
4590     }
4591     if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4592         return $rhighlights($id)
4593     }
4594     return 0
4595 }
4596
4597 proc bolden {id font} {
4598     global canv linehtag currentid boldids need_redisplay markedid
4599
4600     # need_redisplay = 1 means the display is stale and about to be redrawn
4601     if {$need_redisplay} return
4602     lappend boldids $id
4603     $canv itemconf $linehtag($id) -font $font
4604     if {[info exists currentid] && $id eq $currentid} {
4605         $canv delete secsel
4606         set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4607                    -outline {{}} -tags secsel \
4608                    -fill [$canv cget -selectbackground]]
4609         $canv lower $t
4610     }
4611     if {[info exists markedid] && $id eq $markedid} {
4612         make_idmark $id
4613     }
4614 }
4615
4616 proc bolden_name {id font} {
4617     global canv2 linentag currentid boldnameids need_redisplay
4618
4619     if {$need_redisplay} return
4620     lappend boldnameids $id
4621     $canv2 itemconf $linentag($id) -font $font
4622     if {[info exists currentid] && $id eq $currentid} {
4623         $canv2 delete secsel
4624         set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4625                    -outline {{}} -tags secsel \
4626                    -fill [$canv2 cget -selectbackground]]
4627         $canv2 lower $t
4628     }
4629 }
4630
4631 proc unbolden {} {
4632     global boldids
4633
4634     set stillbold {}
4635     foreach id $boldids {
4636         if {![ishighlighted $id]} {
4637             bolden $id mainfont
4638         } else {
4639             lappend stillbold $id
4640         }
4641     }
4642     set boldids $stillbold
4643 }
4644
4645 proc addvhighlight {n} {
4646     global hlview viewcomplete curview vhl_done commitidx
4647
4648     if {[info exists hlview]} {
4649         delvhighlight
4650     }
4651     set hlview $n
4652     if {$n != $curview && ![info exists viewcomplete($n)]} {
4653         start_rev_list $n
4654     }
4655     set vhl_done $commitidx($hlview)
4656     if {$vhl_done > 0} {
4657         drawvisible
4658     }
4659 }
4660
4661 proc delvhighlight {} {
4662     global hlview vhighlights
4663
4664     if {![info exists hlview]} return
4665     unset hlview
4666     unset -nocomplain vhighlights
4667     unbolden
4668 }
4669
4670 proc vhighlightmore {} {
4671     global hlview vhl_done commitidx vhighlights curview
4672
4673     set max $commitidx($hlview)
4674     set vr [visiblerows]
4675     set r0 [lindex $vr 0]
4676     set r1 [lindex $vr 1]
4677     for {set i $vhl_done} {$i < $max} {incr i} {
4678         set id [commitonrow $i $hlview]
4679         if {[commitinview $id $curview]} {
4680             set row [rowofcommit $id]
4681             if {$r0 <= $row && $row <= $r1} {
4682                 if {![highlighted $row]} {
4683                     bolden $id mainfontbold
4684                 }
4685                 set vhighlights($id) 1
4686             }
4687         }
4688     }
4689     set vhl_done $max
4690     return 0
4691 }
4692
4693 proc askvhighlight {row id} {
4694     global hlview vhighlights iddrawn
4695
4696     if {[commitinview $id $hlview]} {
4697         if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4698             bolden $id mainfontbold
4699         }
4700         set vhighlights($id) 1
4701     } else {
4702         set vhighlights($id) 0
4703     }
4704 }
4705
4706 proc hfiles_change {} {
4707     global highlight_files filehighlight fhighlights fh_serial
4708     global highlight_paths
4709
4710     if {[info exists filehighlight]} {
4711         # delete previous highlights
4712         catch {close $filehighlight}
4713         unset filehighlight
4714         unset -nocomplain fhighlights
4715         unbolden
4716         unhighlight_filelist
4717     }
4718     set highlight_paths {}
4719     after cancel do_file_hl $fh_serial
4720     incr fh_serial
4721     if {$highlight_files ne {}} {
4722         after 300 do_file_hl $fh_serial
4723     }
4724 }
4725
4726 proc gdttype_change {name ix op} {
4727     global gdttype highlight_files findstring findpattern
4728
4729     stopfinding
4730     if {$findstring ne {}} {
4731         if {$gdttype eq [mc "containing:"]} {
4732             if {$highlight_files ne {}} {
4733                 set highlight_files {}
4734                 hfiles_change
4735             }
4736             findcom_change
4737         } else {
4738             if {$findpattern ne {}} {
4739                 set findpattern {}
4740                 findcom_change
4741             }
4742             set highlight_files $findstring
4743             hfiles_change
4744         }
4745         drawvisible
4746     }
4747     # enable/disable findtype/findloc menus too
4748 }
4749
4750 proc find_change {name ix op} {
4751     global gdttype findstring highlight_files
4752
4753     stopfinding
4754     if {$gdttype eq [mc "containing:"]} {
4755         findcom_change
4756     } else {
4757         if {$highlight_files ne $findstring} {
4758             set highlight_files $findstring
4759             hfiles_change
4760         }
4761     }
4762     drawvisible
4763 }
4764
4765 proc findcom_change args {
4766     global nhighlights boldnameids
4767     global findpattern findtype findstring gdttype
4768
4769     stopfinding
4770     # delete previous highlights, if any
4771     foreach id $boldnameids {
4772         bolden_name $id mainfont
4773     }
4774     set boldnameids {}
4775     unset -nocomplain nhighlights
4776     unbolden
4777     unmarkmatches
4778     if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4779         set findpattern {}
4780     } elseif {$findtype eq [mc "Regexp"]} {
4781         set findpattern $findstring
4782     } else {
4783         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4784                    $findstring]
4785         set findpattern "*$e*"
4786     }
4787 }
4788
4789 proc makepatterns {l} {
4790     set ret {}
4791     foreach e $l {
4792         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4793         if {[string index $ee end] eq "/"} {
4794             lappend ret "$ee*"
4795         } else {
4796             lappend ret $ee
4797             lappend ret "$ee/*"
4798         }
4799     }
4800     return $ret
4801 }
4802
4803 proc do_file_hl {serial} {
4804     global highlight_files filehighlight highlight_paths gdttype fhl_list
4805     global cdup findtype
4806
4807     if {$gdttype eq [mc "touching paths:"]} {
4808         # If "exact" match then convert backslashes to forward slashes.
4809         # Most useful to support Windows-flavoured file paths.
4810         if {$findtype eq [mc "Exact"]} {
4811             set highlight_files [string map {"\\" "/"} $highlight_files]
4812         }
4813         if {[catch {set paths [shellsplit $highlight_files]}]} return
4814         set highlight_paths [makepatterns $paths]
4815         highlight_filelist
4816         set relative_paths {}
4817         foreach path $paths {
4818             lappend relative_paths [file join $cdup $path]
4819         }
4820         set gdtargs [concat -- $relative_paths]
4821     } elseif {$gdttype eq [mc "adding/removing string:"]} {
4822         set gdtargs [list "-S$highlight_files"]
4823     } elseif {$gdttype eq [mc "changing lines matching:"]} {
4824         set gdtargs [list "-G$highlight_files"]
4825     } else {
4826         # must be "containing:", i.e. we're searching commit info
4827         return
4828     }
4829     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4830     set filehighlight [open $cmd r+]
4831     fconfigure $filehighlight -blocking 0
4832     filerun $filehighlight readfhighlight
4833     set fhl_list {}
4834     drawvisible
4835     flushhighlights
4836 }
4837
4838 proc flushhighlights {} {
4839     global filehighlight fhl_list
4840
4841     if {[info exists filehighlight]} {
4842         lappend fhl_list {}
4843         puts $filehighlight ""
4844         flush $filehighlight
4845     }
4846 }
4847
4848 proc askfilehighlight {row id} {
4849     global filehighlight fhighlights fhl_list
4850
4851     lappend fhl_list $id
4852     set fhighlights($id) -1
4853     puts $filehighlight $id
4854 }
4855
4856 proc readfhighlight {} {
4857     global filehighlight fhighlights curview iddrawn
4858     global fhl_list find_dirn
4859
4860     if {![info exists filehighlight]} {
4861         return 0
4862     }
4863     set nr 0
4864     while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4865         set line [string trim $line]
4866         set i [lsearch -exact $fhl_list $line]
4867         if {$i < 0} continue
4868         for {set j 0} {$j < $i} {incr j} {
4869             set id [lindex $fhl_list $j]
4870             set fhighlights($id) 0
4871         }
4872         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4873         if {$line eq {}} continue
4874         if {![commitinview $line $curview]} continue
4875         if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4876             bolden $line mainfontbold
4877         }
4878         set fhighlights($line) 1
4879     }
4880     if {[eof $filehighlight]} {
4881         # strange...
4882         puts "oops, git diff-tree died"
4883         catch {close $filehighlight}
4884         unset filehighlight
4885         return 0
4886     }
4887     if {[info exists find_dirn]} {
4888         run findmore
4889     }
4890     return 1
4891 }
4892
4893 proc doesmatch {f} {
4894     global findtype findpattern
4895
4896     if {$findtype eq [mc "Regexp"]} {
4897         return [regexp $findpattern $f]
4898     } elseif {$findtype eq [mc "IgnCase"]} {
4899         return [string match -nocase $findpattern $f]
4900     } else {
4901         return [string match $findpattern $f]
4902     }
4903 }
4904
4905 proc askfindhighlight {row id} {
4906     global nhighlights commitinfo iddrawn
4907     global findloc
4908     global markingmatches
4909
4910     if {![info exists commitinfo($id)]} {
4911         getcommit $id
4912     }
4913     set info $commitinfo($id)
4914     set isbold 0
4915     set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
4916     foreach f $info ty $fldtypes {
4917         if {$ty eq ""} continue
4918         if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4919             [doesmatch $f]} {
4920             if {$ty eq [mc "Author"]} {
4921                 set isbold 2
4922                 break
4923             }
4924             set isbold 1
4925         }
4926     }
4927     if {$isbold && [info exists iddrawn($id)]} {
4928         if {![ishighlighted $id]} {
4929             bolden $id mainfontbold
4930             if {$isbold > 1} {
4931                 bolden_name $id mainfontbold
4932             }
4933         }
4934         if {$markingmatches} {
4935             markrowmatches $row $id
4936         }
4937     }
4938     set nhighlights($id) $isbold
4939 }
4940
4941 proc markrowmatches {row id} {
4942     global canv canv2 linehtag linentag commitinfo findloc
4943
4944     set headline [lindex $commitinfo($id) 0]
4945     set author [lindex $commitinfo($id) 1]
4946     $canv delete match$row
4947     $canv2 delete match$row
4948     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4949         set m [findmatches $headline]
4950         if {$m ne {}} {
4951             markmatches $canv $row $headline $linehtag($id) $m \
4952                 [$canv itemcget $linehtag($id) -font] $row
4953         }
4954     }
4955     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4956         set m [findmatches $author]
4957         if {$m ne {}} {
4958             markmatches $canv2 $row $author $linentag($id) $m \
4959                 [$canv2 itemcget $linentag($id) -font] $row
4960         }
4961     }
4962 }
4963
4964 proc vrel_change {name ix op} {
4965     global highlight_related
4966
4967     rhighlight_none
4968     if {$highlight_related ne [mc "None"]} {
4969         run drawvisible
4970     }
4971 }
4972
4973 # prepare for testing whether commits are descendents or ancestors of a
4974 proc rhighlight_sel {a} {
4975     global descendent desc_todo ancestor anc_todo
4976     global highlight_related
4977
4978     unset -nocomplain descendent
4979     set desc_todo [list $a]
4980     unset -nocomplain ancestor
4981     set anc_todo [list $a]
4982     if {$highlight_related ne [mc "None"]} {
4983         rhighlight_none
4984         run drawvisible
4985     }
4986 }
4987
4988 proc rhighlight_none {} {
4989     global rhighlights
4990
4991     unset -nocomplain rhighlights
4992     unbolden
4993 }
4994
4995 proc is_descendent {a} {
4996     global curview children descendent desc_todo
4997
4998     set v $curview
4999     set la [rowofcommit $a]
5000     set todo $desc_todo
5001     set leftover {}
5002     set done 0
5003     for {set i 0} {$i < [llength $todo]} {incr i} {
5004         set do [lindex $todo $i]
5005         if {[rowofcommit $do] < $la} {
5006             lappend leftover $do
5007             continue
5008         }
5009         foreach nk $children($v,$do) {
5010             if {![info exists descendent($nk)]} {
5011                 set descendent($nk) 1
5012                 lappend todo $nk
5013                 if {$nk eq $a} {
5014                     set done 1
5015                 }
5016             }
5017         }
5018         if {$done} {
5019             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5020             return
5021         }
5022     }
5023     set descendent($a) 0
5024     set desc_todo $leftover
5025 }
5026
5027 proc is_ancestor {a} {
5028     global curview parents ancestor anc_todo
5029
5030     set v $curview
5031     set la [rowofcommit $a]
5032     set todo $anc_todo
5033     set leftover {}
5034     set done 0
5035     for {set i 0} {$i < [llength $todo]} {incr i} {
5036         set do [lindex $todo $i]
5037         if {![commitinview $do $v] || [rowofcommit $do] > $la} {
5038             lappend leftover $do
5039             continue
5040         }
5041         foreach np $parents($v,$do) {
5042             if {![info exists ancestor($np)]} {
5043                 set ancestor($np) 1
5044                 lappend todo $np
5045                 if {$np eq $a} {
5046                     set done 1
5047                 }
5048             }
5049         }
5050         if {$done} {
5051             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5052             return
5053         }
5054     }
5055     set ancestor($a) 0
5056     set anc_todo $leftover
5057 }
5058
5059 proc askrelhighlight {row id} {
5060     global descendent highlight_related iddrawn rhighlights
5061     global selectedline ancestor
5062
5063     if {$selectedline eq {}} return
5064     set isbold 0
5065     if {$highlight_related eq [mc "Descendant"] ||
5066         $highlight_related eq [mc "Not descendant"]} {
5067         if {![info exists descendent($id)]} {
5068             is_descendent $id
5069         }
5070         if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
5071             set isbold 1
5072         }
5073     } elseif {$highlight_related eq [mc "Ancestor"] ||
5074               $highlight_related eq [mc "Not ancestor"]} {
5075         if {![info exists ancestor($id)]} {
5076             is_ancestor $id
5077         }
5078         if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
5079             set isbold 1
5080         }
5081     }
5082     if {[info exists iddrawn($id)]} {
5083         if {$isbold && ![ishighlighted $id]} {
5084             bolden $id mainfontbold
5085         }
5086     }
5087     set rhighlights($id) $isbold
5088 }
5089
5090 # Graph layout functions
5091
5092 proc shortids {ids} {
5093     set res {}
5094     foreach id $ids {
5095         if {[llength $id] > 1} {
5096             lappend res [shortids $id]
5097         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
5098             lappend res [string range $id 0 7]
5099         } else {
5100             lappend res $id
5101         }
5102     }
5103     return $res
5104 }
5105
5106 proc ntimes {n o} {
5107     set ret {}
5108     set o [list $o]
5109     for {set mask 1} {$mask <= $n} {incr mask $mask} {
5110         if {($n & $mask) != 0} {
5111             set ret [concat $ret $o]
5112         }
5113         set o [concat $o $o]
5114     }
5115     return $ret
5116 }
5117
5118 proc ordertoken {id} {
5119     global ordertok curview varcid varcstart varctok curview parents children
5120     global nullid nullid2
5121
5122     if {[info exists ordertok($id)]} {
5123         return $ordertok($id)
5124     }
5125     set origid $id
5126     set todo {}
5127     while {1} {
5128         if {[info exists varcid($curview,$id)]} {
5129             set a $varcid($curview,$id)
5130             set p [lindex $varcstart($curview) $a]
5131         } else {
5132             set p [lindex $children($curview,$id) 0]
5133         }
5134         if {[info exists ordertok($p)]} {
5135             set tok $ordertok($p)
5136             break
5137         }
5138         set id [first_real_child $curview,$p]
5139         if {$id eq {}} {
5140             # it's a root
5141             set tok [lindex $varctok($curview) $varcid($curview,$p)]
5142             break
5143         }
5144         if {[llength $parents($curview,$id)] == 1} {
5145             lappend todo [list $p {}]
5146         } else {
5147             set j [lsearch -exact $parents($curview,$id) $p]
5148             if {$j < 0} {
5149                 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5150             }
5151             lappend todo [list $p [strrep $j]]
5152         }
5153     }
5154     for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5155         set p [lindex $todo $i 0]
5156         append tok [lindex $todo $i 1]
5157         set ordertok($p) $tok
5158     }
5159     set ordertok($origid) $tok
5160     return $tok
5161 }
5162
5163 # Work out where id should go in idlist so that order-token
5164 # values increase from left to right
5165 proc idcol {idlist id {i 0}} {
5166     set t [ordertoken $id]
5167     if {$i < 0} {
5168         set i 0
5169     }
5170     if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
5171         if {$i > [llength $idlist]} {
5172             set i [llength $idlist]
5173         }
5174         while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5175         incr i
5176     } else {
5177         if {$t > [ordertoken [lindex $idlist $i]]} {
5178             while {[incr i] < [llength $idlist] &&
5179                    $t >= [ordertoken [lindex $idlist $i]]} {}
5180         }
5181     }
5182     return $i
5183 }
5184
5185 proc initlayout {} {
5186     global rowidlist rowisopt rowfinal displayorder parentlist
5187     global numcommits canvxmax canv
5188     global nextcolor
5189     global colormap rowtextx
5190
5191     set numcommits 0
5192     set displayorder {}
5193     set parentlist {}
5194     set nextcolor 0
5195     set rowidlist {}
5196     set rowisopt {}
5197     set rowfinal {}
5198     set canvxmax [$canv cget -width]
5199     unset -nocomplain colormap
5200     unset -nocomplain rowtextx
5201     setcanvscroll
5202 }
5203
5204 proc setcanvscroll {} {
5205     global canv canv2 canv3 numcommits linespc canvxmax canvy0
5206     global lastscrollset lastscrollrows
5207
5208     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5209     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5210     $canv2 conf -scrollregion [list 0 0 0 $ymax]
5211     $canv3 conf -scrollregion [list 0 0 0 $ymax]
5212     set lastscrollset [clock clicks -milliseconds]
5213     set lastscrollrows $numcommits
5214 }
5215
5216 proc visiblerows {} {
5217     global canv numcommits linespc
5218
5219     set ymax [lindex [$canv cget -scrollregion] 3]
5220     if {$ymax eq {} || $ymax == 0} return
5221     set f [$canv yview]
5222     set y0 [expr {int([lindex $f 0] * $ymax)}]
5223     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5224     if {$r0 < 0} {
5225         set r0 0
5226     }
5227     set y1 [expr {int([lindex $f 1] * $ymax)}]
5228     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5229     if {$r1 >= $numcommits} {
5230         set r1 [expr {$numcommits - 1}]
5231     }
5232     return [list $r0 $r1]
5233 }
5234
5235 proc layoutmore {} {
5236     global commitidx viewcomplete curview
5237     global numcommits pending_select curview
5238     global lastscrollset lastscrollrows
5239
5240     if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5241         [clock clicks -milliseconds] - $lastscrollset > 500} {
5242         setcanvscroll
5243     }
5244     if {[info exists pending_select] &&
5245         [commitinview $pending_select $curview]} {
5246         update
5247         selectline [rowofcommit $pending_select] 1
5248     }
5249     drawvisible
5250 }
5251
5252 # With path limiting, we mightn't get the actual HEAD commit,
5253 # so ask git rev-list what is the first ancestor of HEAD that
5254 # touches a file in the path limit.
5255 proc get_viewmainhead {view} {
5256     global viewmainheadid vfilelimit viewinstances mainheadid
5257
5258     catch {
5259         set rfd [open [concat | git rev-list -1 $mainheadid \
5260                            -- $vfilelimit($view)] r]
5261         set j [reg_instance $rfd]
5262         lappend viewinstances($view) $j
5263         fconfigure $rfd -blocking 0
5264         filerun $rfd [list getviewhead $rfd $j $view]
5265         set viewmainheadid($curview) {}
5266     }
5267 }
5268
5269 # git rev-list should give us just 1 line to use as viewmainheadid($view)
5270 proc getviewhead {fd inst view} {
5271     global viewmainheadid commfd curview viewinstances showlocalchanges
5272
5273     set id {}
5274     if {[gets $fd line] < 0} {
5275         if {![eof $fd]} {
5276             return 1
5277         }
5278     } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5279         set id $line
5280     }
5281     set viewmainheadid($view) $id
5282     close $fd
5283     unset commfd($inst)
5284     set i [lsearch -exact $viewinstances($view) $inst]
5285     if {$i >= 0} {
5286         set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5287     }
5288     if {$showlocalchanges && $id ne {} && $view == $curview} {
5289         doshowlocalchanges
5290     }
5291     return 0
5292 }
5293
5294 proc doshowlocalchanges {} {
5295     global curview viewmainheadid
5296
5297     if {$viewmainheadid($curview) eq {}} return
5298     if {[commitinview $viewmainheadid($curview) $curview]} {
5299         dodiffindex
5300     } else {
5301         interestedin $viewmainheadid($curview) dodiffindex
5302     }
5303 }
5304
5305 proc dohidelocalchanges {} {
5306     global nullid nullid2 lserial curview
5307
5308     if {[commitinview $nullid $curview]} {
5309         removefakerow $nullid
5310     }
5311     if {[commitinview $nullid2 $curview]} {
5312         removefakerow $nullid2
5313     }
5314     incr lserial
5315 }
5316
5317 # spawn off a process to do git diff-index --cached HEAD
5318 proc dodiffindex {} {
5319     global lserial showlocalchanges vfilelimit curview
5320     global hasworktree git_version
5321
5322     if {!$showlocalchanges || !$hasworktree} return
5323     incr lserial
5324     if {[package vcompare $git_version "1.7.2"] >= 0} {
5325         set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
5326     } else {
5327         set cmd "|git diff-index --cached HEAD"
5328     }
5329     if {$vfilelimit($curview) ne {}} {
5330         set cmd [concat $cmd -- $vfilelimit($curview)]
5331     }
5332     set fd [open $cmd r]
5333     fconfigure $fd -blocking 0
5334     set i [reg_instance $fd]
5335     filerun $fd [list readdiffindex $fd $lserial $i]
5336 }
5337
5338 proc readdiffindex {fd serial inst} {
5339     global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5340     global vfilelimit
5341
5342     set isdiff 1
5343     if {[gets $fd line] < 0} {
5344         if {![eof $fd]} {
5345             return 1
5346         }
5347         set isdiff 0
5348     }
5349     # we only need to see one line and we don't really care what it says...
5350     stop_instance $inst
5351
5352     if {$serial != $lserial} {
5353         return 0
5354     }
5355
5356     # now see if there are any local changes not checked in to the index
5357     set cmd "|git diff-files"
5358     if {$vfilelimit($curview) ne {}} {
5359         set cmd [concat $cmd -- $vfilelimit($curview)]
5360     }
5361     set fd [open $cmd r]
5362     fconfigure $fd -blocking 0
5363     set i [reg_instance $fd]
5364     filerun $fd [list readdifffiles $fd $serial $i]
5365
5366     if {$isdiff && ![commitinview $nullid2 $curview]} {
5367         # add the line for the changes in the index to the graph
5368         set hl [mc "Local changes checked in to index but not committed"]
5369         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5370         set commitdata($nullid2) "\n    $hl\n"
5371         if {[commitinview $nullid $curview]} {
5372             removefakerow $nullid
5373         }
5374         insertfakerow $nullid2 $viewmainheadid($curview)
5375     } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5376         if {[commitinview $nullid $curview]} {
5377             removefakerow $nullid
5378         }
5379         removefakerow $nullid2
5380     }
5381     return 0
5382 }
5383
5384 proc readdifffiles {fd serial inst} {
5385     global viewmainheadid nullid nullid2 curview
5386     global commitinfo commitdata lserial
5387
5388     set isdiff 1
5389     if {[gets $fd line] < 0} {
5390         if {![eof $fd]} {
5391             return 1
5392         }
5393         set isdiff 0
5394     }
5395     # we only need to see one line and we don't really care what it says...
5396     stop_instance $inst
5397
5398     if {$serial != $lserial} {
5399         return 0
5400     }
5401
5402     if {$isdiff && ![commitinview $nullid $curview]} {
5403         # add the line for the local diff to the graph
5404         set hl [mc "Local uncommitted changes, not checked in to index"]
5405         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5406         set commitdata($nullid) "\n    $hl\n"
5407         if {[commitinview $nullid2 $curview]} {
5408             set p $nullid2
5409         } else {
5410             set p $viewmainheadid($curview)
5411         }
5412         insertfakerow $nullid $p
5413     } elseif {!$isdiff && [commitinview $nullid $curview]} {
5414         removefakerow $nullid
5415     }
5416     return 0
5417 }
5418
5419 proc nextuse {id row} {
5420     global curview children
5421
5422     if {[info exists children($curview,$id)]} {
5423         foreach kid $children($curview,$id) {
5424             if {![commitinview $kid $curview]} {
5425                 return -1
5426             }
5427             if {[rowofcommit $kid] > $row} {
5428                 return [rowofcommit $kid]
5429             }
5430         }
5431     }
5432     if {[commitinview $id $curview]} {
5433         return [rowofcommit $id]
5434     }
5435     return -1
5436 }
5437
5438 proc prevuse {id row} {
5439     global curview children
5440
5441     set ret -1
5442     if {[info exists children($curview,$id)]} {
5443         foreach kid $children($curview,$id) {
5444             if {![commitinview $kid $curview]} break
5445             if {[rowofcommit $kid] < $row} {
5446                 set ret [rowofcommit $kid]
5447             }
5448         }
5449     }
5450     return $ret
5451 }
5452
5453 proc make_idlist {row} {
5454     global displayorder parentlist uparrowlen downarrowlen mingaplen
5455     global commitidx curview children
5456
5457     set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5458     if {$r < 0} {
5459         set r 0
5460     }
5461     set ra [expr {$row - $downarrowlen}]
5462     if {$ra < 0} {
5463         set ra 0
5464     }
5465     set rb [expr {$row + $uparrowlen}]
5466     if {$rb > $commitidx($curview)} {
5467         set rb $commitidx($curview)
5468     }
5469     make_disporder $r [expr {$rb + 1}]
5470     set ids {}
5471     for {} {$r < $ra} {incr r} {
5472         set nextid [lindex $displayorder [expr {$r + 1}]]
5473         foreach p [lindex $parentlist $r] {
5474             if {$p eq $nextid} continue
5475             set rn [nextuse $p $r]
5476             if {$rn >= $row &&
5477                 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5478                 lappend ids [list [ordertoken $p] $p]
5479             }
5480         }
5481     }
5482     for {} {$r < $row} {incr r} {
5483         set nextid [lindex $displayorder [expr {$r + 1}]]
5484         foreach p [lindex $parentlist $r] {
5485             if {$p eq $nextid} continue
5486             set rn [nextuse $p $r]
5487             if {$rn < 0 || $rn >= $row} {
5488                 lappend ids [list [ordertoken $p] $p]
5489             }
5490         }
5491     }
5492     set id [lindex $displayorder $row]
5493     lappend ids [list [ordertoken $id] $id]
5494     while {$r < $rb} {
5495         foreach p [lindex $parentlist $r] {
5496             set firstkid [lindex $children($curview,$p) 0]
5497             if {[rowofcommit $firstkid] < $row} {
5498                 lappend ids [list [ordertoken $p] $p]
5499             }
5500         }
5501         incr r
5502         set id [lindex $displayorder $r]
5503         if {$id ne {}} {
5504             set firstkid [lindex $children($curview,$id) 0]
5505             if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5506                 lappend ids [list [ordertoken $id] $id]
5507             }
5508         }
5509     }
5510     set idlist {}
5511     foreach idx [lsort -unique $ids] {
5512         lappend idlist [lindex $idx 1]
5513     }
5514     return $idlist
5515 }
5516
5517 proc rowsequal {a b} {
5518     while {[set i [lsearch -exact $a {}]] >= 0} {
5519         set a [lreplace $a $i $i]
5520     }
5521     while {[set i [lsearch -exact $b {}]] >= 0} {
5522         set b [lreplace $b $i $i]
5523     }
5524     return [expr {$a eq $b}]
5525 }
5526
5527 proc makeupline {id row rend col} {
5528     global rowidlist uparrowlen downarrowlen mingaplen
5529
5530     for {set r $rend} {1} {set r $rstart} {
5531         set rstart [prevuse $id $r]
5532         if {$rstart < 0} return
5533         if {$rstart < $row} break
5534     }
5535     if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5536         set rstart [expr {$rend - $uparrowlen - 1}]
5537     }
5538     for {set r $rstart} {[incr r] <= $row} {} {
5539         set idlist [lindex $rowidlist $r]
5540         if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5541             set col [idcol $idlist $id $col]
5542             lset rowidlist $r [linsert $idlist $col $id]
5543             changedrow $r
5544         }
5545     }
5546 }
5547
5548 proc layoutrows {row endrow} {
5549     global rowidlist rowisopt rowfinal displayorder
5550     global uparrowlen downarrowlen maxwidth mingaplen
5551     global children parentlist
5552     global commitidx viewcomplete curview
5553
5554     make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5555     set idlist {}
5556     if {$row > 0} {
5557         set rm1 [expr {$row - 1}]
5558         foreach id [lindex $rowidlist $rm1] {
5559             if {$id ne {}} {
5560                 lappend idlist $id
5561             }
5562         }
5563         set final [lindex $rowfinal $rm1]
5564     }
5565     for {} {$row < $endrow} {incr row} {
5566         set rm1 [expr {$row - 1}]
5567         if {$rm1 < 0 || $idlist eq {}} {
5568             set idlist [make_idlist $row]
5569             set final 1
5570         } else {
5571             set id [lindex $displayorder $rm1]
5572             set col [lsearch -exact $idlist $id]
5573             set idlist [lreplace $idlist $col $col]
5574             foreach p [lindex $parentlist $rm1] {
5575                 if {[lsearch -exact $idlist $p] < 0} {
5576                     set col [idcol $idlist $p $col]
5577                     set idlist [linsert $idlist $col $p]
5578                     # if not the first child, we have to insert a line going up
5579                     if {$id ne [lindex $children($curview,$p) 0]} {
5580                         makeupline $p $rm1 $row $col
5581                     }
5582                 }
5583             }
5584             set id [lindex $displayorder $row]
5585             if {$row > $downarrowlen} {
5586                 set termrow [expr {$row - $downarrowlen - 1}]
5587                 foreach p [lindex $parentlist $termrow] {
5588                     set i [lsearch -exact $idlist $p]
5589                     if {$i < 0} continue
5590                     set nr [nextuse $p $termrow]
5591                     if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5592                         set idlist [lreplace $idlist $i $i]
5593                     }
5594                 }
5595             }
5596             set col [lsearch -exact $idlist $id]
5597             if {$col < 0} {
5598                 set col [idcol $idlist $id]
5599                 set idlist [linsert $idlist $col $id]
5600                 if {$children($curview,$id) ne {}} {
5601                     makeupline $id $rm1 $row $col
5602                 }
5603             }
5604             set r [expr {$row + $uparrowlen - 1}]
5605             if {$r < $commitidx($curview)} {
5606                 set x $col
5607                 foreach p [lindex $parentlist $r] {
5608                     if {[lsearch -exact $idlist $p] >= 0} continue
5609                     set fk [lindex $children($curview,$p) 0]
5610                     if {[rowofcommit $fk] < $row} {
5611                         set x [idcol $idlist $p $x]
5612                         set idlist [linsert $idlist $x $p]
5613                     }
5614                 }
5615                 if {[incr r] < $commitidx($curview)} {
5616                     set p [lindex $displayorder $r]
5617                     if {[lsearch -exact $idlist $p] < 0} {
5618                         set fk [lindex $children($curview,$p) 0]
5619                         if {$fk ne {} && [rowofcommit $fk] < $row} {
5620                             set x [idcol $idlist $p $x]
5621                             set idlist [linsert $idlist $x $p]
5622                         }
5623                     }
5624                 }
5625             }
5626         }
5627         if {$final && !$viewcomplete($curview) &&
5628             $row + $uparrowlen + $mingaplen + $downarrowlen
5629                 >= $commitidx($curview)} {
5630             set final 0
5631         }
5632         set l [llength $rowidlist]
5633         if {$row == $l} {
5634             lappend rowidlist $idlist
5635             lappend rowisopt 0
5636             lappend rowfinal $final
5637         } elseif {$row < $l} {
5638             if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5639                 lset rowidlist $row $idlist
5640                 changedrow $row
5641             }
5642             lset rowfinal $row $final
5643         } else {
5644             set pad [ntimes [expr {$row - $l}] {}]
5645             set rowidlist [concat $rowidlist $pad]
5646             lappend rowidlist $idlist
5647             set rowfinal [concat $rowfinal $pad]
5648             lappend rowfinal $final
5649             set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5650         }
5651     }
5652     return $row
5653 }
5654
5655 proc changedrow {row} {
5656     global displayorder iddrawn rowisopt need_redisplay
5657
5658     set l [llength $rowisopt]
5659     if {$row < $l} {
5660         lset rowisopt $row 0
5661         if {$row + 1 < $l} {
5662             lset rowisopt [expr {$row + 1}] 0
5663             if {$row + 2 < $l} {
5664                 lset rowisopt [expr {$row + 2}] 0
5665             }
5666         }
5667     }
5668     set id [lindex $displayorder $row]
5669     if {[info exists iddrawn($id)]} {
5670         set need_redisplay 1
5671     }
5672 }
5673
5674 proc insert_pad {row col npad} {
5675     global rowidlist
5676
5677     set pad [ntimes $npad {}]
5678     set idlist [lindex $rowidlist $row]
5679     set bef [lrange $idlist 0 [expr {$col - 1}]]
5680     set aft [lrange $idlist $col end]
5681     set i [lsearch -exact $aft {}]
5682     if {$i > 0} {
5683         set aft [lreplace $aft $i $i]
5684     }
5685     lset rowidlist $row [concat $bef $pad $aft]
5686     changedrow $row
5687 }
5688
5689 proc optimize_rows {row col endrow} {
5690     global rowidlist rowisopt displayorder curview children
5691
5692     if {$row < 1} {
5693         set row 1
5694     }
5695     for {} {$row < $endrow} {incr row; set col 0} {
5696         if {[lindex $rowisopt $row]} continue
5697         set haspad 0
5698         set y0 [expr {$row - 1}]
5699         set ym [expr {$row - 2}]
5700         set idlist [lindex $rowidlist $row]
5701         set previdlist [lindex $rowidlist $y0]
5702         if {$idlist eq {} || $previdlist eq {}} continue
5703         if {$ym >= 0} {
5704             set pprevidlist [lindex $rowidlist $ym]
5705             if {$pprevidlist eq {}} continue
5706         } else {
5707             set pprevidlist {}
5708         }
5709         set x0 -1
5710         set xm -1
5711         for {} {$col < [llength $idlist]} {incr col} {
5712             set id [lindex $idlist $col]
5713             if {[lindex $previdlist $col] eq $id} continue
5714             if {$id eq {}} {
5715                 set haspad 1
5716                 continue
5717             }
5718             set x0 [lsearch -exact $previdlist $id]
5719             if {$x0 < 0} continue
5720             set z [expr {$x0 - $col}]
5721             set isarrow 0
5722             set z0 {}
5723             if {$ym >= 0} {
5724                 set xm [lsearch -exact $pprevidlist $id]
5725                 if {$xm >= 0} {
5726                     set z0 [expr {$xm - $x0}]
5727                 }
5728             }
5729             if {$z0 eq {}} {
5730                 # if row y0 is the first child of $id then it's not an arrow
5731                 if {[lindex $children($curview,$id) 0] ne
5732                     [lindex $displayorder $y0]} {
5733                     set isarrow 1
5734                 }
5735             }
5736             if {!$isarrow && $id ne [lindex $displayorder $row] &&
5737                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5738                 set isarrow 1
5739             }
5740             # Looking at lines from this row to the previous row,
5741             # make them go straight up if they end in an arrow on
5742             # the previous row; otherwise make them go straight up
5743             # or at 45 degrees.
5744             if {$z < -1 || ($z < 0 && $isarrow)} {
5745                 # Line currently goes left too much;
5746                 # insert pads in the previous row, then optimize it
5747                 set npad [expr {-1 - $z + $isarrow}]
5748                 insert_pad $y0 $x0 $npad
5749                 if {$y0 > 0} {
5750                     optimize_rows $y0 $x0 $row
5751                 }
5752                 set previdlist [lindex $rowidlist $y0]
5753                 set x0 [lsearch -exact $previdlist $id]
5754                 set z [expr {$x0 - $col}]
5755                 if {$z0 ne {}} {
5756                     set pprevidlist [lindex $rowidlist $ym]
5757                     set xm [lsearch -exact $pprevidlist $id]
5758                     set z0 [expr {$xm - $x0}]
5759                 }
5760             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5761                 # Line currently goes right too much;
5762                 # insert pads in this line
5763                 set npad [expr {$z - 1 + $isarrow}]
5764                 insert_pad $row $col $npad
5765                 set idlist [lindex $rowidlist $row]
5766                 incr col $npad
5767                 set z [expr {$x0 - $col}]
5768                 set haspad 1
5769             }
5770             if {$z0 eq {} && !$isarrow && $ym >= 0} {
5771                 # this line links to its first child on row $row-2
5772                 set id [lindex $displayorder $ym]
5773                 set xc [lsearch -exact $pprevidlist $id]
5774                 if {$xc >= 0} {
5775                     set z0 [expr {$xc - $x0}]
5776                 }
5777             }
5778             # avoid lines jigging left then immediately right
5779             if {$z0 ne {} && $z < 0 && $z0 > 0} {
5780                 insert_pad $y0 $x0 1
5781                 incr x0
5782                 optimize_rows $y0 $x0 $row
5783                 set previdlist [lindex $rowidlist $y0]
5784             }
5785         }
5786         if {!$haspad} {
5787             # Find the first column that doesn't have a line going right
5788             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5789                 set id [lindex $idlist $col]
5790                 if {$id eq {}} break
5791                 set x0 [lsearch -exact $previdlist $id]
5792                 if {$x0 < 0} {
5793                     # check if this is the link to the first child
5794                     set kid [lindex $displayorder $y0]
5795                     if {[lindex $children($curview,$id) 0] eq $kid} {
5796                         # it is, work out offset to child
5797                         set x0 [lsearch -exact $previdlist $kid]
5798                     }
5799                 }
5800                 if {$x0 <= $col} break
5801             }
5802             # Insert a pad at that column as long as it has a line and
5803             # isn't the last column
5804             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5805                 set idlist [linsert $idlist $col {}]
5806                 lset rowidlist $row $idlist
5807                 changedrow $row
5808             }
5809         }
5810     }
5811 }
5812
5813 proc xc {row col} {
5814     global canvx0 linespc
5815     return [expr {$canvx0 + $col * $linespc}]
5816 }
5817
5818 proc yc {row} {
5819     global canvy0 linespc
5820     return [expr {$canvy0 + $row * $linespc}]
5821 }
5822
5823 proc linewidth {id} {
5824     global thickerline lthickness
5825
5826     set wid $lthickness
5827     if {[info exists thickerline] && $id eq $thickerline} {
5828         set wid [expr {2 * $lthickness}]
5829     }
5830     return $wid
5831 }
5832
5833 proc rowranges {id} {
5834     global curview children uparrowlen downarrowlen
5835     global rowidlist
5836
5837     set kids $children($curview,$id)
5838     if {$kids eq {}} {
5839         return {}
5840     }
5841     set ret {}
5842     lappend kids $id
5843     foreach child $kids {
5844         if {![commitinview $child $curview]} break
5845         set row [rowofcommit $child]
5846         if {![info exists prev]} {
5847             lappend ret [expr {$row + 1}]
5848         } else {
5849             if {$row <= $prevrow} {
5850                 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5851             }
5852             # see if the line extends the whole way from prevrow to row
5853             if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5854                 [lsearch -exact [lindex $rowidlist \
5855                             [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5856                 # it doesn't, see where it ends
5857                 set r [expr {$prevrow + $downarrowlen}]
5858                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5859                     while {[incr r -1] > $prevrow &&
5860                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5861                 } else {
5862                     while {[incr r] <= $row &&
5863                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5864                     incr r -1
5865                 }
5866                 lappend ret $r
5867                 # see where it starts up again
5868                 set r [expr {$row - $uparrowlen}]
5869                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5870                     while {[incr r] < $row &&
5871                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5872                 } else {
5873                     while {[incr r -1] >= $prevrow &&
5874                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5875                     incr r
5876                 }
5877                 lappend ret $r
5878             }
5879         }
5880         if {$child eq $id} {
5881             lappend ret $row
5882         }
5883         set prev $child
5884         set prevrow $row
5885     }
5886     return $ret
5887 }
5888
5889 proc drawlineseg {id row endrow arrowlow} {
5890     global rowidlist displayorder iddrawn linesegs
5891     global canv colormap linespc curview maxlinelen parentlist
5892
5893     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5894     set le [expr {$row + 1}]
5895     set arrowhigh 1
5896     while {1} {
5897         set c [lsearch -exact [lindex $rowidlist $le] $id]
5898         if {$c < 0} {
5899             incr le -1
5900             break
5901         }
5902         lappend cols $c
5903         set x [lindex $displayorder $le]
5904         if {$x eq $id} {
5905             set arrowhigh 0
5906             break
5907         }
5908         if {[info exists iddrawn($x)] || $le == $endrow} {
5909             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5910             if {$c >= 0} {
5911                 lappend cols $c
5912                 set arrowhigh 0
5913             }
5914             break
5915         }
5916         incr le
5917     }
5918     if {$le <= $row} {
5919         return $row
5920     }
5921
5922     set lines {}
5923     set i 0
5924     set joinhigh 0
5925     if {[info exists linesegs($id)]} {
5926         set lines $linesegs($id)
5927         foreach li $lines {
5928             set r0 [lindex $li 0]
5929             if {$r0 > $row} {
5930                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5931                     set joinhigh 1
5932                 }
5933                 break
5934             }
5935             incr i
5936         }
5937     }
5938     set joinlow 0
5939     if {$i > 0} {
5940         set li [lindex $lines [expr {$i-1}]]
5941         set r1 [lindex $li 1]
5942         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5943             set joinlow 1
5944         }
5945     }
5946
5947     set x [lindex $cols [expr {$le - $row}]]
5948     set xp [lindex $cols [expr {$le - 1 - $row}]]
5949     set dir [expr {$xp - $x}]
5950     if {$joinhigh} {
5951         set ith [lindex $lines $i 2]
5952         set coords [$canv coords $ith]
5953         set ah [$canv itemcget $ith -arrow]
5954         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5955         set x2 [lindex $cols [expr {$le + 1 - $row}]]
5956         if {$x2 ne {} && $x - $x2 == $dir} {
5957             set coords [lrange $coords 0 end-2]
5958         }
5959     } else {
5960         set coords [list [xc $le $x] [yc $le]]
5961     }
5962     if {$joinlow} {
5963         set itl [lindex $lines [expr {$i-1}] 2]
5964         set al [$canv itemcget $itl -arrow]
5965         set arrowlow [expr {$al eq "last" || $al eq "both"}]
5966     } elseif {$arrowlow} {
5967         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5968             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5969             set arrowlow 0
5970         }
5971     }
5972     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5973     for {set y $le} {[incr y -1] > $row} {} {
5974         set x $xp
5975         set xp [lindex $cols [expr {$y - 1 - $row}]]
5976         set ndir [expr {$xp - $x}]
5977         if {$dir != $ndir || $xp < 0} {
5978             lappend coords [xc $y $x] [yc $y]
5979         }
5980         set dir $ndir
5981     }
5982     if {!$joinlow} {
5983         if {$xp < 0} {
5984             # join parent line to first child
5985             set ch [lindex $displayorder $row]
5986             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5987             if {$xc < 0} {
5988                 puts "oops: drawlineseg: child $ch not on row $row"
5989             } elseif {$xc != $x} {
5990                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5991                     set d [expr {int(0.5 * $linespc)}]
5992                     set x1 [xc $row $x]
5993                     if {$xc < $x} {
5994                         set x2 [expr {$x1 - $d}]
5995                     } else {
5996                         set x2 [expr {$x1 + $d}]
5997                     }
5998                     set y2 [yc $row]
5999                     set y1 [expr {$y2 + $d}]
6000                     lappend coords $x1 $y1 $x2 $y2
6001                 } elseif {$xc < $x - 1} {
6002                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
6003                 } elseif {$xc > $x + 1} {
6004                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
6005                 }
6006                 set x $xc
6007             }
6008             lappend coords [xc $row $x] [yc $row]
6009         } else {
6010             set xn [xc $row $xp]
6011             set yn [yc $row]
6012             lappend coords $xn $yn
6013         }
6014         if {!$joinhigh} {
6015             assigncolor $id
6016             set t [$canv create line $coords -width [linewidth $id] \
6017                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
6018             $canv lower $t
6019             bindline $t $id
6020             set lines [linsert $lines $i [list $row $le $t]]
6021         } else {
6022             $canv coords $ith $coords
6023             if {$arrow ne $ah} {
6024                 $canv itemconf $ith -arrow $arrow
6025             }
6026             lset lines $i 0 $row
6027         }
6028     } else {
6029         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
6030         set ndir [expr {$xo - $xp}]
6031         set clow [$canv coords $itl]
6032         if {$dir == $ndir} {
6033             set clow [lrange $clow 2 end]
6034         }
6035         set coords [concat $coords $clow]
6036         if {!$joinhigh} {
6037             lset lines [expr {$i-1}] 1 $le
6038         } else {
6039             # coalesce two pieces
6040             $canv delete $ith
6041             set b [lindex $lines [expr {$i-1}] 0]
6042             set e [lindex $lines $i 1]
6043             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
6044         }
6045         $canv coords $itl $coords
6046         if {$arrow ne $al} {
6047             $canv itemconf $itl -arrow $arrow
6048         }
6049     }
6050
6051     set linesegs($id) $lines
6052     return $le
6053 }
6054
6055 proc drawparentlinks {id row} {
6056     global rowidlist canv colormap curview parentlist
6057     global idpos linespc
6058
6059     set rowids [lindex $rowidlist $row]
6060     set col [lsearch -exact $rowids $id]
6061     if {$col < 0} return
6062     set olds [lindex $parentlist $row]
6063     set row2 [expr {$row + 1}]
6064     set x [xc $row $col]
6065     set y [yc $row]
6066     set y2 [yc $row2]
6067     set d [expr {int(0.5 * $linespc)}]
6068     set ymid [expr {$y + $d}]
6069     set ids [lindex $rowidlist $row2]
6070     # rmx = right-most X coord used
6071     set rmx 0
6072     foreach p $olds {
6073         set i [lsearch -exact $ids $p]
6074         if {$i < 0} {
6075             puts "oops, parent $p of $id not in list"
6076             continue
6077         }
6078         set x2 [xc $row2 $i]
6079         if {$x2 > $rmx} {
6080             set rmx $x2
6081         }
6082         set j [lsearch -exact $rowids $p]
6083         if {$j < 0} {
6084             # drawlineseg will do this one for us
6085             continue
6086         }
6087         assigncolor $p
6088         # should handle duplicated parents here...
6089         set coords [list $x $y]
6090         if {$i != $col} {
6091             # if attaching to a vertical segment, draw a smaller
6092             # slant for visual distinctness
6093             if {$i == $j} {
6094                 if {$i < $col} {
6095                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
6096                 } else {
6097                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
6098                 }
6099             } elseif {$i < $col && $i < $j} {
6100                 # segment slants towards us already
6101                 lappend coords [xc $row $j] $y
6102             } else {
6103                 if {$i < $col - 1} {
6104                     lappend coords [expr {$x2 + $linespc}] $y
6105                 } elseif {$i > $col + 1} {
6106                     lappend coords [expr {$x2 - $linespc}] $y
6107                 }
6108                 lappend coords $x2 $y2
6109             }
6110         } else {
6111             lappend coords $x2 $y2
6112         }
6113         set t [$canv create line $coords -width [linewidth $p] \
6114                    -fill $colormap($p) -tags lines.$p]
6115         $canv lower $t
6116         bindline $t $p
6117     }
6118     if {$rmx > [lindex $idpos($id) 1]} {
6119         lset idpos($id) 1 $rmx
6120         redrawtags $id
6121     }
6122 }
6123
6124 proc drawlines {id} {
6125     global canv
6126
6127     $canv itemconf lines.$id -width [linewidth $id]
6128 }
6129
6130 proc drawcmittext {id row col} {
6131     global linespc canv canv2 canv3 fgcolor curview
6132     global cmitlisted commitinfo rowidlist parentlist
6133     global rowtextx idpos idtags idheads idotherrefs
6134     global linehtag linentag linedtag selectedline
6135     global canvxmax boldids boldnameids fgcolor markedid
6136     global mainheadid nullid nullid2 circleitem circlecolors ctxbut
6137     global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
6138     global circleoutlinecolor
6139
6140     # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
6141     set listed $cmitlisted($curview,$id)
6142     if {$id eq $nullid} {
6143         set ofill $workingfilescirclecolor
6144     } elseif {$id eq $nullid2} {
6145         set ofill $indexcirclecolor
6146     } elseif {$id eq $mainheadid} {
6147         set ofill $mainheadcirclecolor
6148     } else {
6149         set ofill [lindex $circlecolors $listed]
6150     }
6151     set x [xc $row $col]
6152     set y [yc $row]
6153     set orad [expr {$linespc / 3}]
6154     if {$listed <= 2} {
6155         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6156                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6157                    -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6158     } elseif {$listed == 3} {
6159         # triangle pointing left for left-side commits
6160         set t [$canv create polygon \
6161                    [expr {$x - $orad}] $y \
6162                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6163                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6164                    -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6165     } else {
6166         # triangle pointing right for right-side commits
6167         set t [$canv create polygon \
6168                    [expr {$x + $orad - 1}] $y \
6169                    [expr {$x - $orad}] [expr {$y - $orad}] \
6170                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6171                    -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6172     }
6173     set circleitem($row) $t
6174     $canv raise $t
6175     $canv bind $t <1> {selcanvline {} %x %y}
6176     set rmx [llength [lindex $rowidlist $row]]
6177     set olds [lindex $parentlist $row]
6178     if {$olds ne {}} {
6179         set nextids [lindex $rowidlist [expr {$row + 1}]]
6180         foreach p $olds {
6181             set i [lsearch -exact $nextids $p]
6182             if {$i > $rmx} {
6183                 set rmx $i
6184             }
6185         }
6186     }
6187     set xt [xc $row $rmx]
6188     set rowtextx($row) $xt
6189     set idpos($id) [list $x $xt $y]
6190     if {[info exists idtags($id)] || [info exists idheads($id)]
6191         || [info exists idotherrefs($id)]} {
6192         set xt [drawtags $id $x $xt $y]
6193     }
6194     if {[lindex $commitinfo($id) 6] > 0} {
6195         set xt [drawnotesign $xt $y]
6196     }
6197     set headline [lindex $commitinfo($id) 0]
6198     set name [lindex $commitinfo($id) 1]
6199     set date [lindex $commitinfo($id) 2]
6200     set date [formatdate $date]
6201     set font mainfont
6202     set nfont mainfont
6203     set isbold [ishighlighted $id]
6204     if {$isbold > 0} {
6205         lappend boldids $id
6206         set font mainfontbold
6207         if {$isbold > 1} {
6208             lappend boldnameids $id
6209             set nfont mainfontbold
6210         }
6211     }
6212     set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6213                            -text $headline -font $font -tags text]
6214     $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6215     set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6216                            -text $name -font $nfont -tags text]
6217     set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6218                            -text $date -font mainfont -tags text]
6219     if {$selectedline == $row} {
6220         make_secsel $id
6221     }
6222     if {[info exists markedid] && $markedid eq $id} {
6223         make_idmark $id
6224     }
6225     set xr [expr {$xt + [font measure $font $headline]}]
6226     if {$xr > $canvxmax} {
6227         set canvxmax $xr
6228         setcanvscroll
6229     }
6230 }
6231
6232 proc drawcmitrow {row} {
6233     global displayorder rowidlist nrows_drawn
6234     global iddrawn markingmatches
6235     global commitinfo numcommits
6236     global filehighlight fhighlights findpattern nhighlights
6237     global hlview vhighlights
6238     global highlight_related rhighlights
6239
6240     if {$row >= $numcommits} return
6241
6242     set id [lindex $displayorder $row]
6243     if {[info exists hlview] && ![info exists vhighlights($id)]} {
6244         askvhighlight $row $id
6245     }
6246     if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
6247         askfilehighlight $row $id
6248     }
6249     if {$findpattern ne {} && ![info exists nhighlights($id)]} {
6250         askfindhighlight $row $id
6251     }
6252     if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
6253         askrelhighlight $row $id
6254     }
6255     if {![info exists iddrawn($id)]} {
6256         set col [lsearch -exact [lindex $rowidlist $row] $id]
6257         if {$col < 0} {
6258             puts "oops, row $row id $id not in list"
6259             return
6260         }
6261         if {![info exists commitinfo($id)]} {
6262             getcommit $id
6263         }
6264         assigncolor $id
6265         drawcmittext $id $row $col
6266         set iddrawn($id) 1
6267         incr nrows_drawn
6268     }
6269     if {$markingmatches} {
6270         markrowmatches $row $id
6271     }
6272 }
6273
6274 proc drawcommits {row {endrow {}}} {
6275     global numcommits iddrawn displayorder curview need_redisplay
6276     global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6277
6278     if {$row < 0} {
6279         set row 0
6280     }
6281     if {$endrow eq {}} {
6282         set endrow $row
6283     }
6284     if {$endrow >= $numcommits} {
6285         set endrow [expr {$numcommits - 1}]
6286     }
6287
6288     set rl1 [expr {$row - $downarrowlen - 3}]
6289     if {$rl1 < 0} {
6290         set rl1 0
6291     }
6292     set ro1 [expr {$row - 3}]
6293     if {$ro1 < 0} {
6294         set ro1 0
6295     }
6296     set r2 [expr {$endrow + $uparrowlen + 3}]
6297     if {$r2 > $numcommits} {
6298         set r2 $numcommits
6299     }
6300     for {set r $rl1} {$r < $r2} {incr r} {
6301         if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6302             if {$rl1 < $r} {
6303                 layoutrows $rl1 $r
6304             }
6305             set rl1 [expr {$r + 1}]
6306         }
6307     }
6308     if {$rl1 < $r} {
6309         layoutrows $rl1 $r
6310     }
6311     optimize_rows $ro1 0 $r2
6312     if {$need_redisplay || $nrows_drawn > 2000} {
6313         clear_display
6314     }
6315
6316     # make the lines join to already-drawn rows either side
6317     set r [expr {$row - 1}]
6318     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6319         set r $row
6320     }
6321     set er [expr {$endrow + 1}]
6322     if {$er >= $numcommits ||
6323         ![info exists iddrawn([lindex $displayorder $er])]} {
6324         set er $endrow
6325     }
6326     for {} {$r <= $er} {incr r} {
6327         set id [lindex $displayorder $r]
6328         set wasdrawn [info exists iddrawn($id)]
6329         drawcmitrow $r
6330         if {$r == $er} break
6331         set nextid [lindex $displayorder [expr {$r + 1}]]
6332         if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6333         drawparentlinks $id $r
6334
6335         set rowids [lindex $rowidlist $r]
6336         foreach lid $rowids {
6337             if {$lid eq {}} continue
6338             if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6339             if {$lid eq $id} {
6340                 # see if this is the first child of any of its parents
6341                 foreach p [lindex $parentlist $r] {
6342                     if {[lsearch -exact $rowids $p] < 0} {
6343                         # make this line extend up to the child
6344                         set lineend($p) [drawlineseg $p $r $er 0]
6345                     }
6346                 }
6347             } else {
6348                 set lineend($lid) [drawlineseg $lid $r $er 1]
6349             }
6350         }
6351     }
6352 }
6353
6354 proc undolayout {row} {
6355     global uparrowlen mingaplen downarrowlen
6356     global rowidlist rowisopt rowfinal need_redisplay
6357
6358     set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6359     if {$r < 0} {
6360         set r 0
6361     }
6362     if {[llength $rowidlist] > $r} {
6363         incr r -1
6364         set rowidlist [lrange $rowidlist 0 $r]
6365         set rowfinal [lrange $rowfinal 0 $r]
6366         set rowisopt [lrange $rowisopt 0 $r]
6367         set need_redisplay 1
6368         run drawvisible
6369     }
6370 }
6371
6372 proc drawvisible {} {
6373     global canv linespc curview vrowmod selectedline targetrow targetid
6374     global need_redisplay cscroll numcommits
6375
6376     set fs [$canv yview]
6377     set ymax [lindex [$canv cget -scrollregion] 3]
6378     if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6379     set f0 [lindex $fs 0]
6380     set f1 [lindex $fs 1]
6381     set y0 [expr {int($f0 * $ymax)}]
6382     set y1 [expr {int($f1 * $ymax)}]
6383
6384     if {[info exists targetid]} {
6385         if {[commitinview $targetid $curview]} {
6386             set r [rowofcommit $targetid]
6387             if {$r != $targetrow} {
6388                 # Fix up the scrollregion and change the scrolling position
6389                 # now that our target row has moved.
6390                 set diff [expr {($r - $targetrow) * $linespc}]
6391                 set targetrow $r
6392                 setcanvscroll
6393                 set ymax [lindex [$canv cget -scrollregion] 3]
6394                 incr y0 $diff
6395                 incr y1 $diff
6396                 set f0 [expr {$y0 / $ymax}]
6397                 set f1 [expr {$y1 / $ymax}]
6398                 allcanvs yview moveto $f0
6399                 $cscroll set $f0 $f1
6400                 set need_redisplay 1
6401             }
6402         } else {
6403             unset targetid
6404         }
6405     }
6406
6407     set row [expr {int(($y0 - 3) / $linespc) - 1}]
6408     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6409     if {$endrow >= $vrowmod($curview)} {
6410         update_arcrows $curview
6411     }
6412     if {$selectedline ne {} &&
6413         $row <= $selectedline && $selectedline <= $endrow} {
6414         set targetrow $selectedline
6415     } elseif {[info exists targetid]} {
6416         set targetrow [expr {int(($row + $endrow) / 2)}]
6417     }
6418     if {[info exists targetrow]} {
6419         if {$targetrow >= $numcommits} {
6420             set targetrow [expr {$numcommits - 1}]
6421         }
6422         set targetid [commitonrow $targetrow]
6423     }
6424     drawcommits $row $endrow
6425 }
6426
6427 proc clear_display {} {
6428     global iddrawn linesegs need_redisplay nrows_drawn
6429     global vhighlights fhighlights nhighlights rhighlights
6430     global linehtag linentag linedtag boldids boldnameids
6431
6432     allcanvs delete all
6433     unset -nocomplain iddrawn
6434     unset -nocomplain linesegs
6435     unset -nocomplain linehtag
6436     unset -nocomplain linentag
6437     unset -nocomplain linedtag
6438     set boldids {}
6439     set boldnameids {}
6440     unset -nocomplain vhighlights
6441     unset -nocomplain fhighlights
6442     unset -nocomplain nhighlights
6443     unset -nocomplain rhighlights
6444     set need_redisplay 0
6445     set nrows_drawn 0
6446 }
6447
6448 proc findcrossings {id} {
6449     global rowidlist parentlist numcommits displayorder
6450
6451     set cross {}
6452     set ccross {}
6453     foreach {s e} [rowranges $id] {
6454         if {$e >= $numcommits} {
6455             set e [expr {$numcommits - 1}]
6456         }
6457         if {$e <= $s} continue
6458         for {set row $e} {[incr row -1] >= $s} {} {
6459             set x [lsearch -exact [lindex $rowidlist $row] $id]
6460             if {$x < 0} break
6461             set olds [lindex $parentlist $row]
6462             set kid [lindex $displayorder $row]
6463             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6464             if {$kidx < 0} continue
6465             set nextrow [lindex $rowidlist [expr {$row + 1}]]
6466             foreach p $olds {
6467                 set px [lsearch -exact $nextrow $p]
6468                 if {$px < 0} continue
6469                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6470                     if {[lsearch -exact $ccross $p] >= 0} continue
6471                     if {$x == $px + ($kidx < $px? -1: 1)} {
6472                         lappend ccross $p
6473                     } elseif {[lsearch -exact $cross $p] < 0} {
6474                         lappend cross $p
6475                     }
6476                 }
6477             }
6478         }
6479     }
6480     return [concat $ccross {{}} $cross]
6481 }
6482
6483 proc assigncolor {id} {
6484     global colormap colors nextcolor
6485     global parents children children curview
6486
6487     if {[info exists colormap($id)]} return
6488     set ncolors [llength $colors]
6489     if {[info exists children($curview,$id)]} {
6490         set kids $children($curview,$id)
6491     } else {
6492         set kids {}
6493     }
6494     if {[llength $kids] == 1} {
6495         set child [lindex $kids 0]
6496         if {[info exists colormap($child)]
6497             && [llength $parents($curview,$child)] == 1} {
6498             set colormap($id) $colormap($child)
6499             return
6500         }
6501     }
6502     set badcolors {}
6503     set origbad {}
6504     foreach x [findcrossings $id] {
6505         if {$x eq {}} {
6506             # delimiter between corner crossings and other crossings
6507             if {[llength $badcolors] >= $ncolors - 1} break
6508             set origbad $badcolors
6509         }
6510         if {[info exists colormap($x)]
6511             && [lsearch -exact $badcolors $colormap($x)] < 0} {
6512             lappend badcolors $colormap($x)
6513         }
6514     }
6515     if {[llength $badcolors] >= $ncolors} {
6516         set badcolors $origbad
6517     }
6518     set origbad $badcolors
6519     if {[llength $badcolors] < $ncolors - 1} {
6520         foreach child $kids {
6521             if {[info exists colormap($child)]
6522                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6523                 lappend badcolors $colormap($child)
6524             }
6525             foreach p $parents($curview,$child) {
6526                 if {[info exists colormap($p)]
6527                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
6528                     lappend badcolors $colormap($p)
6529                 }
6530             }
6531         }
6532         if {[llength $badcolors] >= $ncolors} {
6533             set badcolors $origbad
6534         }
6535     }
6536     for {set i 0} {$i <= $ncolors} {incr i} {
6537         set c [lindex $colors $nextcolor]
6538         if {[incr nextcolor] >= $ncolors} {
6539             set nextcolor 0
6540         }
6541         if {[lsearch -exact $badcolors $c]} break
6542     }
6543     set colormap($id) $c
6544 }
6545
6546 proc bindline {t id} {
6547     global canv
6548
6549     $canv bind $t <Enter> "lineenter %x %y $id"
6550     $canv bind $t <Motion> "linemotion %x %y $id"
6551     $canv bind $t <Leave> "lineleave $id"
6552     $canv bind $t <Button-1> "lineclick %x %y $id 1"
6553 }
6554
6555 proc graph_pane_width {} {
6556     global use_ttk
6557
6558     if {$use_ttk} {
6559         set g [.tf.histframe.pwclist sashpos 0]
6560     } else {
6561         set g [.tf.histframe.pwclist sash coord 0]
6562     }
6563     return [lindex $g 0]
6564 }
6565
6566 proc totalwidth {l font extra} {
6567     set tot 0
6568     foreach str $l {
6569         set tot [expr {$tot + [font measure $font $str] + $extra}]
6570     }
6571     return $tot
6572 }
6573
6574 proc drawtags {id x xt y1} {
6575     global idtags idheads idotherrefs mainhead
6576     global linespc lthickness
6577     global canv rowtextx curview fgcolor bgcolor ctxbut
6578     global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6579     global tagbgcolor tagfgcolor tagoutlinecolor
6580     global reflinecolor
6581
6582     set marks {}
6583     set ntags 0
6584     set nheads 0
6585     set singletag 0
6586     set maxtags 3
6587     set maxtagpct 25
6588     set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6589     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6590     set extra [expr {$delta + $lthickness + $linespc}]
6591
6592     if {[info exists idtags($id)]} {
6593         set marks $idtags($id)
6594         set ntags [llength $marks]
6595         if {$ntags > $maxtags ||
6596             [totalwidth $marks mainfont $extra] > $maxwidth} {
6597             # show just a single "n tags..." tag
6598             set singletag 1
6599             if {$ntags == 1} {
6600                 set marks [list "tag..."]
6601             } else {
6602                 set marks [list [format "%d tags..." $ntags]]
6603             }
6604             set ntags 1
6605         }
6606     }
6607     if {[info exists idheads($id)]} {
6608         set marks [concat $marks $idheads($id)]
6609         set nheads [llength $idheads($id)]
6610     }
6611     if {[info exists idotherrefs($id)]} {
6612         set marks [concat $marks $idotherrefs($id)]
6613     }
6614     if {$marks eq {}} {
6615         return $xt
6616     }
6617
6618     set yt [expr {$y1 - 0.5 * $linespc}]
6619     set yb [expr {$yt + $linespc - 1}]
6620     set xvals {}
6621     set wvals {}
6622     set i -1
6623     foreach tag $marks {
6624         incr i
6625         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6626             set wid [font measure mainfontbold $tag]
6627         } else {
6628             set wid [font measure mainfont $tag]
6629         }
6630         lappend xvals $xt
6631         lappend wvals $wid
6632         set xt [expr {$xt + $wid + $extra}]
6633     }
6634     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6635                -width $lthickness -fill $reflinecolor -tags tag.$id]
6636     $canv lower $t
6637     foreach tag $marks x $xvals wid $wvals {
6638         set tag_quoted [string map {% %%} $tag]
6639         set xl [expr {$x + $delta}]
6640         set xr [expr {$x + $delta + $wid + $lthickness}]
6641         set font mainfont
6642         if {[incr ntags -1] >= 0} {
6643             # draw a tag
6644             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6645                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6646                        -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6647                        -tags tag.$id]
6648             if {$singletag} {
6649                 set tagclick [list showtags $id 1]
6650             } else {
6651                 set tagclick [list showtag $tag_quoted 1]
6652             }
6653             $canv bind $t <1> $tagclick
6654             set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6655         } else {
6656             # draw a head or other ref
6657             if {[incr nheads -1] >= 0} {
6658                 set col $headbgcolor
6659                 if {$tag eq $mainhead} {
6660                     set font mainfontbold
6661                 }
6662             } else {
6663                 set col "#ddddff"
6664             }
6665             set xl [expr {$xl - $delta/2}]
6666             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6667                 -width 1 -outline black -fill $col -tags tag.$id
6668             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6669                 set rwid [font measure mainfont $remoteprefix]
6670                 set xi [expr {$x + 1}]
6671                 set yti [expr {$yt + 1}]
6672                 set xri [expr {$x + $rwid}]
6673                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6674                         -width 0 -fill $remotebgcolor -tags tag.$id
6675             }
6676         }
6677         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6678                    -font $font -tags [list tag.$id text]]
6679         if {$ntags >= 0} {
6680             $canv bind $t <1> $tagclick
6681         } elseif {$nheads >= 0} {
6682             $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6683         }
6684     }
6685     return $xt
6686 }
6687
6688 proc drawnotesign {xt y} {
6689     global linespc canv fgcolor
6690
6691     set orad [expr {$linespc / 3}]
6692     set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6693                [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6694                -fill yellow -outline $fgcolor -width 1 -tags circle]
6695     set xt [expr {$xt + $orad * 3}]
6696     return $xt
6697 }
6698
6699 proc xcoord {i level ln} {
6700     global canvx0 xspc1 xspc2
6701
6702     set x [expr {$canvx0 + $i * $xspc1($ln)}]
6703     if {$i > 0 && $i == $level} {
6704         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6705     } elseif {$i > $level} {
6706         set x [expr {$x + $xspc2 - $xspc1($ln)}]
6707     }
6708     return $x
6709 }
6710
6711 proc show_status {msg} {
6712     global canv fgcolor
6713
6714     clear_display
6715     set_window_title
6716     $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6717         -tags text -fill $fgcolor
6718 }
6719
6720 # Don't change the text pane cursor if it is currently the hand cursor,
6721 # showing that we are over a sha1 ID link.
6722 proc settextcursor {c} {
6723     global ctext curtextcursor
6724
6725     if {[$ctext cget -cursor] == $curtextcursor} {
6726         $ctext config -cursor $c
6727     }
6728     set curtextcursor $c
6729 }
6730
6731 proc nowbusy {what {name {}}} {
6732     global isbusy busyname statusw
6733
6734     if {[array names isbusy] eq {}} {
6735         . config -cursor watch
6736         settextcursor watch
6737     }
6738     set isbusy($what) 1
6739     set busyname($what) $name
6740     if {$name ne {}} {
6741         $statusw conf -text $name
6742     }
6743 }
6744
6745 proc notbusy {what} {
6746     global isbusy maincursor textcursor busyname statusw
6747
6748     catch {
6749         unset isbusy($what)
6750         if {$busyname($what) ne {} &&
6751             [$statusw cget -text] eq $busyname($what)} {
6752             $statusw conf -text {}
6753         }
6754     }
6755     if {[array names isbusy] eq {}} {
6756         . config -cursor $maincursor
6757         settextcursor $textcursor
6758     }
6759 }
6760
6761 proc findmatches {f} {
6762     global findtype findstring
6763     if {$findtype == [mc "Regexp"]} {
6764         set matches [regexp -indices -all -inline $findstring $f]
6765     } else {
6766         set fs $findstring
6767         if {$findtype == [mc "IgnCase"]} {
6768             set f [string tolower $f]
6769             set fs [string tolower $fs]
6770         }
6771         set matches {}
6772         set i 0
6773         set l [string length $fs]
6774         while {[set j [string first $fs $f $i]] >= 0} {
6775             lappend matches [list $j [expr {$j+$l-1}]]
6776             set i [expr {$j + $l}]
6777         }
6778     }
6779     return $matches
6780 }
6781
6782 proc dofind {{dirn 1} {wrap 1}} {
6783     global findstring findstartline findcurline selectedline numcommits
6784     global gdttype filehighlight fh_serial find_dirn findallowwrap
6785
6786     if {[info exists find_dirn]} {
6787         if {$find_dirn == $dirn} return
6788         stopfinding
6789     }
6790     focus .
6791     if {$findstring eq {} || $numcommits == 0} return
6792     if {$selectedline eq {}} {
6793         set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6794     } else {
6795         set findstartline $selectedline
6796     }
6797     set findcurline $findstartline
6798     nowbusy finding [mc "Searching"]
6799     if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6800         after cancel do_file_hl $fh_serial
6801         do_file_hl $fh_serial
6802     }
6803     set find_dirn $dirn
6804     set findallowwrap $wrap
6805     run findmore
6806 }
6807
6808 proc stopfinding {} {
6809     global find_dirn findcurline fprogcoord
6810
6811     if {[info exists find_dirn]} {
6812         unset find_dirn
6813         unset findcurline
6814         notbusy finding
6815         set fprogcoord 0
6816         adjustprogress
6817     }
6818     stopblaming
6819 }
6820
6821 proc findmore {} {
6822     global commitdata commitinfo numcommits findpattern findloc
6823     global findstartline findcurline findallowwrap
6824     global find_dirn gdttype fhighlights fprogcoord
6825     global curview varcorder vrownum varccommits vrowmod
6826
6827     if {![info exists find_dirn]} {
6828         return 0
6829     }
6830     set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6831     set l $findcurline
6832     set moretodo 0
6833     if {$find_dirn > 0} {
6834         incr l
6835         if {$l >= $numcommits} {
6836             set l 0
6837         }
6838         if {$l <= $findstartline} {
6839             set lim [expr {$findstartline + 1}]
6840         } else {
6841             set lim $numcommits
6842             set moretodo $findallowwrap
6843         }
6844     } else {
6845         if {$l == 0} {
6846             set l $numcommits
6847         }
6848         incr l -1
6849         if {$l >= $findstartline} {
6850             set lim [expr {$findstartline - 1}]
6851         } else {
6852             set lim -1
6853             set moretodo $findallowwrap
6854         }
6855     }
6856     set n [expr {($lim - $l) * $find_dirn}]
6857     if {$n > 500} {
6858         set n 500
6859         set moretodo 1
6860     }
6861     if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6862         update_arcrows $curview
6863     }
6864     set found 0
6865     set domore 1
6866     set ai [bsearch $vrownum($curview) $l]
6867     set a [lindex $varcorder($curview) $ai]
6868     set arow [lindex $vrownum($curview) $ai]
6869     set ids [lindex $varccommits($curview,$a)]
6870     set arowend [expr {$arow + [llength $ids]}]
6871     if {$gdttype eq [mc "containing:"]} {
6872         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6873             if {$l < $arow || $l >= $arowend} {
6874                 incr ai $find_dirn
6875                 set a [lindex $varcorder($curview) $ai]
6876                 set arow [lindex $vrownum($curview) $ai]
6877                 set ids [lindex $varccommits($curview,$a)]
6878                 set arowend [expr {$arow + [llength $ids]}]
6879             }
6880             set id [lindex $ids [expr {$l - $arow}]]
6881             # shouldn't happen unless git log doesn't give all the commits...
6882             if {![info exists commitdata($id)] ||
6883                 ![doesmatch $commitdata($id)]} {
6884                 continue
6885             }
6886             if {![info exists commitinfo($id)]} {
6887                 getcommit $id
6888             }
6889             set info $commitinfo($id)
6890             foreach f $info ty $fldtypes {
6891                 if {$ty eq ""} continue
6892                 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6893                     [doesmatch $f]} {
6894                     set found 1
6895                     break
6896                 }
6897             }
6898             if {$found} break
6899         }
6900     } else {
6901         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6902             if {$l < $arow || $l >= $arowend} {
6903                 incr ai $find_dirn
6904                 set a [lindex $varcorder($curview) $ai]
6905                 set arow [lindex $vrownum($curview) $ai]
6906                 set ids [lindex $varccommits($curview,$a)]
6907                 set arowend [expr {$arow + [llength $ids]}]
6908             }
6909             set id [lindex $ids [expr {$l - $arow}]]
6910             if {![info exists fhighlights($id)]} {
6911                 # this sets fhighlights($id) to -1
6912                 askfilehighlight $l $id
6913             }
6914             if {$fhighlights($id) > 0} {
6915                 set found $domore
6916                 break
6917             }
6918             if {$fhighlights($id) < 0} {
6919                 if {$domore} {
6920                     set domore 0
6921                     set findcurline [expr {$l - $find_dirn}]
6922                 }
6923             }
6924         }
6925     }
6926     if {$found || ($domore && !$moretodo)} {
6927         unset findcurline
6928         unset find_dirn
6929         notbusy finding
6930         set fprogcoord 0
6931         adjustprogress
6932         if {$found} {
6933             findselectline $l
6934         } else {
6935             bell
6936         }
6937         return 0
6938     }
6939     if {!$domore} {
6940         flushhighlights
6941     } else {
6942         set findcurline [expr {$l - $find_dirn}]
6943     }
6944     set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6945     if {$n < 0} {
6946         incr n $numcommits
6947     }
6948     set fprogcoord [expr {$n * 1.0 / $numcommits}]
6949     adjustprogress
6950     return $domore
6951 }
6952
6953 proc findselectline {l} {
6954     global findloc commentend ctext findcurline markingmatches gdttype
6955
6956     set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6957     set findcurline $l
6958     selectline $l 1
6959     if {$markingmatches &&
6960         ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6961         # highlight the matches in the comments
6962         set f [$ctext get 1.0 $commentend]
6963         set matches [findmatches $f]
6964         foreach match $matches {
6965             set start [lindex $match 0]
6966             set end [expr {[lindex $match 1] + 1}]
6967             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6968         }
6969     }
6970     drawvisible
6971 }
6972
6973 # mark the bits of a headline or author that match a find string
6974 proc markmatches {canv l str tag matches font row} {
6975     global selectedline
6976
6977     set bbox [$canv bbox $tag]
6978     set x0 [lindex $bbox 0]
6979     set y0 [lindex $bbox 1]
6980     set y1 [lindex $bbox 3]
6981     foreach match $matches {
6982         set start [lindex $match 0]
6983         set end [lindex $match 1]
6984         if {$start > $end} continue
6985         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6986         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6987         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6988                    [expr {$x0+$xlen+2}] $y1 \
6989                    -outline {} -tags [list match$l matches] -fill yellow]
6990         $canv lower $t
6991         if {$row == $selectedline} {
6992             $canv raise $t secsel
6993         }
6994     }
6995 }
6996
6997 proc unmarkmatches {} {
6998     global markingmatches
6999
7000     allcanvs delete matches
7001     set markingmatches 0
7002     stopfinding
7003 }
7004
7005 proc selcanvline {w x y} {
7006     global canv canvy0 ctext linespc
7007     global rowtextx
7008     set ymax [lindex [$canv cget -scrollregion] 3]
7009     if {$ymax == {}} return
7010     set yfrac [lindex [$canv yview] 0]
7011     set y [expr {$y + $yfrac * $ymax}]
7012     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
7013     if {$l < 0} {
7014         set l 0
7015     }
7016     if {$w eq $canv} {
7017         set xmax [lindex [$canv cget -scrollregion] 2]
7018         set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
7019         if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
7020     }
7021     unmarkmatches
7022     selectline $l 1
7023 }
7024
7025 proc commit_descriptor {p} {
7026     global commitinfo
7027     if {![info exists commitinfo($p)]} {
7028         getcommit $p
7029     }
7030     set l "..."
7031     if {[llength $commitinfo($p)] > 1} {
7032         set l [lindex $commitinfo($p) 0]
7033     }
7034     return "$p ($l)\n"
7035 }
7036
7037 # append some text to the ctext widget, and make any SHA1 ID
7038 # that we know about be a clickable link.
7039 # Also look for URLs of the form "http[s]://..." and make them web links.
7040 proc appendwithlinks {text tags} {
7041     global ctext linknum curview
7042
7043     set start [$ctext index "end - 1c"]
7044     $ctext insert end $text $tags
7045     set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
7046     foreach l $links {
7047         set s [lindex $l 0]
7048         set e [lindex $l 1]
7049         set linkid [string range $text $s $e]
7050         incr e
7051         $ctext tag delete link$linknum
7052         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
7053         setlink $linkid link$linknum
7054         incr linknum
7055     }
7056     set wlinks [regexp -indices -all -inline -line \
7057                     {https?://[^[:space:]]+} $text]
7058     foreach l $wlinks {
7059         set s2 [lindex $l 0]
7060         set e2 [lindex $l 1]
7061         set url [string range $text $s2 $e2]
7062         incr e2
7063         $ctext tag delete link$linknum
7064         $ctext tag add link$linknum "$start + $s2 c" "$start + $e2 c"
7065         setwlink $url link$linknum
7066         incr linknum
7067     }
7068 }
7069
7070 proc setlink {id lk} {
7071     global curview ctext pendinglinks
7072     global linkfgcolor
7073
7074     if {[string range $id 0 1] eq "-g"} {
7075       set id [string range $id 2 end]
7076     }
7077
7078     set known 0
7079     if {[string length $id] < 40} {
7080         set matches [longid $id]
7081         if {[llength $matches] > 0} {
7082             if {[llength $matches] > 1} return
7083             set known 1
7084             set id [lindex $matches 0]
7085         }
7086     } else {
7087         set known [commitinview $id $curview]
7088     }
7089     if {$known} {
7090         $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7091         $ctext tag bind $lk <1> [list selbyid $id]
7092         $ctext tag bind $lk <Enter> {linkcursor %W 1}
7093         $ctext tag bind $lk <Leave> {linkcursor %W -1}
7094     } else {
7095         lappend pendinglinks($id) $lk
7096         interestedin $id {makelink %P}
7097     }
7098 }
7099
7100 proc setwlink {url lk} {
7101     global ctext
7102     global linkfgcolor
7103     global web_browser
7104
7105     if {$web_browser eq {}} return
7106     $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7107     $ctext tag bind $lk <1> [list browseweb $url]
7108     $ctext tag bind $lk <Enter> {linkcursor %W 1}
7109     $ctext tag bind $lk <Leave> {linkcursor %W -1}
7110 }
7111
7112 proc appendshortlink {id {pre {}} {post {}}} {
7113     global ctext linknum
7114
7115     $ctext insert end $pre
7116     $ctext tag delete link$linknum
7117     $ctext insert end [string range $id 0 7] link$linknum
7118     $ctext insert end $post
7119     setlink $id link$linknum
7120     incr linknum
7121 }
7122
7123 proc makelink {id} {
7124     global pendinglinks
7125
7126     if {![info exists pendinglinks($id)]} return
7127     foreach lk $pendinglinks($id) {
7128         setlink $id $lk
7129     }
7130     unset pendinglinks($id)
7131 }
7132
7133 proc linkcursor {w inc} {
7134     global linkentercount curtextcursor
7135
7136     if {[incr linkentercount $inc] > 0} {
7137         $w configure -cursor hand2
7138     } else {
7139         $w configure -cursor $curtextcursor
7140         if {$linkentercount < 0} {
7141             set linkentercount 0
7142         }
7143     }
7144 }
7145
7146 proc browseweb {url} {
7147     global web_browser
7148
7149     if {$web_browser eq {}} return
7150     # Use eval here in case $web_browser is a command plus some arguments
7151     if {[catch {eval exec $web_browser [list $url] &} err]} {
7152         error_popup "[mc "Error starting web browser:"] $err"
7153     }
7154 }
7155
7156 proc viewnextline {dir} {
7157     global canv linespc
7158
7159     $canv delete hover
7160     set ymax [lindex [$canv cget -scrollregion] 3]
7161     set wnow [$canv yview]
7162     set wtop [expr {[lindex $wnow 0] * $ymax}]
7163     set newtop [expr {$wtop + $dir * $linespc}]
7164     if {$newtop < 0} {
7165         set newtop 0
7166     } elseif {$newtop > $ymax} {
7167         set newtop $ymax
7168     }
7169     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7170 }
7171
7172 # add a list of tag or branch names at position pos
7173 # returns the number of names inserted
7174 proc appendrefs {pos ids var} {
7175     global ctext linknum curview $var maxrefs visiblerefs mainheadid
7176
7177     if {[catch {$ctext index $pos}]} {
7178         return 0
7179     }
7180     $ctext conf -state normal
7181     $ctext delete $pos "$pos lineend"
7182     set tags {}
7183     foreach id $ids {
7184         foreach tag [set $var\($id\)] {
7185             lappend tags [list $tag $id]
7186         }
7187     }
7188
7189     set sep {}
7190     set tags [lsort -index 0 -decreasing $tags]
7191     set nutags 0
7192
7193     if {[llength $tags] > $maxrefs} {
7194         # If we are displaying heads, and there are too many,
7195         # see if there are some important heads to display.
7196         # Currently that are the current head and heads listed in $visiblerefs option
7197         set itags {}
7198         if {$var eq "idheads"} {
7199             set utags {}
7200             foreach ti $tags {
7201                 set hname [lindex $ti 0]
7202                 set id [lindex $ti 1]
7203                 if {([lsearch -exact $visiblerefs $hname] != -1 || $id eq $mainheadid) &&
7204                     [llength $itags] < $maxrefs} {
7205                     lappend itags $ti
7206                 } else {
7207                     lappend utags $ti
7208                 }
7209             }
7210             set tags $utags
7211         }
7212         if {$itags ne {}} {
7213             set str [mc "and many more"]
7214             set sep " "
7215         } else {
7216             set str [mc "many"]
7217         }
7218         $ctext insert $pos "$str ([llength $tags])"
7219         set nutags [llength $tags]
7220         set tags $itags
7221     }
7222
7223     foreach ti $tags {
7224         set id [lindex $ti 1]
7225         set lk link$linknum
7226         incr linknum
7227         $ctext tag delete $lk
7228         $ctext insert $pos $sep
7229         $ctext insert $pos [lindex $ti 0] $lk
7230         setlink $id $lk
7231         set sep ", "
7232     }
7233     $ctext tag add wwrap "$pos linestart" "$pos lineend"
7234     $ctext conf -state disabled
7235     return [expr {[llength $tags] + $nutags}]
7236 }
7237
7238 # called when we have finished computing the nearby tags
7239 proc dispneartags {delay} {
7240     global selectedline currentid showneartags tagphase
7241
7242     if {$selectedline eq {} || !$showneartags} return
7243     after cancel dispnexttag
7244     if {$delay} {
7245         after 200 dispnexttag
7246         set tagphase -1
7247     } else {
7248         after idle dispnexttag
7249         set tagphase 0
7250     }
7251 }
7252
7253 proc dispnexttag {} {
7254     global selectedline currentid showneartags tagphase ctext
7255
7256     if {$selectedline eq {} || !$showneartags} return
7257     switch -- $tagphase {
7258         0 {
7259             set dtags [desctags $currentid]
7260             if {$dtags ne {}} {
7261                 appendrefs precedes $dtags idtags
7262             }
7263         }
7264         1 {
7265             set atags [anctags $currentid]
7266             if {$atags ne {}} {
7267                 appendrefs follows $atags idtags
7268             }
7269         }
7270         2 {
7271             set dheads [descheads $currentid]
7272             if {$dheads ne {}} {
7273                 if {[appendrefs branch $dheads idheads] > 1
7274                     && [$ctext get "branch -3c"] eq "h"} {
7275                     # turn "Branch" into "Branches"
7276                     $ctext conf -state normal
7277                     $ctext insert "branch -2c" "es"
7278                     $ctext conf -state disabled
7279                 }
7280             }
7281         }
7282     }
7283     if {[incr tagphase] <= 2} {
7284         after idle dispnexttag
7285     }
7286 }
7287
7288 proc make_secsel {id} {
7289     global linehtag linentag linedtag canv canv2 canv3
7290
7291     if {![info exists linehtag($id)]} return
7292     $canv delete secsel
7293     set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7294                -tags secsel -fill [$canv cget -selectbackground]]
7295     $canv lower $t
7296     $canv2 delete secsel
7297     set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7298                -tags secsel -fill [$canv2 cget -selectbackground]]
7299     $canv2 lower $t
7300     $canv3 delete secsel
7301     set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7302                -tags secsel -fill [$canv3 cget -selectbackground]]
7303     $canv3 lower $t
7304 }
7305
7306 proc make_idmark {id} {
7307     global linehtag canv fgcolor
7308
7309     if {![info exists linehtag($id)]} return
7310     $canv delete markid
7311     set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7312                -tags markid -outline $fgcolor]
7313     $canv raise $t
7314 }
7315
7316 proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
7317     global canv ctext commitinfo selectedline
7318     global canvy0 linespc parents children curview
7319     global currentid sha1entry
7320     global commentend idtags linknum
7321     global mergemax numcommits pending_select
7322     global cmitmode showneartags allcommits
7323     global targetrow targetid lastscrollrows
7324     global autoselect autosellen jump_to_here
7325     global vinlinediff
7326
7327     unset -nocomplain pending_select
7328     $canv delete hover
7329     normalline
7330     unsel_reflist
7331     stopfinding
7332     if {$l < 0 || $l >= $numcommits} return
7333     set id [commitonrow $l]
7334     set targetid $id
7335     set targetrow $l
7336     set selectedline $l
7337     set currentid $id
7338     if {$lastscrollrows < $numcommits} {
7339         setcanvscroll
7340     }
7341
7342     if {$cmitmode ne "patch" && $switch_to_patch} {
7343         set cmitmode "patch"
7344     }
7345
7346     set y [expr {$canvy0 + $l * $linespc}]
7347     set ymax [lindex [$canv cget -scrollregion] 3]
7348     set ytop [expr {$y - $linespc - 1}]
7349     set ybot [expr {$y + $linespc + 1}]
7350     set wnow [$canv yview]
7351     set wtop [expr {[lindex $wnow 0] * $ymax}]
7352     set wbot [expr {[lindex $wnow 1] * $ymax}]
7353     set wh [expr {$wbot - $wtop}]
7354     set newtop $wtop
7355     if {$ytop < $wtop} {
7356         if {$ybot < $wtop} {
7357             set newtop [expr {$y - $wh / 2.0}]
7358         } else {
7359             set newtop $ytop
7360             if {$newtop > $wtop - $linespc} {
7361                 set newtop [expr {$wtop - $linespc}]
7362             }
7363         }
7364     } elseif {$ybot > $wbot} {
7365         if {$ytop > $wbot} {
7366             set newtop [expr {$y - $wh / 2.0}]
7367         } else {
7368             set newtop [expr {$ybot - $wh}]
7369             if {$newtop < $wtop + $linespc} {
7370                 set newtop [expr {$wtop + $linespc}]
7371             }
7372         }
7373     }
7374     if {$newtop != $wtop} {
7375         if {$newtop < 0} {
7376             set newtop 0
7377         }
7378         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7379         drawvisible
7380     }
7381
7382     make_secsel $id
7383
7384     if {$isnew} {
7385         addtohistory [list selbyid $id 0] savecmitpos
7386     }
7387
7388     $sha1entry delete 0 end
7389     $sha1entry insert 0 $id
7390     if {$autoselect} {
7391         $sha1entry selection range 0 $autosellen
7392     }
7393     rhighlight_sel $id
7394
7395     $ctext conf -state normal
7396     clear_ctext
7397     set linknum 0
7398     if {![info exists commitinfo($id)]} {
7399         getcommit $id
7400     }
7401     set info $commitinfo($id)
7402     set date [formatdate [lindex $info 2]]
7403     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7404     set date [formatdate [lindex $info 4]]
7405     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7406     if {[info exists idtags($id)]} {
7407         $ctext insert end [mc "Tags:"]
7408         foreach tag $idtags($id) {
7409             $ctext insert end " $tag"
7410         }
7411         $ctext insert end "\n"
7412     }
7413
7414     set headers {}
7415     set olds $parents($curview,$id)
7416     if {[llength $olds] > 1} {
7417         set np 0
7418         foreach p $olds {
7419             if {$np >= $mergemax} {
7420                 set tag mmax
7421             } else {
7422                 set tag m$np
7423             }
7424             $ctext insert end "[mc "Parent"]: " $tag
7425             appendwithlinks [commit_descriptor $p] {}
7426             incr np
7427         }
7428     } else {
7429         foreach p $olds {
7430             append headers "[mc "Parent"]: [commit_descriptor $p]"
7431         }
7432     }
7433
7434     foreach c $children($curview,$id) {
7435         append headers "[mc "Child"]:  [commit_descriptor $c]"
7436     }
7437
7438     # make anything that looks like a SHA1 ID be a clickable link
7439     appendwithlinks $headers {}
7440     if {$showneartags} {
7441         if {![info exists allcommits]} {
7442             getallcommits
7443         }
7444         $ctext insert end "[mc "Branch"]: "
7445         $ctext mark set branch "end -1c"
7446         $ctext mark gravity branch left
7447         $ctext insert end "\n[mc "Follows"]: "
7448         $ctext mark set follows "end -1c"
7449         $ctext mark gravity follows left
7450         $ctext insert end "\n[mc "Precedes"]: "
7451         $ctext mark set precedes "end -1c"
7452         $ctext mark gravity precedes left
7453         $ctext insert end "\n"
7454         dispneartags 1
7455     }
7456     $ctext insert end "\n"
7457     set comment [lindex $info 5]
7458     if {[string first "\r" $comment] >= 0} {
7459         set comment [string map {"\r" "\n    "} $comment]
7460     }
7461     appendwithlinks $comment {comment}
7462
7463     $ctext tag remove found 1.0 end
7464     $ctext conf -state disabled
7465     set commentend [$ctext index "end - 1c"]
7466
7467     set jump_to_here $desired_loc
7468     init_flist [mc "Comments"]
7469     if {$cmitmode eq "tree"} {
7470         gettree $id
7471     } elseif {$vinlinediff($curview) == 1} {
7472         showinlinediff $id
7473     } elseif {[llength $olds] <= 1} {
7474         startdiff $id
7475     } else {
7476         mergediff $id
7477     }
7478 }
7479
7480 proc selfirstline {} {
7481     unmarkmatches
7482     selectline 0 1
7483 }
7484
7485 proc sellastline {} {
7486     global numcommits
7487     unmarkmatches
7488     set l [expr {$numcommits - 1}]
7489     selectline $l 1
7490 }
7491
7492 proc selnextline {dir} {
7493     global selectedline
7494     focus .
7495     if {$selectedline eq {}} return
7496     set l [expr {$selectedline + $dir}]
7497     unmarkmatches
7498     selectline $l 1
7499 }
7500
7501 proc selnextpage {dir} {
7502     global canv linespc selectedline numcommits
7503
7504     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7505     if {$lpp < 1} {
7506         set lpp 1
7507     }
7508     allcanvs yview scroll [expr {$dir * $lpp}] units
7509     drawvisible
7510     if {$selectedline eq {}} return
7511     set l [expr {$selectedline + $dir * $lpp}]
7512     if {$l < 0} {
7513         set l 0
7514     } elseif {$l >= $numcommits} {
7515         set l [expr $numcommits - 1]
7516     }
7517     unmarkmatches
7518     selectline $l 1
7519 }
7520
7521 proc unselectline {} {
7522     global selectedline currentid
7523
7524     set selectedline {}
7525     unset -nocomplain currentid
7526     allcanvs delete secsel
7527     rhighlight_none
7528 }
7529
7530 proc reselectline {} {
7531     global selectedline
7532
7533     if {$selectedline ne {}} {
7534         selectline $selectedline 0
7535     }
7536 }
7537
7538 proc addtohistory {cmd {saveproc {}}} {
7539     global history historyindex curview
7540
7541     unset_posvars
7542     save_position
7543     set elt [list $curview $cmd $saveproc {}]
7544     if {$historyindex > 0
7545         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7546         return
7547     }
7548
7549     if {$historyindex < [llength $history]} {
7550         set history [lreplace $history $historyindex end $elt]
7551     } else {
7552         lappend history $elt
7553     }
7554     incr historyindex
7555     if {$historyindex > 1} {
7556         .tf.bar.leftbut conf -state normal
7557     } else {
7558         .tf.bar.leftbut conf -state disabled
7559     }
7560     .tf.bar.rightbut conf -state disabled
7561 }
7562
7563 # save the scrolling position of the diff display pane
7564 proc save_position {} {
7565     global historyindex history
7566
7567     if {$historyindex < 1} return
7568     set hi [expr {$historyindex - 1}]
7569     set fn [lindex $history $hi 2]
7570     if {$fn ne {}} {
7571         lset history $hi 3 [eval $fn]
7572     }
7573 }
7574
7575 proc unset_posvars {} {
7576     global last_posvars
7577
7578     if {[info exists last_posvars]} {
7579         foreach {var val} $last_posvars {
7580             global $var
7581             unset -nocomplain $var
7582         }
7583         unset last_posvars
7584     }
7585 }
7586
7587 proc godo {elt} {
7588     global curview last_posvars
7589
7590     set view [lindex $elt 0]
7591     set cmd [lindex $elt 1]
7592     set pv [lindex $elt 3]
7593     if {$curview != $view} {
7594         showview $view
7595     }
7596     unset_posvars
7597     foreach {var val} $pv {
7598         global $var
7599         set $var $val
7600     }
7601     set last_posvars $pv
7602     eval $cmd
7603 }
7604
7605 proc goback {} {
7606     global history historyindex
7607     focus .
7608
7609     if {$historyindex > 1} {
7610         save_position
7611         incr historyindex -1
7612         godo [lindex $history [expr {$historyindex - 1}]]
7613         .tf.bar.rightbut conf -state normal
7614     }
7615     if {$historyindex <= 1} {
7616         .tf.bar.leftbut conf -state disabled
7617     }
7618 }
7619
7620 proc goforw {} {
7621     global history historyindex
7622     focus .
7623
7624     if {$historyindex < [llength $history]} {
7625         save_position
7626         set cmd [lindex $history $historyindex]
7627         incr historyindex
7628         godo $cmd
7629         .tf.bar.leftbut conf -state normal
7630     }
7631     if {$historyindex >= [llength $history]} {
7632         .tf.bar.rightbut conf -state disabled
7633     }
7634 }
7635
7636 proc go_to_parent {i} {
7637     global parents curview targetid
7638     set ps $parents($curview,$targetid)
7639     if {[llength $ps] >= $i} {
7640         selbyid [lindex $ps [expr $i - 1]]
7641     }
7642 }
7643
7644 proc gettree {id} {
7645     global treefilelist treeidlist diffids diffmergeid treepending
7646     global nullid nullid2
7647
7648     set diffids $id
7649     unset -nocomplain diffmergeid
7650     if {![info exists treefilelist($id)]} {
7651         if {![info exists treepending]} {
7652             if {$id eq $nullid} {
7653                 set cmd [list | git ls-files]
7654             } elseif {$id eq $nullid2} {
7655                 set cmd [list | git ls-files --stage -t]
7656             } else {
7657                 set cmd [list | git ls-tree -r $id]
7658             }
7659             if {[catch {set gtf [open $cmd r]}]} {
7660                 return
7661             }
7662             set treepending $id
7663             set treefilelist($id) {}
7664             set treeidlist($id) {}
7665             fconfigure $gtf -blocking 0 -encoding binary
7666             filerun $gtf [list gettreeline $gtf $id]
7667         }
7668     } else {
7669         setfilelist $id
7670     }
7671 }
7672
7673 proc gettreeline {gtf id} {
7674     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7675
7676     set nl 0
7677     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7678         if {$diffids eq $nullid} {
7679             set fname $line
7680         } else {
7681             set i [string first "\t" $line]
7682             if {$i < 0} continue
7683             set fname [string range $line [expr {$i+1}] end]
7684             set line [string range $line 0 [expr {$i-1}]]
7685             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7686             set sha1 [lindex $line 2]
7687             lappend treeidlist($id) $sha1
7688         }
7689         if {[string index $fname 0] eq "\""} {
7690             set fname [lindex $fname 0]
7691         }
7692         set fname [encoding convertfrom $fname]
7693         lappend treefilelist($id) $fname
7694     }
7695     if {![eof $gtf]} {
7696         return [expr {$nl >= 1000? 2: 1}]
7697     }
7698     close $gtf
7699     unset treepending
7700     if {$cmitmode ne "tree"} {
7701         if {![info exists diffmergeid]} {
7702             gettreediffs $diffids
7703         }
7704     } elseif {$id ne $diffids} {
7705         gettree $diffids
7706     } else {
7707         setfilelist $id
7708     }
7709     return 0
7710 }
7711
7712 proc showfile {f} {
7713     global treefilelist treeidlist diffids nullid nullid2
7714     global ctext_file_names ctext_file_lines
7715     global ctext commentend
7716
7717     set i [lsearch -exact $treefilelist($diffids) $f]
7718     if {$i < 0} {
7719         puts "oops, $f not in list for id $diffids"
7720         return
7721     }
7722     if {$diffids eq $nullid} {
7723         if {[catch {set bf [open $f r]} err]} {
7724             puts "oops, can't read $f: $err"
7725             return
7726         }
7727     } else {
7728         set blob [lindex $treeidlist($diffids) $i]
7729         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7730             puts "oops, error reading blob $blob: $err"
7731             return
7732         }
7733     }
7734     fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7735     filerun $bf [list getblobline $bf $diffids]
7736     $ctext config -state normal
7737     clear_ctext $commentend
7738     lappend ctext_file_names $f
7739     lappend ctext_file_lines [lindex [split $commentend "."] 0]
7740     $ctext insert end "\n"
7741     $ctext insert end "$f\n" filesep
7742     $ctext config -state disabled
7743     $ctext yview $commentend
7744     settabs 0
7745 }
7746
7747 proc getblobline {bf id} {
7748     global diffids cmitmode ctext
7749
7750     if {$id ne $diffids || $cmitmode ne "tree"} {
7751         catch {close $bf}
7752         return 0
7753     }
7754     $ctext config -state normal
7755     set nl 0
7756     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7757         $ctext insert end "$line\n"
7758     }
7759     if {[eof $bf]} {
7760         global jump_to_here ctext_file_names commentend
7761
7762         # delete last newline
7763         $ctext delete "end - 2c" "end - 1c"
7764         close $bf
7765         if {$jump_to_here ne {} &&
7766             [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7767             set lnum [expr {[lindex $jump_to_here 1] +
7768                             [lindex [split $commentend .] 0]}]
7769             mark_ctext_line $lnum
7770         }
7771         $ctext config -state disabled
7772         return 0
7773     }
7774     $ctext config -state disabled
7775     return [expr {$nl >= 1000? 2: 1}]
7776 }
7777
7778 proc mark_ctext_line {lnum} {
7779     global ctext markbgcolor
7780
7781     $ctext tag delete omark
7782     $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7783     $ctext tag conf omark -background $markbgcolor
7784     $ctext see $lnum.0
7785 }
7786
7787 proc mergediff {id} {
7788     global diffmergeid
7789     global diffids treediffs
7790     global parents curview
7791
7792     set diffmergeid $id
7793     set diffids $id
7794     set treediffs($id) {}
7795     set np [llength $parents($curview,$id)]
7796     settabs $np
7797     getblobdiffs $id
7798 }
7799
7800 proc startdiff {ids} {
7801     global treediffs diffids treepending diffmergeid nullid nullid2
7802
7803     settabs 1
7804     set diffids $ids
7805     unset -nocomplain diffmergeid
7806     if {![info exists treediffs($ids)] ||
7807         [lsearch -exact $ids $nullid] >= 0 ||
7808         [lsearch -exact $ids $nullid2] >= 0} {
7809         if {![info exists treepending]} {
7810             gettreediffs $ids
7811         }
7812     } else {
7813         addtocflist $ids
7814     }
7815 }
7816
7817 proc showinlinediff {ids} {
7818     global commitinfo commitdata ctext
7819     global treediffs
7820
7821     set info $commitinfo($ids)
7822     set diff [lindex $info 7]
7823     set difflines [split $diff "\n"]
7824
7825     initblobdiffvars
7826     set treediff {}
7827
7828     set inhdr 0
7829     foreach line $difflines {
7830         if {![string compare -length 5 "diff " $line]} {
7831             set inhdr 1
7832         } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7833             # offset also accounts for the b/ prefix
7834             lappend treediff [string range $line 6 end]
7835             set inhdr 0
7836         }
7837     }
7838
7839     set treediffs($ids) $treediff
7840     add_flist $treediff
7841
7842     $ctext conf -state normal
7843     foreach line $difflines {
7844         parseblobdiffline $ids $line
7845     }
7846     maybe_scroll_ctext 1
7847     $ctext conf -state disabled
7848 }
7849
7850 # If the filename (name) is under any of the passed filter paths
7851 # then return true to include the file in the listing.
7852 proc path_filter {filter name} {
7853     set worktree [gitworktree]
7854     foreach p $filter {
7855         set fq_p [file normalize $p]
7856         set fq_n [file normalize [file join $worktree $name]]
7857         if {[string match [file normalize $fq_p]* $fq_n]} {
7858             return 1
7859         }
7860     }
7861     return 0
7862 }
7863
7864 proc addtocflist {ids} {
7865     global treediffs
7866
7867     add_flist $treediffs($ids)
7868     getblobdiffs $ids
7869 }
7870
7871 proc diffcmd {ids flags} {
7872     global log_showroot nullid nullid2 git_version
7873
7874     set i [lsearch -exact $ids $nullid]
7875     set j [lsearch -exact $ids $nullid2]
7876     if {$i >= 0} {
7877         if {[llength $ids] > 1 && $j < 0} {
7878             # comparing working directory with some specific revision
7879             set cmd [concat | git diff-index $flags]
7880             if {$i == 0} {
7881                 lappend cmd -R [lindex $ids 1]
7882             } else {
7883                 lappend cmd [lindex $ids 0]
7884             }
7885         } else {
7886             # comparing working directory with index
7887             set cmd [concat | git diff-files $flags]
7888             if {$j == 1} {
7889                 lappend cmd -R
7890             }
7891         }
7892     } elseif {$j >= 0} {
7893         if {[package vcompare $git_version "1.7.2"] >= 0} {
7894             set flags "$flags --ignore-submodules=dirty"
7895         }
7896         set cmd [concat | git diff-index --cached $flags]
7897         if {[llength $ids] > 1} {
7898             # comparing index with specific revision
7899             if {$j == 0} {
7900                 lappend cmd -R [lindex $ids 1]
7901             } else {
7902                 lappend cmd [lindex $ids 0]
7903             }
7904         } else {
7905             # comparing index with HEAD
7906             lappend cmd HEAD
7907         }
7908     } else {
7909         if {$log_showroot} {
7910             lappend flags --root
7911         }
7912         set cmd [concat | git diff-tree -r $flags $ids]
7913     }
7914     return $cmd
7915 }
7916
7917 proc gettreediffs {ids} {
7918     global treediff treepending limitdiffs vfilelimit curview
7919
7920     set cmd [diffcmd $ids {--no-commit-id}]
7921     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7922             set cmd [concat $cmd -- $vfilelimit($curview)]
7923     }
7924     if {[catch {set gdtf [open $cmd r]}]} return
7925
7926     set treepending $ids
7927     set treediff {}
7928     fconfigure $gdtf -blocking 0 -encoding binary
7929     filerun $gdtf [list gettreediffline $gdtf $ids]
7930 }
7931
7932 proc gettreediffline {gdtf ids} {
7933     global treediff treediffs treepending diffids diffmergeid
7934     global cmitmode vfilelimit curview limitdiffs perfile_attrs
7935
7936     set nr 0
7937     set sublist {}
7938     set max 1000
7939     if {$perfile_attrs} {
7940         # cache_gitattr is slow, and even slower on win32 where we
7941         # have to invoke it for only about 30 paths at a time
7942         set max 500
7943         if {[tk windowingsystem] == "win32"} {
7944             set max 120
7945         }
7946     }
7947     while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7948         set i [string first "\t" $line]
7949         if {$i >= 0} {
7950             set file [string range $line [expr {$i+1}] end]
7951             if {[string index $file 0] eq "\""} {
7952                 set file [lindex $file 0]
7953             }
7954             set file [encoding convertfrom $file]
7955             if {$file ne [lindex $treediff end]} {
7956                 lappend treediff $file
7957                 lappend sublist $file
7958             }
7959         }
7960     }
7961     if {$perfile_attrs} {
7962         cache_gitattr encoding $sublist
7963     }
7964     if {![eof $gdtf]} {
7965         return [expr {$nr >= $max? 2: 1}]
7966     }
7967     close $gdtf
7968     set treediffs($ids) $treediff
7969     unset treepending
7970     if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7971         gettree $diffids
7972     } elseif {$ids != $diffids} {
7973         if {![info exists diffmergeid]} {
7974             gettreediffs $diffids
7975         }
7976     } else {
7977         addtocflist $ids
7978     }
7979     return 0
7980 }
7981
7982 # empty string or positive integer
7983 proc diffcontextvalidate {v} {
7984     return [regexp {^(|[1-9][0-9]*)$} $v]
7985 }
7986
7987 proc diffcontextchange {n1 n2 op} {
7988     global diffcontextstring diffcontext
7989
7990     if {[string is integer -strict $diffcontextstring]} {
7991         if {$diffcontextstring >= 0} {
7992             set diffcontext $diffcontextstring
7993             reselectline
7994         }
7995     }
7996 }
7997
7998 proc changeignorespace {} {
7999     reselectline
8000 }
8001
8002 proc changeworddiff {name ix op} {
8003     reselectline
8004 }
8005
8006 proc initblobdiffvars {} {
8007     global diffencoding targetline diffnparents
8008     global diffinhdr currdiffsubmod diffseehere
8009     set targetline {}
8010     set diffnparents 0
8011     set diffinhdr 0
8012     set diffencoding [get_path_encoding {}]
8013     set currdiffsubmod ""
8014     set diffseehere -1
8015 }
8016
8017 proc getblobdiffs {ids} {
8018     global blobdifffd diffids env
8019     global treediffs
8020     global diffcontext
8021     global ignorespace
8022     global worddiff
8023     global limitdiffs vfilelimit curview
8024     global git_version
8025
8026     set textconv {}
8027     if {[package vcompare $git_version "1.6.1"] >= 0} {
8028         set textconv "--textconv"
8029     }
8030     set submodule {}
8031     if {[package vcompare $git_version "1.6.6"] >= 0} {
8032         set submodule "--submodule"
8033     }
8034     set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
8035     if {$ignorespace} {
8036         append cmd " -w"
8037     }
8038     if {$worddiff ne [mc "Line diff"]} {
8039         append cmd " --word-diff=porcelain"
8040     }
8041     if {$limitdiffs && $vfilelimit($curview) ne {}} {
8042         set cmd [concat $cmd -- $vfilelimit($curview)]
8043     }
8044     if {[catch {set bdf [open $cmd r]} err]} {
8045         error_popup [mc "Error getting diffs: %s" $err]
8046         return
8047     }
8048     fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
8049     set blobdifffd($ids) $bdf
8050     initblobdiffvars
8051     filerun $bdf [list getblobdiffline $bdf $diffids]
8052 }
8053
8054 proc savecmitpos {} {
8055     global ctext cmitmode
8056
8057     if {$cmitmode eq "tree"} {
8058         return {}
8059     }
8060     return [list target_scrollpos [$ctext index @0,0]]
8061 }
8062
8063 proc savectextpos {} {
8064     global ctext
8065
8066     return [list target_scrollpos [$ctext index @0,0]]
8067 }
8068
8069 proc maybe_scroll_ctext {ateof} {
8070     global ctext target_scrollpos
8071
8072     if {![info exists target_scrollpos]} return
8073     if {!$ateof} {
8074         set nlines [expr {[winfo height $ctext]
8075                           / [font metrics textfont -linespace]}]
8076         if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
8077     }
8078     $ctext yview $target_scrollpos
8079     unset target_scrollpos
8080 }
8081
8082 proc setinlist {var i val} {
8083     global $var
8084
8085     while {[llength [set $var]] < $i} {
8086         lappend $var {}
8087     }
8088     if {[llength [set $var]] == $i} {
8089         lappend $var $val
8090     } else {
8091         lset $var $i $val
8092     }
8093 }
8094
8095 proc makediffhdr {fname ids} {
8096     global ctext curdiffstart treediffs diffencoding
8097     global ctext_file_names jump_to_here targetline diffline
8098
8099     set fname [encoding convertfrom $fname]
8100     set diffencoding [get_path_encoding $fname]
8101     set i [lsearch -exact $treediffs($ids) $fname]
8102     if {$i >= 0} {
8103         setinlist difffilestart $i $curdiffstart
8104     }
8105     lset ctext_file_names end $fname
8106     set l [expr {(78 - [string length $fname]) / 2}]
8107     set pad [string range "----------------------------------------" 1 $l]
8108     $ctext insert $curdiffstart "$pad $fname $pad" filesep
8109     set targetline {}
8110     if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
8111         set targetline [lindex $jump_to_here 1]
8112     }
8113     set diffline 0
8114 }
8115
8116 proc blobdiffmaybeseehere {ateof} {
8117     global diffseehere
8118     if {$diffseehere >= 0} {
8119         mark_ctext_line [lindex [split $diffseehere .] 0]
8120     }
8121     maybe_scroll_ctext $ateof
8122 }
8123
8124 proc getblobdiffline {bdf ids} {
8125     global diffids blobdifffd
8126     global ctext
8127
8128     set nr 0
8129     $ctext conf -state normal
8130     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
8131         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
8132             # Older diff read. Abort it.
8133             catch {close $bdf}
8134             if {$ids != $diffids} {
8135                 array unset blobdifffd $ids
8136             }
8137             return 0
8138         }
8139         parseblobdiffline $ids $line
8140     }
8141     $ctext conf -state disabled
8142     blobdiffmaybeseehere [eof $bdf]
8143     if {[eof $bdf]} {
8144         catch {close $bdf}
8145         array unset blobdifffd $ids
8146         return 0
8147     }
8148     return [expr {$nr >= 1000? 2: 1}]
8149 }
8150
8151 proc parseblobdiffline {ids line} {
8152     global ctext curdiffstart
8153     global diffnexthead diffnextnote difffilestart
8154     global ctext_file_names ctext_file_lines
8155     global diffinhdr treediffs mergemax diffnparents
8156     global diffencoding jump_to_here targetline diffline currdiffsubmod
8157     global worddiff diffseehere
8158
8159     if {![string compare -length 5 "diff " $line]} {
8160         if {![regexp {^diff (--cc|--git) } $line m type]} {
8161             set line [encoding convertfrom $line]
8162             $ctext insert end "$line\n" hunksep
8163             continue
8164         }
8165         # start of a new file
8166         set diffinhdr 1
8167         set currdiffsubmod ""
8168
8169         $ctext insert end "\n"
8170         set curdiffstart [$ctext index "end - 1c"]
8171         lappend ctext_file_names ""
8172         lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8173         $ctext insert end "\n" filesep
8174
8175         if {$type eq "--cc"} {
8176             # start of a new file in a merge diff
8177             set fname [string range $line 10 end]
8178             if {[lsearch -exact $treediffs($ids) $fname] < 0} {
8179                 lappend treediffs($ids) $fname
8180                 add_flist [list $fname]
8181             }
8182
8183         } else {
8184             set line [string range $line 11 end]
8185             # If the name hasn't changed the length will be odd,
8186             # the middle char will be a space, and the two bits either
8187             # side will be a/name and b/name, or "a/name" and "b/name".
8188             # If the name has changed we'll get "rename from" and
8189             # "rename to" or "copy from" and "copy to" lines following
8190             # this, and we'll use them to get the filenames.
8191             # This complexity is necessary because spaces in the
8192             # filename(s) don't get escaped.
8193             set l [string length $line]
8194             set i [expr {$l / 2}]
8195             if {!(($l & 1) && [string index $line $i] eq " " &&
8196                   [string range $line 2 [expr {$i - 1}]] eq \
8197                       [string range $line [expr {$i + 3}] end])} {
8198                 return
8199             }
8200             # unescape if quoted and chop off the a/ from the front
8201             if {[string index $line 0] eq "\""} {
8202                 set fname [string range [lindex $line 0] 2 end]
8203             } else {
8204                 set fname [string range $line 2 [expr {$i - 1}]]
8205             }
8206         }
8207         makediffhdr $fname $ids
8208
8209     } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8210         set fname [encoding convertfrom [string range $line 16 end]]
8211         $ctext insert end "\n"
8212         set curdiffstart [$ctext index "end - 1c"]
8213         lappend ctext_file_names $fname
8214         lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8215         $ctext insert end "$line\n" filesep
8216         set i [lsearch -exact $treediffs($ids) $fname]
8217         if {$i >= 0} {
8218             setinlist difffilestart $i $curdiffstart
8219         }
8220
8221     } elseif {![string compare -length 2 "@@" $line]} {
8222         regexp {^@@+} $line ats
8223         set line [encoding convertfrom $diffencoding $line]
8224         $ctext insert end "$line\n" hunksep
8225         if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8226             set diffline $nl
8227         }
8228         set diffnparents [expr {[string length $ats] - 1}]
8229         set diffinhdr 0
8230
8231     } elseif {![string compare -length 10 "Submodule " $line]} {
8232         # start of a new submodule
8233         if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8234             set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8235         } else {
8236             set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8237         }
8238         if {$currdiffsubmod != $fname} {
8239             $ctext insert end "\n";     # Add newline after commit message
8240         }
8241         if {$currdiffsubmod != $fname} {
8242             set curdiffstart [$ctext index "end - 1c"]
8243             lappend ctext_file_names ""
8244             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8245             makediffhdr $fname $ids
8246             set currdiffsubmod $fname
8247             $ctext insert end "\n$line\n" filesep
8248         } else {
8249             $ctext insert end "$line\n" filesep
8250         }
8251     } elseif {$currdiffsubmod != "" && ![string compare -length 3 "  >" $line]} {
8252         set line [encoding convertfrom $diffencoding $line]
8253         $ctext insert end "$line\n" dresult
8254     } elseif {$currdiffsubmod != "" && ![string compare -length 3 "  <" $line]} {
8255         set line [encoding convertfrom $diffencoding $line]
8256         $ctext insert end "$line\n" d0
8257     } elseif {$diffinhdr} {
8258         if {![string compare -length 12 "rename from " $line]} {
8259             set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8260             if {[string index $fname 0] eq "\""} {
8261                 set fname [lindex $fname 0]
8262             }
8263             set fname [encoding convertfrom $fname]
8264             set i [lsearch -exact $treediffs($ids) $fname]
8265             if {$i >= 0} {
8266                 setinlist difffilestart $i $curdiffstart
8267             }
8268         } elseif {![string compare -length 10 $line "rename to "] ||
8269                   ![string compare -length 8 $line "copy to "]} {
8270             set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8271             if {[string index $fname 0] eq "\""} {
8272                 set fname [lindex $fname 0]
8273             }
8274             makediffhdr $fname $ids
8275         } elseif {[string compare -length 3 $line "---"] == 0} {
8276             # do nothing
8277             return
8278         } elseif {[string compare -length 3 $line "+++"] == 0} {
8279             set diffinhdr 0
8280             return
8281         }
8282         $ctext insert end "$line\n" filesep
8283
8284     } else {
8285         set line [string map {\x1A ^Z} \
8286                       [encoding convertfrom $diffencoding $line]]
8287         # parse the prefix - one ' ', '-' or '+' for each parent
8288         set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8289         set tag [expr {$diffnparents > 1? "m": "d"}]
8290         set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8291         set words_pre_markup ""
8292         set words_post_markup ""
8293         if {[string trim $prefix " -+"] eq {}} {
8294             # prefix only has " ", "-" and "+" in it: normal diff line
8295             set num [string first "-" $prefix]
8296             if {$dowords} {
8297                 set line [string range $line 1 end]
8298             }
8299             if {$num >= 0} {
8300                 # removed line, first parent with line is $num
8301                 if {$num >= $mergemax} {
8302                     set num "max"
8303                 }
8304                 if {$dowords && $worddiff eq [mc "Markup words"]} {
8305                     $ctext insert end "\[-$line-\]" $tag$num
8306                 } else {
8307                     $ctext insert end "$line" $tag$num
8308                 }
8309                 if {!$dowords} {
8310                     $ctext insert end "\n" $tag$num
8311                 }
8312             } else {
8313                 set tags {}
8314                 if {[string first "+" $prefix] >= 0} {
8315                     # added line
8316                     lappend tags ${tag}result
8317                     if {$diffnparents > 1} {
8318                         set num [string first " " $prefix]
8319                         if {$num >= 0} {
8320                             if {$num >= $mergemax} {
8321                                 set num "max"
8322                             }
8323                             lappend tags m$num
8324                         }
8325                     }
8326                     set words_pre_markup "{+"
8327                     set words_post_markup "+}"
8328                 }
8329                 if {$targetline ne {}} {
8330                     if {$diffline == $targetline} {
8331                         set diffseehere [$ctext index "end - 1 chars"]
8332                         set targetline {}
8333                     } else {
8334                         incr diffline
8335                     }
8336                 }
8337                 if {$dowords && $worddiff eq [mc "Markup words"]} {
8338                     $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8339                 } else {
8340                     $ctext insert end "$line" $tags
8341                 }
8342                 if {!$dowords} {
8343                     $ctext insert end "\n" $tags
8344                 }
8345             }
8346         } elseif {$dowords && $prefix eq "~"} {
8347             $ctext insert end "\n" {}
8348         } else {
8349             # "\ No newline at end of file",
8350             # or something else we don't recognize
8351             $ctext insert end "$line\n" hunksep
8352         }
8353     }
8354 }
8355
8356 proc changediffdisp {} {
8357     global ctext diffelide
8358
8359     $ctext tag conf d0 -elide [lindex $diffelide 0]
8360     $ctext tag conf dresult -elide [lindex $diffelide 1]
8361 }
8362
8363 proc highlightfile {cline} {
8364     global cflist cflist_top
8365
8366     if {![info exists cflist_top]} return
8367
8368     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8369     $cflist tag add highlight $cline.0 "$cline.0 lineend"
8370     $cflist see $cline.0
8371     set cflist_top $cline
8372 }
8373
8374 proc highlightfile_for_scrollpos {topidx} {
8375     global cmitmode difffilestart
8376
8377     if {$cmitmode eq "tree"} return
8378     if {![info exists difffilestart]} return
8379
8380     set top [lindex [split $topidx .] 0]
8381     if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8382         highlightfile 0
8383     } else {
8384         highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8385     }
8386 }
8387
8388 proc prevfile {} {
8389     global difffilestart ctext cmitmode
8390
8391     if {$cmitmode eq "tree"} return
8392     set prev 0.0
8393     set here [$ctext index @0,0]
8394     foreach loc $difffilestart {
8395         if {[$ctext compare $loc >= $here]} {
8396             $ctext yview $prev
8397             return
8398         }
8399         set prev $loc
8400     }
8401     $ctext yview $prev
8402 }
8403
8404 proc nextfile {} {
8405     global difffilestart ctext cmitmode
8406
8407     if {$cmitmode eq "tree"} return
8408     set here [$ctext index @0,0]
8409     foreach loc $difffilestart {
8410         if {[$ctext compare $loc > $here]} {
8411             $ctext yview $loc
8412             return
8413         }
8414     }
8415 }
8416
8417 proc clear_ctext {{first 1.0}} {
8418     global ctext smarktop smarkbot
8419     global ctext_file_names ctext_file_lines
8420     global pendinglinks
8421
8422     set l [lindex [split $first .] 0]
8423     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8424         set smarktop $l
8425     }
8426     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8427         set smarkbot $l
8428     }
8429     $ctext delete $first end
8430     if {$first eq "1.0"} {
8431         unset -nocomplain pendinglinks
8432     }
8433     set ctext_file_names {}
8434     set ctext_file_lines {}
8435 }
8436
8437 proc settabs {{firstab {}}} {
8438     global firsttabstop tabstop ctext have_tk85
8439
8440     if {$firstab ne {} && $have_tk85} {
8441         set firsttabstop $firstab
8442     }
8443     set w [font measure textfont "0"]
8444     if {$firsttabstop != 0} {
8445         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8446                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8447     } elseif {$have_tk85 || $tabstop != 8} {
8448         $ctext conf -tabs [expr {$tabstop * $w}]
8449     } else {
8450         $ctext conf -tabs {}
8451     }
8452 }
8453
8454 proc incrsearch {name ix op} {
8455     global ctext searchstring searchdirn
8456
8457     if {[catch {$ctext index anchor}]} {
8458         # no anchor set, use start of selection, or of visible area
8459         set sel [$ctext tag ranges sel]
8460         if {$sel ne {}} {
8461             $ctext mark set anchor [lindex $sel 0]
8462         } elseif {$searchdirn eq "-forwards"} {
8463             $ctext mark set anchor @0,0
8464         } else {
8465             $ctext mark set anchor @0,[winfo height $ctext]
8466         }
8467     }
8468     if {$searchstring ne {}} {
8469         set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8470         if {$here ne {}} {
8471             $ctext see $here
8472             set mend "$here + $mlen c"
8473             $ctext tag remove sel 1.0 end
8474             $ctext tag add sel $here $mend
8475             suppress_highlighting_file_for_current_scrollpos
8476             highlightfile_for_scrollpos $here
8477         }
8478     }
8479     rehighlight_search_results
8480 }
8481
8482 proc dosearch {} {
8483     global sstring ctext searchstring searchdirn
8484
8485     focus $sstring
8486     $sstring icursor end
8487     set searchdirn -forwards
8488     if {$searchstring ne {}} {
8489         set sel [$ctext tag ranges sel]
8490         if {$sel ne {}} {
8491             set start "[lindex $sel 0] + 1c"
8492         } elseif {[catch {set start [$ctext index anchor]}]} {
8493             set start "@0,0"
8494         }
8495         set match [$ctext search -count mlen -- $searchstring $start]
8496         $ctext tag remove sel 1.0 end
8497         if {$match eq {}} {
8498             bell
8499             return
8500         }
8501         $ctext see $match
8502         suppress_highlighting_file_for_current_scrollpos
8503         highlightfile_for_scrollpos $match
8504         set mend "$match + $mlen c"
8505         $ctext tag add sel $match $mend
8506         $ctext mark unset anchor
8507         rehighlight_search_results
8508     }
8509 }
8510
8511 proc dosearchback {} {
8512     global sstring ctext searchstring searchdirn
8513
8514     focus $sstring
8515     $sstring icursor end
8516     set searchdirn -backwards
8517     if {$searchstring ne {}} {
8518         set sel [$ctext tag ranges sel]
8519         if {$sel ne {}} {
8520             set start [lindex $sel 0]
8521         } elseif {[catch {set start [$ctext index anchor]}]} {
8522             set start @0,[winfo height $ctext]
8523         }
8524         set match [$ctext search -backwards -count ml -- $searchstring $start]
8525         $ctext tag remove sel 1.0 end
8526         if {$match eq {}} {
8527             bell
8528             return
8529         }
8530         $ctext see $match
8531         suppress_highlighting_file_for_current_scrollpos
8532         highlightfile_for_scrollpos $match
8533         set mend "$match + $ml c"
8534         $ctext tag add sel $match $mend
8535         $ctext mark unset anchor
8536         rehighlight_search_results
8537     }
8538 }
8539
8540 proc rehighlight_search_results {} {
8541     global ctext searchstring
8542
8543     $ctext tag remove found 1.0 end
8544     $ctext tag remove currentsearchhit 1.0 end
8545
8546     if {$searchstring ne {}} {
8547         searchmarkvisible 1
8548     }
8549 }
8550
8551 proc searchmark {first last} {
8552     global ctext searchstring
8553
8554     set sel [$ctext tag ranges sel]
8555
8556     set mend $first.0
8557     while {1} {
8558         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8559         if {$match eq {}} break
8560         set mend "$match + $mlen c"
8561         if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8562             $ctext tag add currentsearchhit $match $mend
8563         } else {
8564             $ctext tag add found $match $mend
8565         }
8566     }
8567 }
8568
8569 proc searchmarkvisible {doall} {
8570     global ctext smarktop smarkbot
8571
8572     set topline [lindex [split [$ctext index @0,0] .] 0]
8573     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8574     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8575         # no overlap with previous
8576         searchmark $topline $botline
8577         set smarktop $topline
8578         set smarkbot $botline
8579     } else {
8580         if {$topline < $smarktop} {
8581             searchmark $topline [expr {$smarktop-1}]
8582             set smarktop $topline
8583         }
8584         if {$botline > $smarkbot} {
8585             searchmark [expr {$smarkbot+1}] $botline
8586             set smarkbot $botline
8587         }
8588     }
8589 }
8590
8591 proc suppress_highlighting_file_for_current_scrollpos {} {
8592     global ctext suppress_highlighting_file_for_this_scrollpos
8593
8594     set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8595 }
8596
8597 proc scrolltext {f0 f1} {
8598     global searchstring cmitmode ctext
8599     global suppress_highlighting_file_for_this_scrollpos
8600
8601     set topidx [$ctext index @0,0]
8602     if {![info exists suppress_highlighting_file_for_this_scrollpos]
8603         || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8604         highlightfile_for_scrollpos $topidx
8605     }
8606
8607     unset -nocomplain suppress_highlighting_file_for_this_scrollpos
8608
8609     .bleft.bottom.sb set $f0 $f1
8610     if {$searchstring ne {}} {
8611         searchmarkvisible 0
8612     }
8613 }
8614
8615 proc setcoords {} {
8616     global linespc charspc canvx0 canvy0
8617     global xspc1 xspc2 lthickness
8618
8619     set linespc [font metrics mainfont -linespace]
8620     set charspc [font measure mainfont "m"]
8621     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8622     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8623     set lthickness [expr {int($linespc / 9) + 1}]
8624     set xspc1(0) $linespc
8625     set xspc2 $linespc
8626 }
8627
8628 proc redisplay {} {
8629     global canv
8630     global selectedline
8631
8632     set ymax [lindex [$canv cget -scrollregion] 3]
8633     if {$ymax eq {} || $ymax == 0} return
8634     set span [$canv yview]
8635     clear_display
8636     setcanvscroll
8637     allcanvs yview moveto [lindex $span 0]
8638     drawvisible
8639     if {$selectedline ne {}} {
8640         selectline $selectedline 0
8641         allcanvs yview moveto [lindex $span 0]
8642     }
8643 }
8644
8645 proc parsefont {f n} {
8646     global fontattr
8647
8648     set fontattr($f,family) [lindex $n 0]
8649     set s [lindex $n 1]
8650     if {$s eq {} || $s == 0} {
8651         set s 10
8652     } elseif {$s < 0} {
8653         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8654     }
8655     set fontattr($f,size) $s
8656     set fontattr($f,weight) normal
8657     set fontattr($f,slant) roman
8658     foreach style [lrange $n 2 end] {
8659         switch -- $style {
8660             "normal" -
8661             "bold"   {set fontattr($f,weight) $style}
8662             "roman" -
8663             "italic" {set fontattr($f,slant) $style}
8664         }
8665     }
8666 }
8667
8668 proc fontflags {f {isbold 0}} {
8669     global fontattr
8670
8671     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8672                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8673                 -slant $fontattr($f,slant)]
8674 }
8675
8676 proc fontname {f} {
8677     global fontattr
8678
8679     set n [list $fontattr($f,family) $fontattr($f,size)]
8680     if {$fontattr($f,weight) eq "bold"} {
8681         lappend n "bold"
8682     }
8683     if {$fontattr($f,slant) eq "italic"} {
8684         lappend n "italic"
8685     }
8686     return $n
8687 }
8688
8689 proc incrfont {inc} {
8690     global mainfont textfont ctext canv cflist showrefstop
8691     global stopped entries fontattr
8692
8693     unmarkmatches
8694     set s $fontattr(mainfont,size)
8695     incr s $inc
8696     if {$s < 1} {
8697         set s 1
8698     }
8699     set fontattr(mainfont,size) $s
8700     font config mainfont -size $s
8701     font config mainfontbold -size $s
8702     set mainfont [fontname mainfont]
8703     set s $fontattr(textfont,size)
8704     incr s $inc
8705     if {$s < 1} {
8706         set s 1
8707     }
8708     set fontattr(textfont,size) $s
8709     font config textfont -size $s
8710     font config textfontbold -size $s
8711     set textfont [fontname textfont]
8712     setcoords
8713     settabs
8714     redisplay
8715 }
8716
8717 proc clearsha1 {} {
8718     global sha1entry sha1string
8719     if {[string length $sha1string] == 40} {
8720         $sha1entry delete 0 end
8721     }
8722 }
8723
8724 proc sha1change {n1 n2 op} {
8725     global sha1string currentid sha1but
8726     if {$sha1string == {}
8727         || ([info exists currentid] && $sha1string == $currentid)} {
8728         set state disabled
8729     } else {
8730         set state normal
8731     }
8732     if {[$sha1but cget -state] == $state} return
8733     if {$state == "normal"} {
8734         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8735     } else {
8736         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8737     }
8738 }
8739
8740 proc gotocommit {} {
8741     global sha1string tagids headids curview varcid
8742
8743     if {$sha1string == {}
8744         || ([info exists currentid] && $sha1string == $currentid)} return
8745     if {[info exists tagids($sha1string)]} {
8746         set id $tagids($sha1string)
8747     } elseif {[info exists headids($sha1string)]} {
8748         set id $headids($sha1string)
8749     } else {
8750         set id [string tolower $sha1string]
8751         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8752             set matches [longid $id]
8753             if {$matches ne {}} {
8754                 if {[llength $matches] > 1} {
8755                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8756                     return
8757                 }
8758                 set id [lindex $matches 0]
8759             }
8760         } else {
8761             if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8762                 error_popup [mc "Revision %s is not known" $sha1string]
8763                 return
8764             }
8765         }
8766     }
8767     if {[commitinview $id $curview]} {
8768         selectline [rowofcommit $id] 1
8769         return
8770     }
8771     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8772         set msg [mc "SHA1 id %s is not known" $sha1string]
8773     } else {
8774         set msg [mc "Revision %s is not in the current view" $sha1string]
8775     }
8776     error_popup $msg
8777 }
8778
8779 proc lineenter {x y id} {
8780     global hoverx hovery hoverid hovertimer
8781     global commitinfo canv
8782
8783     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8784     set hoverx $x
8785     set hovery $y
8786     set hoverid $id
8787     if {[info exists hovertimer]} {
8788         after cancel $hovertimer
8789     }
8790     set hovertimer [after 500 linehover]
8791     $canv delete hover
8792 }
8793
8794 proc linemotion {x y id} {
8795     global hoverx hovery hoverid hovertimer
8796
8797     if {[info exists hoverid] && $id == $hoverid} {
8798         set hoverx $x
8799         set hovery $y
8800         if {[info exists hovertimer]} {
8801             after cancel $hovertimer
8802         }
8803         set hovertimer [after 500 linehover]
8804     }
8805 }
8806
8807 proc lineleave {id} {
8808     global hoverid hovertimer canv
8809
8810     if {[info exists hoverid] && $id == $hoverid} {
8811         $canv delete hover
8812         if {[info exists hovertimer]} {
8813             after cancel $hovertimer
8814             unset hovertimer
8815         }
8816         unset hoverid
8817     }
8818 }
8819
8820 proc linehover {} {
8821     global hoverx hovery hoverid hovertimer
8822     global canv linespc lthickness
8823     global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8824
8825     global commitinfo
8826
8827     set text [lindex $commitinfo($hoverid) 0]
8828     set ymax [lindex [$canv cget -scrollregion] 3]
8829     if {$ymax == {}} return
8830     set yfrac [lindex [$canv yview] 0]
8831     set x [expr {$hoverx + 2 * $linespc}]
8832     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8833     set x0 [expr {$x - 2 * $lthickness}]
8834     set y0 [expr {$y - 2 * $lthickness}]
8835     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8836     set y1 [expr {$y + $linespc + 2 * $lthickness}]
8837     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8838                -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8839                -width 1 -tags hover]
8840     $canv raise $t
8841     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8842                -font mainfont -fill $linehoverfgcolor]
8843     $canv raise $t
8844 }
8845
8846 proc clickisonarrow {id y} {
8847     global lthickness
8848
8849     set ranges [rowranges $id]
8850     set thresh [expr {2 * $lthickness + 6}]
8851     set n [expr {[llength $ranges] - 1}]
8852     for {set i 1} {$i < $n} {incr i} {
8853         set row [lindex $ranges $i]
8854         if {abs([yc $row] - $y) < $thresh} {
8855             return $i
8856         }
8857     }
8858     return {}
8859 }
8860
8861 proc arrowjump {id n y} {
8862     global canv
8863
8864     # 1 <-> 2, 3 <-> 4, etc...
8865     set n [expr {(($n - 1) ^ 1) + 1}]
8866     set row [lindex [rowranges $id] $n]
8867     set yt [yc $row]
8868     set ymax [lindex [$canv cget -scrollregion] 3]
8869     if {$ymax eq {} || $ymax <= 0} return
8870     set view [$canv yview]
8871     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8872     set yfrac [expr {$yt / $ymax - $yspan / 2}]
8873     if {$yfrac < 0} {
8874         set yfrac 0
8875     }
8876     allcanvs yview moveto $yfrac
8877 }
8878
8879 proc lineclick {x y id isnew} {
8880     global ctext commitinfo children canv thickerline curview
8881
8882     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8883     unmarkmatches
8884     unselectline
8885     normalline
8886     $canv delete hover
8887     # draw this line thicker than normal
8888     set thickerline $id
8889     drawlines $id
8890     if {$isnew} {
8891         set ymax [lindex [$canv cget -scrollregion] 3]
8892         if {$ymax eq {}} return
8893         set yfrac [lindex [$canv yview] 0]
8894         set y [expr {$y + $yfrac * $ymax}]
8895     }
8896     set dirn [clickisonarrow $id $y]
8897     if {$dirn ne {}} {
8898         arrowjump $id $dirn $y
8899         return
8900     }
8901
8902     if {$isnew} {
8903         addtohistory [list lineclick $x $y $id 0] savectextpos
8904     }
8905     # fill the details pane with info about this line
8906     $ctext conf -state normal
8907     clear_ctext
8908     settabs 0
8909     $ctext insert end "[mc "Parent"]:\t"
8910     $ctext insert end $id link0
8911     setlink $id link0
8912     set info $commitinfo($id)
8913     $ctext insert end "\n\t[lindex $info 0]\n"
8914     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8915     set date [formatdate [lindex $info 2]]
8916     $ctext insert end "\t[mc "Date"]:\t$date\n"
8917     set kids $children($curview,$id)
8918     if {$kids ne {}} {
8919         $ctext insert end "\n[mc "Children"]:"
8920         set i 0
8921         foreach child $kids {
8922             incr i
8923             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8924             set info $commitinfo($child)
8925             $ctext insert end "\n\t"
8926             $ctext insert end $child link$i
8927             setlink $child link$i
8928             $ctext insert end "\n\t[lindex $info 0]"
8929             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8930             set date [formatdate [lindex $info 2]]
8931             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8932         }
8933     }
8934     maybe_scroll_ctext 1
8935     $ctext conf -state disabled
8936     init_flist {}
8937 }
8938
8939 proc normalline {} {
8940     global thickerline
8941     if {[info exists thickerline]} {
8942         set id $thickerline
8943         unset thickerline
8944         drawlines $id
8945     }
8946 }
8947
8948 proc selbyid {id {isnew 1}} {
8949     global curview
8950     if {[commitinview $id $curview]} {
8951         selectline [rowofcommit $id] $isnew
8952     }
8953 }
8954
8955 proc mstime {} {
8956     global startmstime
8957     if {![info exists startmstime]} {
8958         set startmstime [clock clicks -milliseconds]
8959     }
8960     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8961 }
8962
8963 proc rowmenu {x y id} {
8964     global rowctxmenu selectedline rowmenuid curview
8965     global nullid nullid2 fakerowmenu mainhead markedid
8966
8967     stopfinding
8968     set rowmenuid $id
8969     if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8970         set state disabled
8971     } else {
8972         set state normal
8973     }
8974     if {[info exists markedid] && $markedid ne $id} {
8975         set mstate normal
8976     } else {
8977         set mstate disabled
8978     }
8979     if {$id ne $nullid && $id ne $nullid2} {
8980         set menu $rowctxmenu
8981         if {$mainhead ne {}} {
8982             $menu entryconfigure 8 -label [mc "Reset %s branch to here" $mainhead] -state normal
8983         } else {
8984             $menu entryconfigure 8 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8985         }
8986         $menu entryconfigure 10 -state $mstate
8987         $menu entryconfigure 11 -state $mstate
8988         $menu entryconfigure 12 -state $mstate
8989     } else {
8990         set menu $fakerowmenu
8991     }
8992     $menu entryconfigure [mca "Diff this -> selected"] -state $state
8993     $menu entryconfigure [mca "Diff selected -> this"] -state $state
8994     $menu entryconfigure [mca "Make patch"] -state $state
8995     $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8996     $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8997     tk_popup $menu $x $y
8998 }
8999
9000 proc markhere {} {
9001     global rowmenuid markedid canv
9002
9003     set markedid $rowmenuid
9004     make_idmark $markedid
9005 }
9006
9007 proc gotomark {} {
9008     global markedid
9009
9010     if {[info exists markedid]} {
9011         selbyid $markedid
9012     }
9013 }
9014
9015 proc replace_by_kids {l r} {
9016     global curview children
9017
9018     set id [commitonrow $r]
9019     set l [lreplace $l 0 0]
9020     foreach kid $children($curview,$id) {
9021         lappend l [rowofcommit $kid]
9022     }
9023     return [lsort -integer -decreasing -unique $l]
9024 }
9025
9026 proc find_common_desc {} {
9027     global markedid rowmenuid curview children
9028
9029     if {![info exists markedid]} return
9030     if {![commitinview $markedid $curview] ||
9031         ![commitinview $rowmenuid $curview]} return
9032     #set t1 [clock clicks -milliseconds]
9033     set l1 [list [rowofcommit $markedid]]
9034     set l2 [list [rowofcommit $rowmenuid]]
9035     while 1 {
9036         set r1 [lindex $l1 0]
9037         set r2 [lindex $l2 0]
9038         if {$r1 eq {} || $r2 eq {}} break
9039         if {$r1 == $r2} {
9040             selectline $r1 1
9041             break
9042         }
9043         if {$r1 > $r2} {
9044             set l1 [replace_by_kids $l1 $r1]
9045         } else {
9046             set l2 [replace_by_kids $l2 $r2]
9047         }
9048     }
9049     #set t2 [clock clicks -milliseconds]
9050     #puts "took [expr {$t2-$t1}]ms"
9051 }
9052
9053 proc compare_commits {} {
9054     global markedid rowmenuid curview children
9055
9056     if {![info exists markedid]} return
9057     if {![commitinview $markedid $curview]} return
9058     addtohistory [list do_cmp_commits $markedid $rowmenuid]
9059     do_cmp_commits $markedid $rowmenuid
9060 }
9061
9062 proc getpatchid {id} {
9063     global patchids
9064
9065     if {![info exists patchids($id)]} {
9066         set cmd [diffcmd [list $id] {-p --root}]
9067         # trim off the initial "|"
9068         set cmd [lrange $cmd 1 end]
9069         if {[catch {
9070             set x [eval exec $cmd | git patch-id]
9071             set patchids($id) [lindex $x 0]
9072         }]} {
9073             set patchids($id) "error"
9074         }
9075     }
9076     return $patchids($id)
9077 }
9078
9079 proc do_cmp_commits {a b} {
9080     global ctext curview parents children patchids commitinfo
9081
9082     $ctext conf -state normal
9083     clear_ctext
9084     init_flist {}
9085     for {set i 0} {$i < 100} {incr i} {
9086         set skipa 0
9087         set skipb 0
9088         if {[llength $parents($curview,$a)] > 1} {
9089             appendshortlink $a [mc "Skipping merge commit "] "\n"
9090             set skipa 1
9091         } else {
9092             set patcha [getpatchid $a]
9093         }
9094         if {[llength $parents($curview,$b)] > 1} {
9095             appendshortlink $b [mc "Skipping merge commit "] "\n"
9096             set skipb 1
9097         } else {
9098             set patchb [getpatchid $b]
9099         }
9100         if {!$skipa && !$skipb} {
9101             set heada [lindex $commitinfo($a) 0]
9102             set headb [lindex $commitinfo($b) 0]
9103             if {$patcha eq "error"} {
9104                 appendshortlink $a [mc "Error getting patch ID for "] \
9105                     [mc " - stopping\n"]
9106                 break
9107             }
9108             if {$patchb eq "error"} {
9109                 appendshortlink $b [mc "Error getting patch ID for "] \
9110                     [mc " - stopping\n"]
9111                 break
9112             }
9113             if {$patcha eq $patchb} {
9114                 if {$heada eq $headb} {
9115                     appendshortlink $a [mc "Commit "]
9116                     appendshortlink $b " == " "  $heada\n"
9117                 } else {
9118                     appendshortlink $a [mc "Commit "] "  $heada\n"
9119                     appendshortlink $b [mc " is the same patch as\n       "] \
9120                         "  $headb\n"
9121                 }
9122                 set skipa 1
9123                 set skipb 1
9124             } else {
9125                 $ctext insert end "\n"
9126                 appendshortlink $a [mc "Commit "] "  $heada\n"
9127                 appendshortlink $b [mc " differs from\n       "] \
9128                     "  $headb\n"
9129                 $ctext insert end [mc "Diff of commits:\n\n"]
9130                 $ctext conf -state disabled
9131                 update
9132                 diffcommits $a $b
9133                 return
9134             }
9135         }
9136         if {$skipa} {
9137             set kids [real_children $curview,$a]
9138             if {[llength $kids] != 1} {
9139                 $ctext insert end "\n"
9140                 appendshortlink $a [mc "Commit "] \
9141                     [mc " has %s children - stopping\n" [llength $kids]]
9142                 break
9143             }
9144             set a [lindex $kids 0]
9145         }
9146         if {$skipb} {
9147             set kids [real_children $curview,$b]
9148             if {[llength $kids] != 1} {
9149                 appendshortlink $b [mc "Commit "] \
9150                     [mc " has %s children - stopping\n" [llength $kids]]
9151                 break
9152             }
9153             set b [lindex $kids 0]
9154         }
9155     }
9156     $ctext conf -state disabled
9157 }
9158
9159 proc diffcommits {a b} {
9160     global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
9161
9162     set tmpdir [gitknewtmpdir]
9163     set fna [file join $tmpdir "commit-[string range $a 0 7]"]
9164     set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
9165     if {[catch {
9166         exec git diff-tree -p --pretty $a >$fna
9167         exec git diff-tree -p --pretty $b >$fnb
9168     } err]} {
9169         error_popup [mc "Error writing commit to file: %s" $err]
9170         return
9171     }
9172     if {[catch {
9173         set fd [open "| diff -U$diffcontext $fna $fnb" r]
9174     } err]} {
9175         error_popup [mc "Error diffing commits: %s" $err]
9176         return
9177     }
9178     set diffids [list commits $a $b]
9179     set blobdifffd($diffids) $fd
9180     set diffinhdr 0
9181     set currdiffsubmod ""
9182     filerun $fd [list getblobdiffline $fd $diffids]
9183 }
9184
9185 proc diffvssel {dirn} {
9186     global rowmenuid selectedline
9187
9188     if {$selectedline eq {}} return
9189     if {$dirn} {
9190         set oldid [commitonrow $selectedline]
9191         set newid $rowmenuid
9192     } else {
9193         set oldid $rowmenuid
9194         set newid [commitonrow $selectedline]
9195     }
9196     addtohistory [list doseldiff $oldid $newid] savectextpos
9197     doseldiff $oldid $newid
9198 }
9199
9200 proc diffvsmark {dirn} {
9201     global rowmenuid markedid
9202
9203     if {![info exists markedid]} return
9204     if {$dirn} {
9205         set oldid $markedid
9206         set newid $rowmenuid
9207     } else {
9208         set oldid $rowmenuid
9209         set newid $markedid
9210     }
9211     addtohistory [list doseldiff $oldid $newid] savectextpos
9212     doseldiff $oldid $newid
9213 }
9214
9215 proc doseldiff {oldid newid} {
9216     global ctext
9217     global commitinfo
9218
9219     $ctext conf -state normal
9220     clear_ctext
9221     init_flist [mc "Top"]
9222     $ctext insert end "[mc "From"] "
9223     $ctext insert end $oldid link0
9224     setlink $oldid link0
9225     $ctext insert end "\n     "
9226     $ctext insert end [lindex $commitinfo($oldid) 0]
9227     $ctext insert end "\n\n[mc "To"]   "
9228     $ctext insert end $newid link1
9229     setlink $newid link1
9230     $ctext insert end "\n     "
9231     $ctext insert end [lindex $commitinfo($newid) 0]
9232     $ctext insert end "\n"
9233     $ctext conf -state disabled
9234     $ctext tag remove found 1.0 end
9235     startdiff [list $oldid $newid]
9236 }
9237
9238 proc mkpatch {} {
9239     global rowmenuid currentid commitinfo patchtop patchnum NS
9240
9241     if {![info exists currentid]} return
9242     set oldid $currentid
9243     set oldhead [lindex $commitinfo($oldid) 0]
9244     set newid $rowmenuid
9245     set newhead [lindex $commitinfo($newid) 0]
9246     set top .patch
9247     set patchtop $top
9248     catch {destroy $top}
9249     ttk_toplevel $top
9250     make_transient $top .
9251     ${NS}::label $top.title -text [mc "Generate patch"]
9252     grid $top.title - -pady 10
9253     ${NS}::label $top.from -text [mc "From:"]
9254     ${NS}::entry $top.fromsha1 -width 40
9255     $top.fromsha1 insert 0 $oldid
9256     $top.fromsha1 conf -state readonly
9257     grid $top.from $top.fromsha1 -sticky w
9258     ${NS}::entry $top.fromhead -width 60
9259     $top.fromhead insert 0 $oldhead
9260     $top.fromhead conf -state readonly
9261     grid x $top.fromhead -sticky w
9262     ${NS}::label $top.to -text [mc "To:"]
9263     ${NS}::entry $top.tosha1 -width 40
9264     $top.tosha1 insert 0 $newid
9265     $top.tosha1 conf -state readonly
9266     grid $top.to $top.tosha1 -sticky w
9267     ${NS}::entry $top.tohead -width 60
9268     $top.tohead insert 0 $newhead
9269     $top.tohead conf -state readonly
9270     grid x $top.tohead -sticky w
9271     ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9272     grid $top.rev x -pady 10 -padx 5
9273     ${NS}::label $top.flab -text [mc "Output file:"]
9274     ${NS}::entry $top.fname -width 60
9275     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9276     incr patchnum
9277     grid $top.flab $top.fname -sticky w
9278     ${NS}::frame $top.buts
9279     ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9280     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9281     bind $top <Key-Return> mkpatchgo
9282     bind $top <Key-Escape> mkpatchcan
9283     grid $top.buts.gen $top.buts.can
9284     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9285     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9286     grid $top.buts - -pady 10 -sticky ew
9287     focus $top.fname
9288 }
9289
9290 proc mkpatchrev {} {
9291     global patchtop
9292
9293     set oldid [$patchtop.fromsha1 get]
9294     set oldhead [$patchtop.fromhead get]
9295     set newid [$patchtop.tosha1 get]
9296     set newhead [$patchtop.tohead get]
9297     foreach e [list fromsha1 fromhead tosha1 tohead] \
9298             v [list $newid $newhead $oldid $oldhead] {
9299         $patchtop.$e conf -state normal
9300         $patchtop.$e delete 0 end
9301         $patchtop.$e insert 0 $v
9302         $patchtop.$e conf -state readonly
9303     }
9304 }
9305
9306 proc mkpatchgo {} {
9307     global patchtop nullid nullid2
9308
9309     set oldid [$patchtop.fromsha1 get]
9310     set newid [$patchtop.tosha1 get]
9311     set fname [$patchtop.fname get]
9312     set cmd [diffcmd [list $oldid $newid] -p]
9313     # trim off the initial "|"
9314     set cmd [lrange $cmd 1 end]
9315     lappend cmd >$fname &
9316     if {[catch {eval exec $cmd} err]} {
9317         error_popup "[mc "Error creating patch:"] $err" $patchtop
9318     }
9319     catch {destroy $patchtop}
9320     unset patchtop
9321 }
9322
9323 proc mkpatchcan {} {
9324     global patchtop
9325
9326     catch {destroy $patchtop}
9327     unset patchtop
9328 }
9329
9330 proc mktag {} {
9331     global rowmenuid mktagtop commitinfo NS
9332
9333     set top .maketag
9334     set mktagtop $top
9335     catch {destroy $top}
9336     ttk_toplevel $top
9337     make_transient $top .
9338     ${NS}::label $top.title -text [mc "Create tag"]
9339     grid $top.title - -pady 10
9340     ${NS}::label $top.id -text [mc "ID:"]
9341     ${NS}::entry $top.sha1 -width 40
9342     $top.sha1 insert 0 $rowmenuid
9343     $top.sha1 conf -state readonly
9344     grid $top.id $top.sha1 -sticky w
9345     ${NS}::entry $top.head -width 60
9346     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9347     $top.head conf -state readonly
9348     grid x $top.head -sticky w
9349     ${NS}::label $top.tlab -text [mc "Tag name:"]
9350     ${NS}::entry $top.tag -width 60
9351     grid $top.tlab $top.tag -sticky w
9352     ${NS}::label $top.op -text [mc "Tag message is optional"]
9353     grid $top.op -columnspan 2 -sticky we
9354     ${NS}::label $top.mlab -text [mc "Tag message:"]
9355     ${NS}::entry $top.msg -width 60
9356     grid $top.mlab $top.msg -sticky w
9357     ${NS}::frame $top.buts
9358     ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9359     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9360     bind $top <Key-Return> mktaggo
9361     bind $top <Key-Escape> mktagcan
9362     grid $top.buts.gen $top.buts.can
9363     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9364     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9365     grid $top.buts - -pady 10 -sticky ew
9366     focus $top.tag
9367 }
9368
9369 proc domktag {} {
9370     global mktagtop env tagids idtags
9371
9372     set id [$mktagtop.sha1 get]
9373     set tag [$mktagtop.tag get]
9374     set msg [$mktagtop.msg get]
9375     if {$tag == {}} {
9376         error_popup [mc "No tag name specified"] $mktagtop
9377         return 0
9378     }
9379     if {[info exists tagids($tag)]} {
9380         error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9381         return 0
9382     }
9383     if {[catch {
9384         if {$msg != {}} {
9385             exec git tag -a -m $msg $tag $id
9386         } else {
9387             exec git tag $tag $id
9388         }
9389     } err]} {
9390         error_popup "[mc "Error creating tag:"] $err" $mktagtop
9391         return 0
9392     }
9393
9394     set tagids($tag) $id
9395     lappend idtags($id) $tag
9396     redrawtags $id
9397     addedtag $id
9398     dispneartags 0
9399     run refill_reflist
9400     return 1
9401 }
9402
9403 proc redrawtags {id} {
9404     global canv linehtag idpos currentid curview cmitlisted markedid
9405     global canvxmax iddrawn circleitem mainheadid circlecolors
9406     global mainheadcirclecolor
9407
9408     if {![commitinview $id $curview]} return
9409     if {![info exists iddrawn($id)]} return
9410     set row [rowofcommit $id]
9411     if {$id eq $mainheadid} {
9412         set ofill $mainheadcirclecolor
9413     } else {
9414         set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9415     }
9416     $canv itemconf $circleitem($row) -fill $ofill
9417     $canv delete tag.$id
9418     set xt [eval drawtags $id $idpos($id)]
9419     $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9420     set text [$canv itemcget $linehtag($id) -text]
9421     set font [$canv itemcget $linehtag($id) -font]
9422     set xr [expr {$xt + [font measure $font $text]}]
9423     if {$xr > $canvxmax} {
9424         set canvxmax $xr
9425         setcanvscroll
9426     }
9427     if {[info exists currentid] && $currentid == $id} {
9428         make_secsel $id
9429     }
9430     if {[info exists markedid] && $markedid eq $id} {
9431         make_idmark $id
9432     }
9433 }
9434
9435 proc mktagcan {} {
9436     global mktagtop
9437
9438     catch {destroy $mktagtop}
9439     unset mktagtop
9440 }
9441
9442 proc mktaggo {} {
9443     if {![domktag]} return
9444     mktagcan
9445 }
9446
9447 proc copyreference {} {
9448     global rowmenuid autosellen
9449
9450     set format "%h (\"%s\", %ad)"
9451     set cmd [list git show -s --pretty=format:$format --date=short]
9452     if {$autosellen < 40} {
9453         lappend cmd --abbrev=$autosellen
9454     }
9455     set reference [eval exec $cmd $rowmenuid]
9456
9457     clipboard clear
9458     clipboard append $reference
9459 }
9460
9461 proc writecommit {} {
9462     global rowmenuid wrcomtop commitinfo wrcomcmd NS
9463
9464     set top .writecommit
9465     set wrcomtop $top
9466     catch {destroy $top}
9467     ttk_toplevel $top
9468     make_transient $top .
9469     ${NS}::label $top.title -text [mc "Write commit to file"]
9470     grid $top.title - -pady 10
9471     ${NS}::label $top.id -text [mc "ID:"]
9472     ${NS}::entry $top.sha1 -width 40
9473     $top.sha1 insert 0 $rowmenuid
9474     $top.sha1 conf -state readonly
9475     grid $top.id $top.sha1 -sticky w
9476     ${NS}::entry $top.head -width 60
9477     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9478     $top.head conf -state readonly
9479     grid x $top.head -sticky w
9480     ${NS}::label $top.clab -text [mc "Command:"]
9481     ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9482     grid $top.clab $top.cmd -sticky w -pady 10
9483     ${NS}::label $top.flab -text [mc "Output file:"]
9484     ${NS}::entry $top.fname -width 60
9485     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9486     grid $top.flab $top.fname -sticky w
9487     ${NS}::frame $top.buts
9488     ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9489     ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9490     bind $top <Key-Return> wrcomgo
9491     bind $top <Key-Escape> wrcomcan
9492     grid $top.buts.gen $top.buts.can
9493     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9494     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9495     grid $top.buts - -pady 10 -sticky ew
9496     focus $top.fname
9497 }
9498
9499 proc wrcomgo {} {
9500     global wrcomtop
9501
9502     set id [$wrcomtop.sha1 get]
9503     set cmd "echo $id | [$wrcomtop.cmd get]"
9504     set fname [$wrcomtop.fname get]
9505     if {[catch {exec sh -c $cmd >$fname &} err]} {
9506         error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9507     }
9508     catch {destroy $wrcomtop}
9509     unset wrcomtop
9510 }
9511
9512 proc wrcomcan {} {
9513     global wrcomtop
9514
9515     catch {destroy $wrcomtop}
9516     unset wrcomtop
9517 }
9518
9519 proc mkbranch {} {
9520     global NS rowmenuid
9521
9522     set top .branchdialog
9523
9524     set val(name) ""
9525     set val(id) $rowmenuid
9526     set val(command) [list mkbrgo $top]
9527
9528     set ui(title) [mc "Create branch"]
9529     set ui(accept) [mc "Create"]
9530
9531     branchdia $top val ui
9532 }
9533
9534 proc mvbranch {} {
9535     global NS
9536     global headmenuid headmenuhead
9537
9538     set top .branchdialog
9539
9540     set val(name) $headmenuhead
9541     set val(id) $headmenuid
9542     set val(command) [list mvbrgo $top $headmenuhead]
9543
9544     set ui(title) [mc "Rename branch %s" $headmenuhead]
9545     set ui(accept) [mc "Rename"]
9546
9547     branchdia $top val ui
9548 }
9549
9550 proc branchdia {top valvar uivar} {
9551     global NS commitinfo
9552     upvar $valvar val $uivar ui
9553
9554     catch {destroy $top}
9555     ttk_toplevel $top
9556     make_transient $top .
9557     ${NS}::label $top.title -text $ui(title)
9558     grid $top.title - -pady 10
9559     ${NS}::label $top.id -text [mc "ID:"]
9560     ${NS}::entry $top.sha1 -width 40
9561     $top.sha1 insert 0 $val(id)
9562     $top.sha1 conf -state readonly
9563     grid $top.id $top.sha1 -sticky w
9564     ${NS}::entry $top.head -width 60
9565     $top.head insert 0 [lindex $commitinfo($val(id)) 0]
9566     $top.head conf -state readonly
9567     grid x $top.head -sticky ew
9568     grid columnconfigure $top 1 -weight 1
9569     ${NS}::label $top.nlab -text [mc "Name:"]
9570     ${NS}::entry $top.name -width 40
9571     $top.name insert 0 $val(name)
9572     grid $top.nlab $top.name -sticky w
9573     ${NS}::frame $top.buts
9574     ${NS}::button $top.buts.go -text $ui(accept) -command $val(command)
9575     ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9576     bind $top <Key-Return> $val(command)
9577     bind $top <Key-Escape> "catch {destroy $top}"
9578     grid $top.buts.go $top.buts.can
9579     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9580     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9581     grid $top.buts - -pady 10 -sticky ew
9582     focus $top.name
9583 }
9584
9585 proc mkbrgo {top} {
9586     global headids idheads
9587
9588     set name [$top.name get]
9589     set id [$top.sha1 get]
9590     set cmdargs {}
9591     set old_id {}
9592     if {$name eq {}} {
9593         error_popup [mc "Please specify a name for the new branch"] $top
9594         return
9595     }
9596     if {[info exists headids($name)]} {
9597         if {![confirm_popup [mc \
9598                 "Branch '%s' already exists. Overwrite?" $name] $top]} {
9599             return
9600         }
9601         set old_id $headids($name)
9602         lappend cmdargs -f
9603     }
9604     catch {destroy $top}
9605     lappend cmdargs $name $id
9606     nowbusy newbranch
9607     update
9608     if {[catch {
9609         eval exec git branch $cmdargs
9610     } err]} {
9611         notbusy newbranch
9612         error_popup $err
9613     } else {
9614         notbusy newbranch
9615         if {$old_id ne {}} {
9616             movehead $id $name
9617             movedhead $id $name
9618             redrawtags $old_id
9619             redrawtags $id
9620         } else {
9621             set headids($name) $id
9622             lappend idheads($id) $name
9623             addedhead $id $name
9624             redrawtags $id
9625         }
9626         dispneartags 0
9627         run refill_reflist
9628     }
9629 }
9630
9631 proc mvbrgo {top prevname} {
9632     global headids idheads mainhead mainheadid
9633
9634     set name [$top.name get]
9635     set id [$top.sha1 get]
9636     set cmdargs {}
9637     if {$name eq $prevname} {
9638         catch {destroy $top}
9639         return
9640     }
9641     if {$name eq {}} {
9642         error_popup [mc "Please specify a new name for the branch"] $top
9643         return
9644     }
9645     catch {destroy $top}
9646     lappend cmdargs -m $prevname $name
9647     nowbusy renamebranch
9648     update
9649     if {[catch {
9650         eval exec git branch $cmdargs
9651     } err]} {
9652         notbusy renamebranch
9653         error_popup $err
9654     } else {
9655         notbusy renamebranch
9656         removehead $id $prevname
9657         removedhead $id $prevname
9658         set headids($name) $id
9659         lappend idheads($id) $name
9660         addedhead $id $name
9661         if {$prevname eq $mainhead} {
9662             set mainhead $name
9663             set mainheadid $id
9664         }
9665         redrawtags $id
9666         dispneartags 0
9667         run refill_reflist
9668     }
9669 }
9670
9671 proc exec_citool {tool_args {baseid {}}} {
9672     global commitinfo env
9673
9674     set save_env [array get env GIT_AUTHOR_*]
9675
9676     if {$baseid ne {}} {
9677         if {![info exists commitinfo($baseid)]} {
9678             getcommit $baseid
9679         }
9680         set author [lindex $commitinfo($baseid) 1]
9681         set date [lindex $commitinfo($baseid) 2]
9682         if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9683                     $author author name email]
9684             && $date ne {}} {
9685             set env(GIT_AUTHOR_NAME) $name
9686             set env(GIT_AUTHOR_EMAIL) $email
9687             set env(GIT_AUTHOR_DATE) $date
9688         }
9689     }
9690
9691     eval exec git citool $tool_args &
9692
9693     array unset env GIT_AUTHOR_*
9694     array set env $save_env
9695 }
9696
9697 proc cherrypick {} {
9698     global rowmenuid curview
9699     global mainhead mainheadid
9700     global gitdir
9701
9702     set oldhead [exec git rev-parse HEAD]
9703     set dheads [descheads $rowmenuid]
9704     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9705         set ok [confirm_popup [mc "Commit %s is already\
9706                 included in branch %s -- really re-apply it?" \
9707                                    [string range $rowmenuid 0 7] $mainhead]]
9708         if {!$ok} return
9709     }
9710     nowbusy cherrypick [mc "Cherry-picking"]
9711     update
9712     # Unfortunately git-cherry-pick writes stuff to stderr even when
9713     # no error occurs, and exec takes that as an indication of error...
9714     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9715         notbusy cherrypick
9716         if {[regexp -line \
9717                  {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9718                  $err msg fname]} {
9719             error_popup [mc "Cherry-pick failed because of local changes\
9720                         to file '%s'.\nPlease commit, reset or stash\
9721                         your changes and try again." $fname]
9722         } elseif {[regexp -line \
9723                        {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9724                        $err]} {
9725             if {[confirm_popup [mc "Cherry-pick failed because of merge\
9726                         conflict.\nDo you wish to run git citool to\
9727                         resolve it?"]]} {
9728                 # Force citool to read MERGE_MSG
9729                 file delete [file join $gitdir "GITGUI_MSG"]
9730                 exec_citool {} $rowmenuid
9731             }
9732         } else {
9733             error_popup $err
9734         }
9735         run updatecommits
9736         return
9737     }
9738     set newhead [exec git rev-parse HEAD]
9739     if {$newhead eq $oldhead} {
9740         notbusy cherrypick
9741         error_popup [mc "No changes committed"]
9742         return
9743     }
9744     addnewchild $newhead $oldhead
9745     if {[commitinview $oldhead $curview]} {
9746         # XXX this isn't right if we have a path limit...
9747         insertrow $newhead $oldhead $curview
9748         if {$mainhead ne {}} {
9749             movehead $newhead $mainhead
9750             movedhead $newhead $mainhead
9751         }
9752         set mainheadid $newhead
9753         redrawtags $oldhead
9754         redrawtags $newhead
9755         selbyid $newhead
9756     }
9757     notbusy cherrypick
9758 }
9759
9760 proc revert {} {
9761     global rowmenuid curview
9762     global mainhead mainheadid
9763     global gitdir
9764
9765     set oldhead [exec git rev-parse HEAD]
9766     set dheads [descheads $rowmenuid]
9767     if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9768        set ok [confirm_popup [mc "Commit %s is not\
9769            included in branch %s -- really revert it?" \
9770                       [string range $rowmenuid 0 7] $mainhead]]
9771        if {!$ok} return
9772     }
9773     nowbusy revert [mc "Reverting"]
9774     update
9775
9776     if [catch {exec git revert --no-edit $rowmenuid} err] {
9777         notbusy revert
9778         if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9779                 $err match files] {
9780             regsub {\n( |\t)+} $files "\n" files
9781             error_popup [mc "Revert failed because of local changes to\
9782                 the following files:%s Please commit, reset or stash \
9783                 your changes and try again." $files]
9784         } elseif [regexp {error: could not revert} $err] {
9785             if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9786                 Do you wish to run git citool to resolve it?"]] {
9787                 # Force citool to read MERGE_MSG
9788                 file delete [file join $gitdir "GITGUI_MSG"]
9789                 exec_citool {} $rowmenuid
9790             }
9791         } else { error_popup $err }
9792         run updatecommits
9793         return
9794     }
9795
9796     set newhead [exec git rev-parse HEAD]
9797     if { $newhead eq $oldhead } {
9798         notbusy revert
9799         error_popup [mc "No changes committed"]
9800         return
9801     }
9802
9803     addnewchild $newhead $oldhead
9804
9805     if [commitinview $oldhead $curview] {
9806         # XXX this isn't right if we have a path limit...
9807         insertrow $newhead $oldhead $curview
9808         if {$mainhead ne {}} {
9809             movehead $newhead $mainhead
9810             movedhead $newhead $mainhead
9811         }
9812         set mainheadid $newhead
9813         redrawtags $oldhead
9814         redrawtags $newhead
9815         selbyid $newhead
9816     }
9817
9818     notbusy revert
9819 }
9820
9821 proc resethead {} {
9822     global mainhead rowmenuid confirm_ok resettype NS
9823
9824     set confirm_ok 0
9825     set w ".confirmreset"
9826     ttk_toplevel $w
9827     make_transient $w .
9828     wm title $w [mc "Confirm reset"]
9829     ${NS}::label $w.m -text \
9830         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9831     pack $w.m -side top -fill x -padx 20 -pady 20
9832     ${NS}::labelframe $w.f -text [mc "Reset type:"]
9833     set resettype mixed
9834     ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9835         -text [mc "Soft: Leave working tree and index untouched"]
9836     grid $w.f.soft -sticky w
9837     ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9838         -text [mc "Mixed: Leave working tree untouched, reset index"]
9839     grid $w.f.mixed -sticky w
9840     ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9841         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9842     grid $w.f.hard -sticky w
9843     pack $w.f -side top -fill x -padx 4
9844     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9845     pack $w.ok -side left -fill x -padx 20 -pady 20
9846     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9847     bind $w <Key-Escape> [list destroy $w]
9848     pack $w.cancel -side right -fill x -padx 20 -pady 20
9849     bind $w <Visibility> "grab $w; focus $w"
9850     tkwait window $w
9851     if {!$confirm_ok} return
9852     if {[catch {set fd [open \
9853             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9854         error_popup $err
9855     } else {
9856         dohidelocalchanges
9857         filerun $fd [list readresetstat $fd]
9858         nowbusy reset [mc "Resetting"]
9859         selbyid $rowmenuid
9860     }
9861 }
9862
9863 proc readresetstat {fd} {
9864     global mainhead mainheadid showlocalchanges rprogcoord
9865
9866     if {[gets $fd line] >= 0} {
9867         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9868             set rprogcoord [expr {1.0 * $m / $n}]
9869             adjustprogress
9870         }
9871         return 1
9872     }
9873     set rprogcoord 0
9874     adjustprogress
9875     notbusy reset
9876     if {[catch {close $fd} err]} {
9877         error_popup $err
9878     }
9879     set oldhead $mainheadid
9880     set newhead [exec git rev-parse HEAD]
9881     if {$newhead ne $oldhead} {
9882         movehead $newhead $mainhead
9883         movedhead $newhead $mainhead
9884         set mainheadid $newhead
9885         redrawtags $oldhead
9886         redrawtags $newhead
9887     }
9888     if {$showlocalchanges} {
9889         doshowlocalchanges
9890     }
9891     return 0
9892 }
9893
9894 # context menu for a head
9895 proc headmenu {x y id head} {
9896     global headmenuid headmenuhead headctxmenu mainhead headids
9897
9898     stopfinding
9899     set headmenuid $id
9900     set headmenuhead $head
9901     array set state {0 normal 1 normal 2 normal}
9902     if {[string match "remotes/*" $head]} {
9903         set localhead [string range $head [expr [string last / $head] + 1] end]
9904         if {[info exists headids($localhead)]} {
9905             set state(0) disabled
9906         }
9907         array set state {1 disabled 2 disabled}
9908     }
9909     if {$head eq $mainhead} {
9910         array set state {0 disabled 2 disabled}
9911     }
9912     foreach i {0 1 2} {
9913         $headctxmenu entryconfigure $i -state $state($i)
9914     }
9915     tk_popup $headctxmenu $x $y
9916 }
9917
9918 proc cobranch {} {
9919     global headmenuid headmenuhead headids
9920     global showlocalchanges
9921
9922     # check the tree is clean first??
9923     set newhead $headmenuhead
9924     set command [list | git checkout]
9925     if {[string match "remotes/*" $newhead]} {
9926         set remote $newhead
9927         set newhead [string range $newhead [expr [string last / $newhead] + 1] end]
9928         # The following check is redundant - the menu option should
9929         # be disabled to begin with...
9930         if {[info exists headids($newhead)]} {
9931             error_popup [mc "A local branch named %s exists already" $newhead]
9932             return
9933         }
9934         lappend command -b $newhead --track $remote
9935     } else {
9936         lappend command $newhead
9937     }
9938     lappend command 2>@1
9939     nowbusy checkout [mc "Checking out"]
9940     update
9941     dohidelocalchanges
9942     if {[catch {
9943         set fd [open $command r]
9944     } err]} {
9945         notbusy checkout
9946         error_popup $err
9947         if {$showlocalchanges} {
9948             dodiffindex
9949         }
9950     } else {
9951         filerun $fd [list readcheckoutstat $fd $newhead $headmenuid]
9952     }
9953 }
9954
9955 proc readcheckoutstat {fd newhead newheadid} {
9956     global mainhead mainheadid headids idheads showlocalchanges progresscoords
9957     global viewmainheadid curview
9958
9959     if {[gets $fd line] >= 0} {
9960         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9961             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9962             adjustprogress
9963         }
9964         return 1
9965     }
9966     set progresscoords {0 0}
9967     adjustprogress
9968     notbusy checkout
9969     if {[catch {close $fd} err]} {
9970         error_popup $err
9971         return
9972     }
9973     set oldmainid $mainheadid
9974     if {! [info exists headids($newhead)]} {
9975         set headids($newhead) $newheadid
9976         lappend idheads($newheadid) $newhead
9977         addedhead $newheadid $newhead
9978     }
9979     set mainhead $newhead
9980     set mainheadid $newheadid
9981     set viewmainheadid($curview) $newheadid
9982     redrawtags $oldmainid
9983     redrawtags $newheadid
9984     selbyid $newheadid
9985     if {$showlocalchanges} {
9986         dodiffindex
9987     }
9988 }
9989
9990 proc rmbranch {} {
9991     global headmenuid headmenuhead mainhead
9992     global idheads
9993
9994     set head $headmenuhead
9995     set id $headmenuid
9996     # this check shouldn't be needed any more...
9997     if {$head eq $mainhead} {
9998         error_popup [mc "Cannot delete the currently checked-out branch"]
9999         return
10000     }
10001     set dheads [descheads $id]
10002     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
10003         # the stuff on this branch isn't on any other branch
10004         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
10005                         branch.\nReally delete branch %s?" $head $head]]} return
10006     }
10007     nowbusy rmbranch
10008     update
10009     if {[catch {exec git branch -D $head} err]} {
10010         notbusy rmbranch
10011         error_popup $err
10012         return
10013     }
10014     removehead $id $head
10015     removedhead $id $head
10016     redrawtags $id
10017     notbusy rmbranch
10018     dispneartags 0
10019     run refill_reflist
10020 }
10021
10022 # Display a list of tags and heads
10023 proc showrefs {} {
10024     global showrefstop bgcolor fgcolor selectbgcolor NS
10025     global bglist fglist reflistfilter reflist maincursor
10026
10027     set top .showrefs
10028     set showrefstop $top
10029     if {[winfo exists $top]} {
10030         raise $top
10031         refill_reflist
10032         return
10033     }
10034     ttk_toplevel $top
10035     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
10036     make_transient $top .
10037     text $top.list -background $bgcolor -foreground $fgcolor \
10038         -selectbackground $selectbgcolor -font mainfont \
10039         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
10040         -width 30 -height 20 -cursor $maincursor \
10041         -spacing1 1 -spacing3 1 -state disabled
10042     $top.list tag configure highlight -background $selectbgcolor
10043     if {![lsearch -exact $bglist $top.list]} {
10044         lappend bglist $top.list
10045         lappend fglist $top.list
10046     }
10047     ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
10048     ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
10049     grid $top.list $top.ysb -sticky nsew
10050     grid $top.xsb x -sticky ew
10051     ${NS}::frame $top.f
10052     ${NS}::label $top.f.l -text "[mc "Filter"]: "
10053     ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
10054     set reflistfilter "*"
10055     trace add variable reflistfilter write reflistfilter_change
10056     pack $top.f.e -side right -fill x -expand 1
10057     pack $top.f.l -side left
10058     grid $top.f - -sticky ew -pady 2
10059     ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
10060     bind $top <Key-Escape> [list destroy $top]
10061     grid $top.close -
10062     grid columnconfigure $top 0 -weight 1
10063     grid rowconfigure $top 0 -weight 1
10064     bind $top.list <1> {break}
10065     bind $top.list <B1-Motion> {break}
10066     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
10067     set reflist {}
10068     refill_reflist
10069 }
10070
10071 proc sel_reflist {w x y} {
10072     global showrefstop reflist headids tagids otherrefids
10073
10074     if {![winfo exists $showrefstop]} return
10075     set l [lindex [split [$w index "@$x,$y"] "."] 0]
10076     set ref [lindex $reflist [expr {$l-1}]]
10077     set n [lindex $ref 0]
10078     switch -- [lindex $ref 1] {
10079         "H" {selbyid $headids($n)}
10080         "R" {selbyid $headids($n)}
10081         "T" {selbyid $tagids($n)}
10082         "o" {selbyid $otherrefids($n)}
10083     }
10084     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
10085 }
10086
10087 proc unsel_reflist {} {
10088     global showrefstop
10089
10090     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10091     $showrefstop.list tag remove highlight 0.0 end
10092 }
10093
10094 proc reflistfilter_change {n1 n2 op} {
10095     global reflistfilter
10096
10097     after cancel refill_reflist
10098     after 200 refill_reflist
10099 }
10100
10101 proc refill_reflist {} {
10102     global reflist reflistfilter showrefstop headids tagids otherrefids
10103     global curview
10104
10105     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10106     set refs {}
10107     foreach n [array names headids] {
10108         if {[string match $reflistfilter $n]} {
10109             if {[commitinview $headids($n) $curview]} {
10110                 if {[string match "remotes/*" $n]} {
10111                     lappend refs [list $n R]
10112                 } else {
10113                     lappend refs [list $n H]
10114                 }
10115             } else {
10116                 interestedin $headids($n) {run refill_reflist}
10117             }
10118         }
10119     }
10120     foreach n [array names tagids] {
10121         if {[string match $reflistfilter $n]} {
10122             if {[commitinview $tagids($n) $curview]} {
10123                 lappend refs [list $n T]
10124             } else {
10125                 interestedin $tagids($n) {run refill_reflist}
10126             }
10127         }
10128     }
10129     foreach n [array names otherrefids] {
10130         if {[string match $reflistfilter $n]} {
10131             if {[commitinview $otherrefids($n) $curview]} {
10132                 lappend refs [list $n o]
10133             } else {
10134                 interestedin $otherrefids($n) {run refill_reflist}
10135             }
10136         }
10137     }
10138     set refs [lsort -index 0 $refs]
10139     if {$refs eq $reflist} return
10140
10141     # Update the contents of $showrefstop.list according to the
10142     # differences between $reflist (old) and $refs (new)
10143     $showrefstop.list conf -state normal
10144     $showrefstop.list insert end "\n"
10145     set i 0
10146     set j 0
10147     while {$i < [llength $reflist] || $j < [llength $refs]} {
10148         if {$i < [llength $reflist]} {
10149             if {$j < [llength $refs]} {
10150                 set cmp [string compare [lindex $reflist $i 0] \
10151                              [lindex $refs $j 0]]
10152                 if {$cmp == 0} {
10153                     set cmp [string compare [lindex $reflist $i 1] \
10154                                  [lindex $refs $j 1]]
10155                 }
10156             } else {
10157                 set cmp -1
10158             }
10159         } else {
10160             set cmp 1
10161         }
10162         switch -- $cmp {
10163             -1 {
10164                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
10165                 incr i
10166             }
10167             0 {
10168                 incr i
10169                 incr j
10170             }
10171             1 {
10172                 set l [expr {$j + 1}]
10173                 $showrefstop.list image create $l.0 -align baseline \
10174                     -image reficon-[lindex $refs $j 1] -padx 2
10175                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
10176                 incr j
10177             }
10178         }
10179     }
10180     set reflist $refs
10181     # delete last newline
10182     $showrefstop.list delete end-2c end-1c
10183     $showrefstop.list conf -state disabled
10184 }
10185
10186 # Stuff for finding nearby tags
10187 proc getallcommits {} {
10188     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
10189     global idheads idtags idotherrefs allparents tagobjid
10190     global gitdir
10191
10192     if {![info exists allcommits]} {
10193         set nextarc 0
10194         set allcommits 0
10195         set seeds {}
10196         set allcwait 0
10197         set cachedarcs 0
10198         set allccache [file join $gitdir "gitk.cache"]
10199         if {![catch {
10200             set f [open $allccache r]
10201             set allcwait 1
10202             getcache $f
10203         }]} return
10204     }
10205
10206     if {$allcwait} {
10207         return
10208     }
10209     set cmd [list | git rev-list --parents]
10210     set allcupdate [expr {$seeds ne {}}]
10211     if {!$allcupdate} {
10212         set ids "--all"
10213     } else {
10214         set refs [concat [array names idheads] [array names idtags] \
10215                       [array names idotherrefs]]
10216         set ids {}
10217         set tagobjs {}
10218         foreach name [array names tagobjid] {
10219             lappend tagobjs $tagobjid($name)
10220         }
10221         foreach id [lsort -unique $refs] {
10222             if {![info exists allparents($id)] &&
10223                 [lsearch -exact $tagobjs $id] < 0} {
10224                 lappend ids $id
10225             }
10226         }
10227         if {$ids ne {}} {
10228             foreach id $seeds {
10229                 lappend ids "^$id"
10230             }
10231         }
10232     }
10233     if {$ids ne {}} {
10234         set fd [open [concat $cmd $ids] r]
10235         fconfigure $fd -blocking 0
10236         incr allcommits
10237         nowbusy allcommits
10238         filerun $fd [list getallclines $fd]
10239     } else {
10240         dispneartags 0
10241     }
10242 }
10243
10244 # Since most commits have 1 parent and 1 child, we group strings of
10245 # such commits into "arcs" joining branch/merge points (BMPs), which
10246 # are commits that either don't have 1 parent or don't have 1 child.
10247 #
10248 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
10249 # arcout(id) - outgoing arcs for BMP
10250 # arcids(a) - list of IDs on arc including end but not start
10251 # arcstart(a) - BMP ID at start of arc
10252 # arcend(a) - BMP ID at end of arc
10253 # growing(a) - arc a is still growing
10254 # arctags(a) - IDs out of arcids (excluding end) that have tags
10255 # archeads(a) - IDs out of arcids (excluding end) that have heads
10256 # The start of an arc is at the descendent end, so "incoming" means
10257 # coming from descendents, and "outgoing" means going towards ancestors.
10258
10259 proc getallclines {fd} {
10260     global allparents allchildren idtags idheads nextarc
10261     global arcnos arcids arctags arcout arcend arcstart archeads growing
10262     global seeds allcommits cachedarcs allcupdate
10263
10264     set nid 0
10265     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
10266         set id [lindex $line 0]
10267         if {[info exists allparents($id)]} {
10268             # seen it already
10269             continue
10270         }
10271         set cachedarcs 0
10272         set olds [lrange $line 1 end]
10273         set allparents($id) $olds
10274         if {![info exists allchildren($id)]} {
10275             set allchildren($id) {}
10276             set arcnos($id) {}
10277             lappend seeds $id
10278         } else {
10279             set a $arcnos($id)
10280             if {[llength $olds] == 1 && [llength $a] == 1} {
10281                 lappend arcids($a) $id
10282                 if {[info exists idtags($id)]} {
10283                     lappend arctags($a) $id
10284                 }
10285                 if {[info exists idheads($id)]} {
10286                     lappend archeads($a) $id
10287                 }
10288                 if {[info exists allparents($olds)]} {
10289                     # seen parent already
10290                     if {![info exists arcout($olds)]} {
10291                         splitarc $olds
10292                     }
10293                     lappend arcids($a) $olds
10294                     set arcend($a) $olds
10295                     unset growing($a)
10296                 }
10297                 lappend allchildren($olds) $id
10298                 lappend arcnos($olds) $a
10299                 continue
10300             }
10301         }
10302         foreach a $arcnos($id) {
10303             lappend arcids($a) $id
10304             set arcend($a) $id
10305             unset growing($a)
10306         }
10307
10308         set ao {}
10309         foreach p $olds {
10310             lappend allchildren($p) $id
10311             set a [incr nextarc]
10312             set arcstart($a) $id
10313             set archeads($a) {}
10314             set arctags($a) {}
10315             set archeads($a) {}
10316             set arcids($a) {}
10317             lappend ao $a
10318             set growing($a) 1
10319             if {[info exists allparents($p)]} {
10320                 # seen it already, may need to make a new branch
10321                 if {![info exists arcout($p)]} {
10322                     splitarc $p
10323                 }
10324                 lappend arcids($a) $p
10325                 set arcend($a) $p
10326                 unset growing($a)
10327             }
10328             lappend arcnos($p) $a
10329         }
10330         set arcout($id) $ao
10331     }
10332     if {$nid > 0} {
10333         global cached_dheads cached_dtags cached_atags
10334         unset -nocomplain cached_dheads
10335         unset -nocomplain cached_dtags
10336         unset -nocomplain cached_atags
10337     }
10338     if {![eof $fd]} {
10339         return [expr {$nid >= 1000? 2: 1}]
10340     }
10341     set cacheok 1
10342     if {[catch {
10343         fconfigure $fd -blocking 1
10344         close $fd
10345     } err]} {
10346         # got an error reading the list of commits
10347         # if we were updating, try rereading the whole thing again
10348         if {$allcupdate} {
10349             incr allcommits -1
10350             dropcache $err
10351             return
10352         }
10353         error_popup "[mc "Error reading commit topology information;\
10354                 branch and preceding/following tag information\
10355                 will be incomplete."]\n($err)"
10356         set cacheok 0
10357     }
10358     if {[incr allcommits -1] == 0} {
10359         notbusy allcommits
10360         if {$cacheok} {
10361             run savecache
10362         }
10363     }
10364     dispneartags 0
10365     return 0
10366 }
10367
10368 proc recalcarc {a} {
10369     global arctags archeads arcids idtags idheads
10370
10371     set at {}
10372     set ah {}
10373     foreach id [lrange $arcids($a) 0 end-1] {
10374         if {[info exists idtags($id)]} {
10375             lappend at $id
10376         }
10377         if {[info exists idheads($id)]} {
10378             lappend ah $id
10379         }
10380     }
10381     set arctags($a) $at
10382     set archeads($a) $ah
10383 }
10384
10385 proc splitarc {p} {
10386     global arcnos arcids nextarc arctags archeads idtags idheads
10387     global arcstart arcend arcout allparents growing
10388
10389     set a $arcnos($p)
10390     if {[llength $a] != 1} {
10391         puts "oops splitarc called but [llength $a] arcs already"
10392         return
10393     }
10394     set a [lindex $a 0]
10395     set i [lsearch -exact $arcids($a) $p]
10396     if {$i < 0} {
10397         puts "oops splitarc $p not in arc $a"
10398         return
10399     }
10400     set na [incr nextarc]
10401     if {[info exists arcend($a)]} {
10402         set arcend($na) $arcend($a)
10403     } else {
10404         set l [lindex $allparents([lindex $arcids($a) end]) 0]
10405         set j [lsearch -exact $arcnos($l) $a]
10406         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10407     }
10408     set tail [lrange $arcids($a) [expr {$i+1}] end]
10409     set arcids($a) [lrange $arcids($a) 0 $i]
10410     set arcend($a) $p
10411     set arcstart($na) $p
10412     set arcout($p) $na
10413     set arcids($na) $tail
10414     if {[info exists growing($a)]} {
10415         set growing($na) 1
10416         unset growing($a)
10417     }
10418
10419     foreach id $tail {
10420         if {[llength $arcnos($id)] == 1} {
10421             set arcnos($id) $na
10422         } else {
10423             set j [lsearch -exact $arcnos($id) $a]
10424             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10425         }
10426     }
10427
10428     # reconstruct tags and heads lists
10429     if {$arctags($a) ne {} || $archeads($a) ne {}} {
10430         recalcarc $a
10431         recalcarc $na
10432     } else {
10433         set arctags($na) {}
10434         set archeads($na) {}
10435     }
10436 }
10437
10438 # Update things for a new commit added that is a child of one
10439 # existing commit.  Used when cherry-picking.
10440 proc addnewchild {id p} {
10441     global allparents allchildren idtags nextarc
10442     global arcnos arcids arctags arcout arcend arcstart archeads growing
10443     global seeds allcommits
10444
10445     if {![info exists allcommits] || ![info exists arcnos($p)]} return
10446     set allparents($id) [list $p]
10447     set allchildren($id) {}
10448     set arcnos($id) {}
10449     lappend seeds $id
10450     lappend allchildren($p) $id
10451     set a [incr nextarc]
10452     set arcstart($a) $id
10453     set archeads($a) {}
10454     set arctags($a) {}
10455     set arcids($a) [list $p]
10456     set arcend($a) $p
10457     if {![info exists arcout($p)]} {
10458         splitarc $p
10459     }
10460     lappend arcnos($p) $a
10461     set arcout($id) [list $a]
10462 }
10463
10464 # This implements a cache for the topology information.
10465 # The cache saves, for each arc, the start and end of the arc,
10466 # the ids on the arc, and the outgoing arcs from the end.
10467 proc readcache {f} {
10468     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10469     global idtags idheads allparents cachedarcs possible_seeds seeds growing
10470     global allcwait
10471
10472     set a $nextarc
10473     set lim $cachedarcs
10474     if {$lim - $a > 500} {
10475         set lim [expr {$a + 500}]
10476     }
10477     if {[catch {
10478         if {$a == $lim} {
10479             # finish reading the cache and setting up arctags, etc.
10480             set line [gets $f]
10481             if {$line ne "1"} {error "bad final version"}
10482             close $f
10483             foreach id [array names idtags] {
10484                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10485                     [llength $allparents($id)] == 1} {
10486                     set a [lindex $arcnos($id) 0]
10487                     if {$arctags($a) eq {}} {
10488                         recalcarc $a
10489                     }
10490                 }
10491             }
10492             foreach id [array names idheads] {
10493                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10494                     [llength $allparents($id)] == 1} {
10495                     set a [lindex $arcnos($id) 0]
10496                     if {$archeads($a) eq {}} {
10497                         recalcarc $a
10498                     }
10499                 }
10500             }
10501             foreach id [lsort -unique $possible_seeds] {
10502                 if {$arcnos($id) eq {}} {
10503                     lappend seeds $id
10504                 }
10505             }
10506             set allcwait 0
10507         } else {
10508             while {[incr a] <= $lim} {
10509                 set line [gets $f]
10510                 if {[llength $line] != 3} {error "bad line"}
10511                 set s [lindex $line 0]
10512                 set arcstart($a) $s
10513                 lappend arcout($s) $a
10514                 if {![info exists arcnos($s)]} {
10515                     lappend possible_seeds $s
10516                     set arcnos($s) {}
10517                 }
10518                 set e [lindex $line 1]
10519                 if {$e eq {}} {
10520                     set growing($a) 1
10521                 } else {
10522                     set arcend($a) $e
10523                     if {![info exists arcout($e)]} {
10524                         set arcout($e) {}
10525                     }
10526                 }
10527                 set arcids($a) [lindex $line 2]
10528                 foreach id $arcids($a) {
10529                     lappend allparents($s) $id
10530                     set s $id
10531                     lappend arcnos($id) $a
10532                 }
10533                 if {![info exists allparents($s)]} {
10534                     set allparents($s) {}
10535                 }
10536                 set arctags($a) {}
10537                 set archeads($a) {}
10538             }
10539             set nextarc [expr {$a - 1}]
10540         }
10541     } err]} {
10542         dropcache $err
10543         return 0
10544     }
10545     if {!$allcwait} {
10546         getallcommits
10547     }
10548     return $allcwait
10549 }
10550
10551 proc getcache {f} {
10552     global nextarc cachedarcs possible_seeds
10553
10554     if {[catch {
10555         set line [gets $f]
10556         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10557         # make sure it's an integer
10558         set cachedarcs [expr {int([lindex $line 1])}]
10559         if {$cachedarcs < 0} {error "bad number of arcs"}
10560         set nextarc 0
10561         set possible_seeds {}
10562         run readcache $f
10563     } err]} {
10564         dropcache $err
10565     }
10566     return 0
10567 }
10568
10569 proc dropcache {err} {
10570     global allcwait nextarc cachedarcs seeds
10571
10572     #puts "dropping cache ($err)"
10573     foreach v {arcnos arcout arcids arcstart arcend growing \
10574                    arctags archeads allparents allchildren} {
10575         global $v
10576         unset -nocomplain $v
10577     }
10578     set allcwait 0
10579     set nextarc 0
10580     set cachedarcs 0
10581     set seeds {}
10582     getallcommits
10583 }
10584
10585 proc writecache {f} {
10586     global cachearc cachedarcs allccache
10587     global arcstart arcend arcnos arcids arcout
10588
10589     set a $cachearc
10590     set lim $cachedarcs
10591     if {$lim - $a > 1000} {
10592         set lim [expr {$a + 1000}]
10593     }
10594     if {[catch {
10595         while {[incr a] <= $lim} {
10596             if {[info exists arcend($a)]} {
10597                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10598             } else {
10599                 puts $f [list $arcstart($a) {} $arcids($a)]
10600             }
10601         }
10602     } err]} {
10603         catch {close $f}
10604         catch {file delete $allccache}
10605         #puts "writing cache failed ($err)"
10606         return 0
10607     }
10608     set cachearc [expr {$a - 1}]
10609     if {$a > $cachedarcs} {
10610         puts $f "1"
10611         close $f
10612         return 0
10613     }
10614     return 1
10615 }
10616
10617 proc savecache {} {
10618     global nextarc cachedarcs cachearc allccache
10619
10620     if {$nextarc == $cachedarcs} return
10621     set cachearc 0
10622     set cachedarcs $nextarc
10623     catch {
10624         set f [open $allccache w]
10625         puts $f [list 1 $cachedarcs]
10626         run writecache $f
10627     }
10628 }
10629
10630 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10631 # or 0 if neither is true.
10632 proc anc_or_desc {a b} {
10633     global arcout arcstart arcend arcnos cached_isanc
10634
10635     if {$arcnos($a) eq $arcnos($b)} {
10636         # Both are on the same arc(s); either both are the same BMP,
10637         # or if one is not a BMP, the other is also not a BMP or is
10638         # the BMP at end of the arc (and it only has 1 incoming arc).
10639         # Or both can be BMPs with no incoming arcs.
10640         if {$a eq $b || $arcnos($a) eq {}} {
10641             return 0
10642         }
10643         # assert {[llength $arcnos($a)] == 1}
10644         set arc [lindex $arcnos($a) 0]
10645         set i [lsearch -exact $arcids($arc) $a]
10646         set j [lsearch -exact $arcids($arc) $b]
10647         if {$i < 0 || $i > $j} {
10648             return 1
10649         } else {
10650             return -1
10651         }
10652     }
10653
10654     if {![info exists arcout($a)]} {
10655         set arc [lindex $arcnos($a) 0]
10656         if {[info exists arcend($arc)]} {
10657             set aend $arcend($arc)
10658         } else {
10659             set aend {}
10660         }
10661         set a $arcstart($arc)
10662     } else {
10663         set aend $a
10664     }
10665     if {![info exists arcout($b)]} {
10666         set arc [lindex $arcnos($b) 0]
10667         if {[info exists arcend($arc)]} {
10668             set bend $arcend($arc)
10669         } else {
10670             set bend {}
10671         }
10672         set b $arcstart($arc)
10673     } else {
10674         set bend $b
10675     }
10676     if {$a eq $bend} {
10677         return 1
10678     }
10679     if {$b eq $aend} {
10680         return -1
10681     }
10682     if {[info exists cached_isanc($a,$bend)]} {
10683         if {$cached_isanc($a,$bend)} {
10684             return 1
10685         }
10686     }
10687     if {[info exists cached_isanc($b,$aend)]} {
10688         if {$cached_isanc($b,$aend)} {
10689             return -1
10690         }
10691         if {[info exists cached_isanc($a,$bend)]} {
10692             return 0
10693         }
10694     }
10695
10696     set todo [list $a $b]
10697     set anc($a) a
10698     set anc($b) b
10699     for {set i 0} {$i < [llength $todo]} {incr i} {
10700         set x [lindex $todo $i]
10701         if {$anc($x) eq {}} {
10702             continue
10703         }
10704         foreach arc $arcnos($x) {
10705             set xd $arcstart($arc)
10706             if {$xd eq $bend} {
10707                 set cached_isanc($a,$bend) 1
10708                 set cached_isanc($b,$aend) 0
10709                 return 1
10710             } elseif {$xd eq $aend} {
10711                 set cached_isanc($b,$aend) 1
10712                 set cached_isanc($a,$bend) 0
10713                 return -1
10714             }
10715             if {![info exists anc($xd)]} {
10716                 set anc($xd) $anc($x)
10717                 lappend todo $xd
10718             } elseif {$anc($xd) ne $anc($x)} {
10719                 set anc($xd) {}
10720             }
10721         }
10722     }
10723     set cached_isanc($a,$bend) 0
10724     set cached_isanc($b,$aend) 0
10725     return 0
10726 }
10727
10728 # This identifies whether $desc has an ancestor that is
10729 # a growing tip of the graph and which is not an ancestor of $anc
10730 # and returns 0 if so and 1 if not.
10731 # If we subsequently discover a tag on such a growing tip, and that
10732 # turns out to be a descendent of $anc (which it could, since we
10733 # don't necessarily see children before parents), then $desc
10734 # isn't a good choice to display as a descendent tag of
10735 # $anc (since it is the descendent of another tag which is
10736 # a descendent of $anc).  Similarly, $anc isn't a good choice to
10737 # display as a ancestor tag of $desc.
10738 #
10739 proc is_certain {desc anc} {
10740     global arcnos arcout arcstart arcend growing problems
10741
10742     set certain {}
10743     if {[llength $arcnos($anc)] == 1} {
10744         # tags on the same arc are certain
10745         if {$arcnos($desc) eq $arcnos($anc)} {
10746             return 1
10747         }
10748         if {![info exists arcout($anc)]} {
10749             # if $anc is partway along an arc, use the start of the arc instead
10750             set a [lindex $arcnos($anc) 0]
10751             set anc $arcstart($a)
10752         }
10753     }
10754     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10755         set x $desc
10756     } else {
10757         set a [lindex $arcnos($desc) 0]
10758         set x $arcend($a)
10759     }
10760     if {$x == $anc} {
10761         return 1
10762     }
10763     set anclist [list $x]
10764     set dl($x) 1
10765     set nnh 1
10766     set ngrowanc 0
10767     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10768         set x [lindex $anclist $i]
10769         if {$dl($x)} {
10770             incr nnh -1
10771         }
10772         set done($x) 1
10773         foreach a $arcout($x) {
10774             if {[info exists growing($a)]} {
10775                 if {![info exists growanc($x)] && $dl($x)} {
10776                     set growanc($x) 1
10777                     incr ngrowanc
10778                 }
10779             } else {
10780                 set y $arcend($a)
10781                 if {[info exists dl($y)]} {
10782                     if {$dl($y)} {
10783                         if {!$dl($x)} {
10784                             set dl($y) 0
10785                             if {![info exists done($y)]} {
10786                                 incr nnh -1
10787                             }
10788                             if {[info exists growanc($x)]} {
10789                                 incr ngrowanc -1
10790                             }
10791                             set xl [list $y]
10792                             for {set k 0} {$k < [llength $xl]} {incr k} {
10793                                 set z [lindex $xl $k]
10794                                 foreach c $arcout($z) {
10795                                     if {[info exists arcend($c)]} {
10796                                         set v $arcend($c)
10797                                         if {[info exists dl($v)] && $dl($v)} {
10798                                             set dl($v) 0
10799                                             if {![info exists done($v)]} {
10800                                                 incr nnh -1
10801                                             }
10802                                             if {[info exists growanc($v)]} {
10803                                                 incr ngrowanc -1
10804                                             }
10805                                             lappend xl $v
10806                                         }
10807                                     }
10808                                 }
10809                             }
10810                         }
10811                     }
10812                 } elseif {$y eq $anc || !$dl($x)} {
10813                     set dl($y) 0
10814                     lappend anclist $y
10815                 } else {
10816                     set dl($y) 1
10817                     lappend anclist $y
10818                     incr nnh
10819                 }
10820             }
10821         }
10822     }
10823     foreach x [array names growanc] {
10824         if {$dl($x)} {
10825             return 0
10826         }
10827         return 0
10828     }
10829     return 1
10830 }
10831
10832 proc validate_arctags {a} {
10833     global arctags idtags
10834
10835     set i -1
10836     set na $arctags($a)
10837     foreach id $arctags($a) {
10838         incr i
10839         if {![info exists idtags($id)]} {
10840             set na [lreplace $na $i $i]
10841             incr i -1
10842         }
10843     }
10844     set arctags($a) $na
10845 }
10846
10847 proc validate_archeads {a} {
10848     global archeads idheads
10849
10850     set i -1
10851     set na $archeads($a)
10852     foreach id $archeads($a) {
10853         incr i
10854         if {![info exists idheads($id)]} {
10855             set na [lreplace $na $i $i]
10856             incr i -1
10857         }
10858     }
10859     set archeads($a) $na
10860 }
10861
10862 # Return the list of IDs that have tags that are descendents of id,
10863 # ignoring IDs that are descendents of IDs already reported.
10864 proc desctags {id} {
10865     global arcnos arcstart arcids arctags idtags allparents
10866     global growing cached_dtags
10867
10868     if {![info exists allparents($id)]} {
10869         return {}
10870     }
10871     set t1 [clock clicks -milliseconds]
10872     set argid $id
10873     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10874         # part-way along an arc; check that arc first
10875         set a [lindex $arcnos($id) 0]
10876         if {$arctags($a) ne {}} {
10877             validate_arctags $a
10878             set i [lsearch -exact $arcids($a) $id]
10879             set tid {}
10880             foreach t $arctags($a) {
10881                 set j [lsearch -exact $arcids($a) $t]
10882                 if {$j >= $i} break
10883                 set tid $t
10884             }
10885             if {$tid ne {}} {
10886                 return $tid
10887             }
10888         }
10889         set id $arcstart($a)
10890         if {[info exists idtags($id)]} {
10891             return $id
10892         }
10893     }
10894     if {[info exists cached_dtags($id)]} {
10895         return $cached_dtags($id)
10896     }
10897
10898     set origid $id
10899     set todo [list $id]
10900     set queued($id) 1
10901     set nc 1
10902     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10903         set id [lindex $todo $i]
10904         set done($id) 1
10905         set ta [info exists hastaggedancestor($id)]
10906         if {!$ta} {
10907             incr nc -1
10908         }
10909         # ignore tags on starting node
10910         if {!$ta && $i > 0} {
10911             if {[info exists idtags($id)]} {
10912                 set tagloc($id) $id
10913                 set ta 1
10914             } elseif {[info exists cached_dtags($id)]} {
10915                 set tagloc($id) $cached_dtags($id)
10916                 set ta 1
10917             }
10918         }
10919         foreach a $arcnos($id) {
10920             set d $arcstart($a)
10921             if {!$ta && $arctags($a) ne {}} {
10922                 validate_arctags $a
10923                 if {$arctags($a) ne {}} {
10924                     lappend tagloc($id) [lindex $arctags($a) end]
10925                 }
10926             }
10927             if {$ta || $arctags($a) ne {}} {
10928                 set tomark [list $d]
10929                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10930                     set dd [lindex $tomark $j]
10931                     if {![info exists hastaggedancestor($dd)]} {
10932                         if {[info exists done($dd)]} {
10933                             foreach b $arcnos($dd) {
10934                                 lappend tomark $arcstart($b)
10935                             }
10936                             if {[info exists tagloc($dd)]} {
10937                                 unset tagloc($dd)
10938                             }
10939                         } elseif {[info exists queued($dd)]} {
10940                             incr nc -1
10941                         }
10942                         set hastaggedancestor($dd) 1
10943                     }
10944                 }
10945             }
10946             if {![info exists queued($d)]} {
10947                 lappend todo $d
10948                 set queued($d) 1
10949                 if {![info exists hastaggedancestor($d)]} {
10950                     incr nc
10951                 }
10952             }
10953         }
10954     }
10955     set tags {}
10956     foreach id [array names tagloc] {
10957         if {![info exists hastaggedancestor($id)]} {
10958             foreach t $tagloc($id) {
10959                 if {[lsearch -exact $tags $t] < 0} {
10960                     lappend tags $t
10961                 }
10962             }
10963         }
10964     }
10965     set t2 [clock clicks -milliseconds]
10966     set loopix $i
10967
10968     # remove tags that are descendents of other tags
10969     for {set i 0} {$i < [llength $tags]} {incr i} {
10970         set a [lindex $tags $i]
10971         for {set j 0} {$j < $i} {incr j} {
10972             set b [lindex $tags $j]
10973             set r [anc_or_desc $a $b]
10974             if {$r == 1} {
10975                 set tags [lreplace $tags $j $j]
10976                 incr j -1
10977                 incr i -1
10978             } elseif {$r == -1} {
10979                 set tags [lreplace $tags $i $i]
10980                 incr i -1
10981                 break
10982             }
10983         }
10984     }
10985
10986     if {[array names growing] ne {}} {
10987         # graph isn't finished, need to check if any tag could get
10988         # eclipsed by another tag coming later.  Simply ignore any
10989         # tags that could later get eclipsed.
10990         set ctags {}
10991         foreach t $tags {
10992             if {[is_certain $t $origid]} {
10993                 lappend ctags $t
10994             }
10995         }
10996         if {$tags eq $ctags} {
10997             set cached_dtags($origid) $tags
10998         } else {
10999             set tags $ctags
11000         }
11001     } else {
11002         set cached_dtags($origid) $tags
11003     }
11004     set t3 [clock clicks -milliseconds]
11005     if {0 && $t3 - $t1 >= 100} {
11006         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
11007             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
11008     }
11009     return $tags
11010 }
11011
11012 proc anctags {id} {
11013     global arcnos arcids arcout arcend arctags idtags allparents
11014     global growing cached_atags
11015
11016     if {![info exists allparents($id)]} {
11017         return {}
11018     }
11019     set t1 [clock clicks -milliseconds]
11020     set argid $id
11021     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
11022         # part-way along an arc; check that arc first
11023         set a [lindex $arcnos($id) 0]
11024         if {$arctags($a) ne {}} {
11025             validate_arctags $a
11026             set i [lsearch -exact $arcids($a) $id]
11027             foreach t $arctags($a) {
11028                 set j [lsearch -exact $arcids($a) $t]
11029                 if {$j > $i} {
11030                     return $t
11031                 }
11032             }
11033         }
11034         if {![info exists arcend($a)]} {
11035             return {}
11036         }
11037         set id $arcend($a)
11038         if {[info exists idtags($id)]} {
11039             return $id
11040         }
11041     }
11042     if {[info exists cached_atags($id)]} {
11043         return $cached_atags($id)
11044     }
11045
11046     set origid $id
11047     set todo [list $id]
11048     set queued($id) 1
11049     set taglist {}
11050     set nc 1
11051     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
11052         set id [lindex $todo $i]
11053         set done($id) 1
11054         set td [info exists hastaggeddescendent($id)]
11055         if {!$td} {
11056             incr nc -1
11057         }
11058         # ignore tags on starting node
11059         if {!$td && $i > 0} {
11060             if {[info exists idtags($id)]} {
11061                 set tagloc($id) $id
11062                 set td 1
11063             } elseif {[info exists cached_atags($id)]} {
11064                 set tagloc($id) $cached_atags($id)
11065                 set td 1
11066             }
11067         }
11068         foreach a $arcout($id) {
11069             if {!$td && $arctags($a) ne {}} {
11070                 validate_arctags $a
11071                 if {$arctags($a) ne {}} {
11072                     lappend tagloc($id) [lindex $arctags($a) 0]
11073                 }
11074             }
11075             if {![info exists arcend($a)]} continue
11076             set d $arcend($a)
11077             if {$td || $arctags($a) ne {}} {
11078                 set tomark [list $d]
11079                 for {set j 0} {$j < [llength $tomark]} {incr j} {
11080                     set dd [lindex $tomark $j]
11081                     if {![info exists hastaggeddescendent($dd)]} {
11082                         if {[info exists done($dd)]} {
11083                             foreach b $arcout($dd) {
11084                                 if {[info exists arcend($b)]} {
11085                                     lappend tomark $arcend($b)
11086                                 }
11087                             }
11088                             if {[info exists tagloc($dd)]} {
11089                                 unset tagloc($dd)
11090                             }
11091                         } elseif {[info exists queued($dd)]} {
11092                             incr nc -1
11093                         }
11094                         set hastaggeddescendent($dd) 1
11095                     }
11096                 }
11097             }
11098             if {![info exists queued($d)]} {
11099                 lappend todo $d
11100                 set queued($d) 1
11101                 if {![info exists hastaggeddescendent($d)]} {
11102                     incr nc
11103                 }
11104             }
11105         }
11106     }
11107     set t2 [clock clicks -milliseconds]
11108     set loopix $i
11109     set tags {}
11110     foreach id [array names tagloc] {
11111         if {![info exists hastaggeddescendent($id)]} {
11112             foreach t $tagloc($id) {
11113                 if {[lsearch -exact $tags $t] < 0} {
11114                     lappend tags $t
11115                 }
11116             }
11117         }
11118     }
11119
11120     # remove tags that are ancestors of other tags
11121     for {set i 0} {$i < [llength $tags]} {incr i} {
11122         set a [lindex $tags $i]
11123         for {set j 0} {$j < $i} {incr j} {
11124             set b [lindex $tags $j]
11125             set r [anc_or_desc $a $b]
11126             if {$r == -1} {
11127                 set tags [lreplace $tags $j $j]
11128                 incr j -1
11129                 incr i -1
11130             } elseif {$r == 1} {
11131                 set tags [lreplace $tags $i $i]
11132                 incr i -1
11133                 break
11134             }
11135         }
11136     }
11137
11138     if {[array names growing] ne {}} {
11139         # graph isn't finished, need to check if any tag could get
11140         # eclipsed by another tag coming later.  Simply ignore any
11141         # tags that could later get eclipsed.
11142         set ctags {}
11143         foreach t $tags {
11144             if {[is_certain $origid $t]} {
11145                 lappend ctags $t
11146             }
11147         }
11148         if {$tags eq $ctags} {
11149             set cached_atags($origid) $tags
11150         } else {
11151             set tags $ctags
11152         }
11153     } else {
11154         set cached_atags($origid) $tags
11155     }
11156     set t3 [clock clicks -milliseconds]
11157     if {0 && $t3 - $t1 >= 100} {
11158         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
11159             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
11160     }
11161     return $tags
11162 }
11163
11164 # Return the list of IDs that have heads that are descendents of id,
11165 # including id itself if it has a head.
11166 proc descheads {id} {
11167     global arcnos arcstart arcids archeads idheads cached_dheads
11168     global allparents arcout
11169
11170     if {![info exists allparents($id)]} {
11171         return {}
11172     }
11173     set aret {}
11174     if {![info exists arcout($id)]} {
11175         # part-way along an arc; check it first
11176         set a [lindex $arcnos($id) 0]
11177         if {$archeads($a) ne {}} {
11178             validate_archeads $a
11179             set i [lsearch -exact $arcids($a) $id]
11180             foreach t $archeads($a) {
11181                 set j [lsearch -exact $arcids($a) $t]
11182                 if {$j > $i} break
11183                 lappend aret $t
11184             }
11185         }
11186         set id $arcstart($a)
11187     }
11188     set origid $id
11189     set todo [list $id]
11190     set seen($id) 1
11191     set ret {}
11192     for {set i 0} {$i < [llength $todo]} {incr i} {
11193         set id [lindex $todo $i]
11194         if {[info exists cached_dheads($id)]} {
11195             set ret [concat $ret $cached_dheads($id)]
11196         } else {
11197             if {[info exists idheads($id)]} {
11198                 lappend ret $id
11199             }
11200             foreach a $arcnos($id) {
11201                 if {$archeads($a) ne {}} {
11202                     validate_archeads $a
11203                     if {$archeads($a) ne {}} {
11204                         set ret [concat $ret $archeads($a)]
11205                     }
11206                 }
11207                 set d $arcstart($a)
11208                 if {![info exists seen($d)]} {
11209                     lappend todo $d
11210                     set seen($d) 1
11211                 }
11212             }
11213         }
11214     }
11215     set ret [lsort -unique $ret]
11216     set cached_dheads($origid) $ret
11217     return [concat $ret $aret]
11218 }
11219
11220 proc addedtag {id} {
11221     global arcnos arcout cached_dtags cached_atags
11222
11223     if {![info exists arcnos($id)]} return
11224     if {![info exists arcout($id)]} {
11225         recalcarc [lindex $arcnos($id) 0]
11226     }
11227     unset -nocomplain cached_dtags
11228     unset -nocomplain cached_atags
11229 }
11230
11231 proc addedhead {hid head} {
11232     global arcnos arcout cached_dheads
11233
11234     if {![info exists arcnos($hid)]} return
11235     if {![info exists arcout($hid)]} {
11236         recalcarc [lindex $arcnos($hid) 0]
11237     }
11238     unset -nocomplain cached_dheads
11239 }
11240
11241 proc removedhead {hid head} {
11242     global cached_dheads
11243
11244     unset -nocomplain cached_dheads
11245 }
11246
11247 proc movedhead {hid head} {
11248     global arcnos arcout cached_dheads
11249
11250     if {![info exists arcnos($hid)]} return
11251     if {![info exists arcout($hid)]} {
11252         recalcarc [lindex $arcnos($hid) 0]
11253     }
11254     unset -nocomplain cached_dheads
11255 }
11256
11257 proc changedrefs {} {
11258     global cached_dheads cached_dtags cached_atags cached_tagcontent
11259     global arctags archeads arcnos arcout idheads idtags
11260
11261     foreach id [concat [array names idheads] [array names idtags]] {
11262         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
11263             set a [lindex $arcnos($id) 0]
11264             if {![info exists donearc($a)]} {
11265                 recalcarc $a
11266                 set donearc($a) 1
11267             }
11268         }
11269     }
11270     unset -nocomplain cached_tagcontent
11271     unset -nocomplain cached_dtags
11272     unset -nocomplain cached_atags
11273     unset -nocomplain cached_dheads
11274 }
11275
11276 proc rereadrefs {} {
11277     global idtags idheads idotherrefs mainheadid
11278
11279     set refids [concat [array names idtags] \
11280                     [array names idheads] [array names idotherrefs]]
11281     foreach id $refids {
11282         if {![info exists ref($id)]} {
11283             set ref($id) [listrefs $id]
11284         }
11285     }
11286     set oldmainhead $mainheadid
11287     readrefs
11288     changedrefs
11289     set refids [lsort -unique [concat $refids [array names idtags] \
11290                         [array names idheads] [array names idotherrefs]]]
11291     foreach id $refids {
11292         set v [listrefs $id]
11293         if {![info exists ref($id)] || $ref($id) != $v} {
11294             redrawtags $id
11295         }
11296     }
11297     if {$oldmainhead ne $mainheadid} {
11298         redrawtags $oldmainhead
11299         redrawtags $mainheadid
11300     }
11301     run refill_reflist
11302 }
11303
11304 proc listrefs {id} {
11305     global idtags idheads idotherrefs
11306
11307     set x {}
11308     if {[info exists idtags($id)]} {
11309         set x $idtags($id)
11310     }
11311     set y {}
11312     if {[info exists idheads($id)]} {
11313         set y $idheads($id)
11314     }
11315     set z {}
11316     if {[info exists idotherrefs($id)]} {
11317         set z $idotherrefs($id)
11318     }
11319     return [list $x $y $z]
11320 }
11321
11322 proc add_tag_ctext {tag} {
11323     global ctext cached_tagcontent tagids
11324
11325     if {![info exists cached_tagcontent($tag)]} {
11326         catch {
11327             set cached_tagcontent($tag) [exec git cat-file -p $tag]
11328         }
11329     }
11330     $ctext insert end "[mc "Tag"]: $tag\n" bold
11331     if {[info exists cached_tagcontent($tag)]} {
11332         set text $cached_tagcontent($tag)
11333     } else {
11334         set text "[mc "Id"]:  $tagids($tag)"
11335     }
11336     appendwithlinks $text {}
11337 }
11338
11339 proc showtag {tag isnew} {
11340     global ctext cached_tagcontent tagids linknum tagobjid
11341
11342     if {$isnew} {
11343         addtohistory [list showtag $tag 0] savectextpos
11344     }
11345     $ctext conf -state normal
11346     clear_ctext
11347     settabs 0
11348     set linknum 0
11349     add_tag_ctext $tag
11350     maybe_scroll_ctext 1
11351     $ctext conf -state disabled
11352     init_flist {}
11353 }
11354
11355 proc showtags {id isnew} {
11356     global idtags ctext linknum
11357
11358     if {$isnew} {
11359         addtohistory [list showtags $id 0] savectextpos
11360     }
11361     $ctext conf -state normal
11362     clear_ctext
11363     settabs 0
11364     set linknum 0
11365     set sep {}
11366     foreach tag $idtags($id) {
11367         $ctext insert end $sep
11368         add_tag_ctext $tag
11369         set sep "\n\n"
11370     }
11371     maybe_scroll_ctext 1
11372     $ctext conf -state disabled
11373     init_flist {}
11374 }
11375
11376 proc doquit {} {
11377     global stopped
11378     global gitktmpdir
11379
11380     set stopped 100
11381     savestuff .
11382     destroy .
11383
11384     if {[info exists gitktmpdir]} {
11385         catch {file delete -force $gitktmpdir}
11386     }
11387 }
11388
11389 proc mkfontdisp {font top which} {
11390     global fontattr fontpref $font NS use_ttk
11391
11392     set fontpref($font) [set $font]
11393     ${NS}::button $top.${font}but -text $which \
11394         -command [list choosefont $font $which]
11395     ${NS}::label $top.$font -relief flat -font $font \
11396         -text $fontattr($font,family) -justify left
11397     grid x $top.${font}but $top.$font -sticky w
11398 }
11399
11400 proc choosefont {font which} {
11401     global fontparam fontlist fonttop fontattr
11402     global prefstop NS
11403
11404     set fontparam(which) $which
11405     set fontparam(font) $font
11406     set fontparam(family) [font actual $font -family]
11407     set fontparam(size) $fontattr($font,size)
11408     set fontparam(weight) $fontattr($font,weight)
11409     set fontparam(slant) $fontattr($font,slant)
11410     set top .gitkfont
11411     set fonttop $top
11412     if {![winfo exists $top]} {
11413         font create sample
11414         eval font config sample [font actual $font]
11415         ttk_toplevel $top
11416         make_transient $top $prefstop
11417         wm title $top [mc "Gitk font chooser"]
11418         ${NS}::label $top.l -textvariable fontparam(which)
11419         pack $top.l -side top
11420         set fontlist [lsort [font families]]
11421         ${NS}::frame $top.f
11422         listbox $top.f.fam -listvariable fontlist \
11423             -yscrollcommand [list $top.f.sb set]
11424         bind $top.f.fam <<ListboxSelect>> selfontfam
11425         ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11426         pack $top.f.sb -side right -fill y
11427         pack $top.f.fam -side left -fill both -expand 1
11428         pack $top.f -side top -fill both -expand 1
11429         ${NS}::frame $top.g
11430         spinbox $top.g.size -from 4 -to 40 -width 4 \
11431             -textvariable fontparam(size) \
11432             -validatecommand {string is integer -strict %s}
11433         checkbutton $top.g.bold -padx 5 \
11434             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11435             -variable fontparam(weight) -onvalue bold -offvalue normal
11436         checkbutton $top.g.ital -padx 5 \
11437             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
11438             -variable fontparam(slant) -onvalue italic -offvalue roman
11439         pack $top.g.size $top.g.bold $top.g.ital -side left
11440         pack $top.g -side top
11441         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11442             -background white
11443         $top.c create text 100 25 -anchor center -text $which -font sample \
11444             -fill black -tags text
11445         bind $top.c <Configure> [list centertext $top.c]
11446         pack $top.c -side top -fill x
11447         ${NS}::frame $top.buts
11448         ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11449         ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11450         bind $top <Key-Return> fontok
11451         bind $top <Key-Escape> fontcan
11452         grid $top.buts.ok $top.buts.can
11453         grid columnconfigure $top.buts 0 -weight 1 -uniform a
11454         grid columnconfigure $top.buts 1 -weight 1 -uniform a
11455         pack $top.buts -side bottom -fill x
11456         trace add variable fontparam write chg_fontparam
11457     } else {
11458         raise $top
11459         $top.c itemconf text -text $which
11460     }
11461     set i [lsearch -exact $fontlist $fontparam(family)]
11462     if {$i >= 0} {
11463         $top.f.fam selection set $i
11464         $top.f.fam see $i
11465     }
11466 }
11467
11468 proc centertext {w} {
11469     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11470 }
11471
11472 proc fontok {} {
11473     global fontparam fontpref prefstop
11474
11475     set f $fontparam(font)
11476     set fontpref($f) [list $fontparam(family) $fontparam(size)]
11477     if {$fontparam(weight) eq "bold"} {
11478         lappend fontpref($f) "bold"
11479     }
11480     if {$fontparam(slant) eq "italic"} {
11481         lappend fontpref($f) "italic"
11482     }
11483     set w $prefstop.notebook.fonts.$f
11484     $w conf -text $fontparam(family) -font $fontpref($f)
11485
11486     fontcan
11487 }
11488
11489 proc fontcan {} {
11490     global fonttop fontparam
11491
11492     if {[info exists fonttop]} {
11493         catch {destroy $fonttop}
11494         catch {font delete sample}
11495         unset fonttop
11496         unset fontparam
11497     }
11498 }
11499
11500 if {[package vsatisfies [package provide Tk] 8.6]} {
11501     # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11502     # function to make use of it.
11503     proc choosefont {font which} {
11504         tk fontchooser configure -title $which -font $font \
11505             -command [list on_choosefont $font $which]
11506         tk fontchooser show
11507     }
11508     proc on_choosefont {font which newfont} {
11509         global fontparam
11510         puts stderr "$font $newfont"
11511         array set f [font actual $newfont]
11512         set fontparam(which) $which
11513         set fontparam(font) $font
11514         set fontparam(family) $f(-family)
11515         set fontparam(size) $f(-size)
11516         set fontparam(weight) $f(-weight)
11517         set fontparam(slant) $f(-slant)
11518         fontok
11519     }
11520 }
11521
11522 proc selfontfam {} {
11523     global fonttop fontparam
11524
11525     set i [$fonttop.f.fam curselection]
11526     if {$i ne {}} {
11527         set fontparam(family) [$fonttop.f.fam get $i]
11528     }
11529 }
11530
11531 proc chg_fontparam {v sub op} {
11532     global fontparam
11533
11534     font config sample -$sub $fontparam($sub)
11535 }
11536
11537 # Create a property sheet tab page
11538 proc create_prefs_page {w} {
11539     global NS
11540     set parent [join [lrange [split $w .] 0 end-1] .]
11541     if {[winfo class $parent] eq "TNotebook"} {
11542         ${NS}::frame $w
11543     } else {
11544         ${NS}::labelframe $w
11545     }
11546 }
11547
11548 proc prefspage_general {notebook} {
11549     global NS maxwidth maxgraphpct showneartags showlocalchanges
11550     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11551     global hideremotes want_ttk have_ttk maxrefs web_browser
11552
11553     set page [create_prefs_page $notebook.general]
11554
11555     ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11556     grid $page.ldisp - -sticky w -pady 10
11557     ${NS}::label $page.spacer -text " "
11558     ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11559     spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11560     grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11561                                          #xgettext:no-tcl-format
11562     ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11563     spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11564     grid x $page.maxpctl $page.maxpct -sticky w
11565     ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11566         -variable showlocalchanges
11567     grid x $page.showlocal -sticky w
11568     ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11569         -variable autoselect
11570     spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11571     grid x $page.autoselect $page.autosellen -sticky w
11572     ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11573         -variable hideremotes
11574     grid x $page.hideremotes -sticky w
11575
11576     ${NS}::label $page.ddisp -text [mc "Diff display options"]
11577     grid $page.ddisp - -sticky w -pady 10
11578     ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11579     spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11580     grid x $page.tabstopl $page.tabstop -sticky w
11581     ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11582         -variable showneartags
11583     grid x $page.ntag -sticky w
11584     ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11585     spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11586     grid x $page.maxrefsl $page.maxrefs -sticky w
11587     ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11588         -variable limitdiffs
11589     grid x $page.ldiff -sticky w
11590     ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11591         -variable perfile_attrs
11592     grid x $page.lattr -sticky w
11593
11594     ${NS}::entry $page.extdifft -textvariable extdifftool
11595     ${NS}::frame $page.extdifff
11596     ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11597     ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11598     pack $page.extdifff.l $page.extdifff.b -side left
11599     pack configure $page.extdifff.l -padx 10
11600     grid x $page.extdifff $page.extdifft -sticky ew
11601
11602     ${NS}::entry $page.webbrowser -textvariable web_browser
11603     ${NS}::frame $page.webbrowserf
11604     ${NS}::label $page.webbrowserf.l -text [mc "Web browser" ]
11605     pack $page.webbrowserf.l -side left
11606     pack configure $page.webbrowserf.l -padx 10
11607     grid x $page.webbrowserf $page.webbrowser -sticky ew
11608
11609     ${NS}::label $page.lgen -text [mc "General options"]
11610     grid $page.lgen - -sticky w -pady 10
11611     ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11612         -text [mc "Use themed widgets"]
11613     if {$have_ttk} {
11614         ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11615     } else {
11616         ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11617     }
11618     grid x $page.want_ttk $page.ttk_note -sticky w
11619     return $page
11620 }
11621
11622 proc prefspage_colors {notebook} {
11623     global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11624     global diffbgcolors
11625
11626     set page [create_prefs_page $notebook.colors]
11627
11628     ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11629     grid $page.cdisp - -sticky w -pady 10
11630     label $page.ui -padx 40 -relief sunk -background $uicolor
11631     ${NS}::button $page.uibut -text [mc "Interface"] \
11632        -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11633     grid x $page.uibut $page.ui -sticky w
11634     label $page.bg -padx 40 -relief sunk -background $bgcolor
11635     ${NS}::button $page.bgbut -text [mc "Background"] \
11636         -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11637     grid x $page.bgbut $page.bg -sticky w
11638     label $page.fg -padx 40 -relief sunk -background $fgcolor
11639     ${NS}::button $page.fgbut -text [mc "Foreground"] \
11640         -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11641     grid x $page.fgbut $page.fg -sticky w
11642     label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11643     ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11644         -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11645                       [list $ctext tag conf d0 -foreground]]
11646     grid x $page.diffoldbut $page.diffold -sticky w
11647     label $page.diffoldbg -padx 40 -relief sunk -background [lindex $diffbgcolors 0]
11648     ${NS}::button $page.diffoldbgbut -text [mc "Diff: old lines bg"] \
11649         -command [list choosecolor diffbgcolors 0 $page.diffoldbg \
11650                       [mc "diff old lines bg"] \
11651                       [list $ctext tag conf d0 -background]]
11652     grid x $page.diffoldbgbut $page.diffoldbg -sticky w
11653     label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11654     ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11655         -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11656                       [list $ctext tag conf dresult -foreground]]
11657     grid x $page.diffnewbut $page.diffnew -sticky w
11658     label $page.diffnewbg -padx 40 -relief sunk -background [lindex $diffbgcolors 1]
11659     ${NS}::button $page.diffnewbgbut -text [mc "Diff: new lines bg"] \
11660         -command [list choosecolor diffbgcolors 1 $page.diffnewbg \
11661                       [mc "diff new lines bg"] \
11662                       [list $ctext tag conf dresult -background]]
11663     grid x $page.diffnewbgbut $page.diffnewbg -sticky w
11664     label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11665     ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11666         -command [list choosecolor diffcolors 2 $page.hunksep \
11667                       [mc "diff hunk header"] \
11668                       [list $ctext tag conf hunksep -foreground]]
11669     grid x $page.hunksepbut $page.hunksep -sticky w
11670     label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11671     ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11672         -command [list choosecolor markbgcolor {} $page.markbgsep \
11673                       [mc "marked line background"] \
11674                       [list $ctext tag conf omark -background]]
11675     grid x $page.markbgbut $page.markbgsep -sticky w
11676     label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11677     ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11678         -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11679     grid x $page.selbgbut $page.selbgsep -sticky w
11680     return $page
11681 }
11682
11683 proc prefspage_fonts {notebook} {
11684     global NS
11685     set page [create_prefs_page $notebook.fonts]
11686     ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11687     grid $page.cfont - -sticky w -pady 10
11688     mkfontdisp mainfont $page [mc "Main font"]
11689     mkfontdisp textfont $page [mc "Diff display font"]
11690     mkfontdisp uifont $page [mc "User interface font"]
11691     return $page
11692 }
11693
11694 proc doprefs {} {
11695     global maxwidth maxgraphpct use_ttk NS
11696     global oldprefs prefstop showneartags showlocalchanges
11697     global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11698     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11699     global hideremotes want_ttk have_ttk
11700
11701     set top .gitkprefs
11702     set prefstop $top
11703     if {[winfo exists $top]} {
11704         raise $top
11705         return
11706     }
11707     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11708                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11709         set oldprefs($v) [set $v]
11710     }
11711     ttk_toplevel $top
11712     wm title $top [mc "Gitk preferences"]
11713     make_transient $top .
11714
11715     if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11716         set notebook [ttk::notebook $top.notebook]
11717     } else {
11718         set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11719     }
11720
11721     lappend pages [prefspage_general $notebook] [mc "General"]
11722     lappend pages [prefspage_colors $notebook] [mc "Colors"]
11723     lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11724     set col 0
11725     foreach {page title} $pages {
11726         if {$use_notebook} {
11727             $notebook add $page -text $title
11728         } else {
11729             set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11730                          -text $title -command [list raise $page]]
11731             $page configure -text $title
11732             grid $btn -row 0 -column [incr col] -sticky w
11733             grid $page -row 1 -column 0 -sticky news -columnspan 100
11734         }
11735     }
11736
11737     if {!$use_notebook} {
11738         grid columnconfigure $notebook 0 -weight 1
11739         grid rowconfigure $notebook 1 -weight 1
11740         raise [lindex $pages 0]
11741     }
11742
11743     grid $notebook -sticky news -padx 2 -pady 2
11744     grid rowconfigure $top 0 -weight 1
11745     grid columnconfigure $top 0 -weight 1
11746
11747     ${NS}::frame $top.buts
11748     ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11749     ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11750     bind $top <Key-Return> prefsok
11751     bind $top <Key-Escape> prefscan
11752     grid $top.buts.ok $top.buts.can
11753     grid columnconfigure $top.buts 0 -weight 1 -uniform a
11754     grid columnconfigure $top.buts 1 -weight 1 -uniform a
11755     grid $top.buts - - -pady 10 -sticky ew
11756     grid columnconfigure $top 2 -weight 1
11757     bind $top <Visibility> [list focus $top.buts.ok]
11758 }
11759
11760 proc choose_extdiff {} {
11761     global extdifftool
11762
11763     set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11764     if {$prog ne {}} {
11765         set extdifftool $prog
11766     }
11767 }
11768
11769 proc choosecolor {v vi w x cmd} {
11770     global $v
11771
11772     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11773                -title [mc "Gitk: choose color for %s" $x]]
11774     if {$c eq {}} return
11775     $w conf -background $c
11776     lset $v $vi $c
11777     eval $cmd $c
11778 }
11779
11780 proc setselbg {c} {
11781     global bglist cflist
11782     foreach w $bglist {
11783         if {[winfo exists $w]} {
11784             $w configure -selectbackground $c
11785         }
11786     }
11787     $cflist tag configure highlight \
11788         -background [$cflist cget -selectbackground]
11789     allcanvs itemconf secsel -fill $c
11790 }
11791
11792 # This sets the background color and the color scheme for the whole UI.
11793 # For some reason, tk_setPalette chooses a nasty dark red for selectColor
11794 # if we don't specify one ourselves, which makes the checkbuttons and
11795 # radiobuttons look bad.  This chooses white for selectColor if the
11796 # background color is light, or black if it is dark.
11797 proc setui {c} {
11798     if {[tk windowingsystem] eq "win32"} { return }
11799     set bg [winfo rgb . $c]
11800     set selc black
11801     if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11802         set selc white
11803     }
11804     tk_setPalette background $c selectColor $selc
11805 }
11806
11807 proc setbg {c} {
11808     global bglist
11809
11810     foreach w $bglist {
11811         if {[winfo exists $w]} {
11812             $w conf -background $c
11813         }
11814     }
11815 }
11816
11817 proc setfg {c} {
11818     global fglist canv
11819
11820     foreach w $fglist {
11821         if {[winfo exists $w]} {
11822             $w conf -foreground $c
11823         }
11824     }
11825     allcanvs itemconf text -fill $c
11826     $canv itemconf circle -outline $c
11827     $canv itemconf markid -outline $c
11828 }
11829
11830 proc prefscan {} {
11831     global oldprefs prefstop
11832
11833     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11834                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11835         global $v
11836         set $v $oldprefs($v)
11837     }
11838     catch {destroy $prefstop}
11839     unset prefstop
11840     fontcan
11841 }
11842
11843 proc prefsok {} {
11844     global maxwidth maxgraphpct
11845     global oldprefs prefstop showneartags showlocalchanges
11846     global fontpref mainfont textfont uifont
11847     global limitdiffs treediffs perfile_attrs
11848     global hideremotes
11849
11850     catch {destroy $prefstop}
11851     unset prefstop
11852     fontcan
11853     set fontchanged 0
11854     if {$mainfont ne $fontpref(mainfont)} {
11855         set mainfont $fontpref(mainfont)
11856         parsefont mainfont $mainfont
11857         eval font configure mainfont [fontflags mainfont]
11858         eval font configure mainfontbold [fontflags mainfont 1]
11859         setcoords
11860         set fontchanged 1
11861     }
11862     if {$textfont ne $fontpref(textfont)} {
11863         set textfont $fontpref(textfont)
11864         parsefont textfont $textfont
11865         eval font configure textfont [fontflags textfont]
11866         eval font configure textfontbold [fontflags textfont 1]
11867     }
11868     if {$uifont ne $fontpref(uifont)} {
11869         set uifont $fontpref(uifont)
11870         parsefont uifont $uifont
11871         eval font configure uifont [fontflags uifont]
11872     }
11873     settabs
11874     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11875         if {$showlocalchanges} {
11876             doshowlocalchanges
11877         } else {
11878             dohidelocalchanges
11879         }
11880     }
11881     if {$limitdiffs != $oldprefs(limitdiffs) ||
11882         ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11883         # treediffs elements are limited by path;
11884         # won't have encodings cached if perfile_attrs was just turned on
11885         unset -nocomplain treediffs
11886     }
11887     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11888         || $maxgraphpct != $oldprefs(maxgraphpct)} {
11889         redisplay
11890     } elseif {$showneartags != $oldprefs(showneartags) ||
11891           $limitdiffs != $oldprefs(limitdiffs)} {
11892         reselectline
11893     }
11894     if {$hideremotes != $oldprefs(hideremotes)} {
11895         rereadrefs
11896     }
11897 }
11898
11899 proc formatdate {d} {
11900     global datetimeformat
11901     if {$d ne {}} {
11902         # If $datetimeformat includes a timezone, display in the
11903         # timezone of the argument.  Otherwise, display in local time.
11904         if {[string match {*%[zZ]*} $datetimeformat]} {
11905             if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11906                 # Tcl < 8.5 does not support -timezone.  Emulate it by
11907                 # setting TZ (e.g. TZ=<-0430>+04:30).
11908                 global env
11909                 if {[info exists env(TZ)]} {
11910                     set savedTZ $env(TZ)
11911                 }
11912                 set zone [lindex $d 1]
11913                 set sign [string map {+ - - +} [string index $zone 0]]
11914                 set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11915                 set d [clock format [lindex $d 0] -format $datetimeformat]
11916                 if {[info exists savedTZ]} {
11917                     set env(TZ) $savedTZ
11918                 } else {
11919                     unset env(TZ)
11920                 }
11921             }
11922         } else {
11923             set d [clock format [lindex $d 0] -format $datetimeformat]
11924         }
11925     }
11926     return $d
11927 }
11928
11929 # This list of encoding names and aliases is distilled from
11930 # http://www.iana.org/assignments/character-sets.
11931 # Not all of them are supported by Tcl.
11932 set encoding_aliases {
11933     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11934       ISO646-US US-ASCII us IBM367 cp367 csASCII }
11935     { ISO-10646-UTF-1 csISO10646UTF1 }
11936     { ISO_646.basic:1983 ref csISO646basic1983 }
11937     { INVARIANT csINVARIANT }
11938     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11939     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11940     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11941     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11942     { NATS-DANO iso-ir-9-1 csNATSDANO }
11943     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11944     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11945     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11946     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11947     { ISO-2022-KR csISO2022KR }
11948     { EUC-KR csEUCKR }
11949     { ISO-2022-JP csISO2022JP }
11950     { ISO-2022-JP-2 csISO2022JP2 }
11951     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11952       csISO13JISC6220jp }
11953     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11954     { IT iso-ir-15 ISO646-IT csISO15Italian }
11955     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11956     { ES iso-ir-17 ISO646-ES csISO17Spanish }
11957     { greek7-old iso-ir-18 csISO18Greek7Old }
11958     { latin-greek iso-ir-19 csISO19LatinGreek }
11959     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11960     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11961     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11962     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11963     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11964     { BS_viewdata iso-ir-47 csISO47BSViewdata }
11965     { INIS iso-ir-49 csISO49INIS }
11966     { INIS-8 iso-ir-50 csISO50INIS8 }
11967     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11968     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11969     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11970     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11971     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11972     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11973       csISO60Norwegian1 }
11974     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11975     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11976     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11977     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11978     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11979     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11980     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11981     { greek7 iso-ir-88 csISO88Greek7 }
11982     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11983     { iso-ir-90 csISO90 }
11984     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11985     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11986       csISO92JISC62991984b }
11987     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11988     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11989     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11990       csISO95JIS62291984handadd }
11991     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11992     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11993     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11994     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11995       CP819 csISOLatin1 }
11996     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11997     { T.61-7bit iso-ir-102 csISO102T617bit }
11998     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11999     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
12000     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
12001     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
12002     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
12003     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
12004     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
12005     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
12006       arabic csISOLatinArabic }
12007     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
12008     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
12009     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
12010       greek greek8 csISOLatinGreek }
12011     { T.101-G2 iso-ir-128 csISO128T101G2 }
12012     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
12013       csISOLatinHebrew }
12014     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
12015     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
12016     { CSN_369103 iso-ir-139 csISO139CSN369103 }
12017     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
12018     { ISO_6937-2-add iso-ir-142 csISOTextComm }
12019     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
12020     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
12021       csISOLatinCyrillic }
12022     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
12023     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
12024     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
12025     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
12026     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
12027     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
12028     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
12029     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
12030     { ISO_10367-box iso-ir-155 csISO10367Box }
12031     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
12032     { latin-lap lap iso-ir-158 csISO158Lap }
12033     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
12034     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
12035     { us-dk csUSDK }
12036     { dk-us csDKUS }
12037     { JIS_X0201 X0201 csHalfWidthKatakana }
12038     { KSC5636 ISO646-KR csKSC5636 }
12039     { ISO-10646-UCS-2 csUnicode }
12040     { ISO-10646-UCS-4 csUCS4 }
12041     { DEC-MCS dec csDECMCS }
12042     { hp-roman8 roman8 r8 csHPRoman8 }
12043     { macintosh mac csMacintosh }
12044     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
12045       csIBM037 }
12046     { IBM038 EBCDIC-INT cp038 csIBM038 }
12047     { IBM273 CP273 csIBM273 }
12048     { IBM274 EBCDIC-BE CP274 csIBM274 }
12049     { IBM275 EBCDIC-BR cp275 csIBM275 }
12050     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
12051     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
12052     { IBM280 CP280 ebcdic-cp-it csIBM280 }
12053     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
12054     { IBM284 CP284 ebcdic-cp-es csIBM284 }
12055     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
12056     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
12057     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
12058     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
12059     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
12060     { IBM424 cp424 ebcdic-cp-he csIBM424 }
12061     { IBM437 cp437 437 csPC8CodePage437 }
12062     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
12063     { IBM775 cp775 csPC775Baltic }
12064     { IBM850 cp850 850 csPC850Multilingual }
12065     { IBM851 cp851 851 csIBM851 }
12066     { IBM852 cp852 852 csPCp852 }
12067     { IBM855 cp855 855 csIBM855 }
12068     { IBM857 cp857 857 csIBM857 }
12069     { IBM860 cp860 860 csIBM860 }
12070     { IBM861 cp861 861 cp-is csIBM861 }
12071     { IBM862 cp862 862 csPC862LatinHebrew }
12072     { IBM863 cp863 863 csIBM863 }
12073     { IBM864 cp864 csIBM864 }
12074     { IBM865 cp865 865 csIBM865 }
12075     { IBM866 cp866 866 csIBM866 }
12076     { IBM868 CP868 cp-ar csIBM868 }
12077     { IBM869 cp869 869 cp-gr csIBM869 }
12078     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
12079     { IBM871 CP871 ebcdic-cp-is csIBM871 }
12080     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
12081     { IBM891 cp891 csIBM891 }
12082     { IBM903 cp903 csIBM903 }
12083     { IBM904 cp904 904 csIBBM904 }
12084     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
12085     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
12086     { IBM1026 CP1026 csIBM1026 }
12087     { EBCDIC-AT-DE csIBMEBCDICATDE }
12088     { EBCDIC-AT-DE-A csEBCDICATDEA }
12089     { EBCDIC-CA-FR csEBCDICCAFR }
12090     { EBCDIC-DK-NO csEBCDICDKNO }
12091     { EBCDIC-DK-NO-A csEBCDICDKNOA }
12092     { EBCDIC-FI-SE csEBCDICFISE }
12093     { EBCDIC-FI-SE-A csEBCDICFISEA }
12094     { EBCDIC-FR csEBCDICFR }
12095     { EBCDIC-IT csEBCDICIT }
12096     { EBCDIC-PT csEBCDICPT }
12097     { EBCDIC-ES csEBCDICES }
12098     { EBCDIC-ES-A csEBCDICESA }
12099     { EBCDIC-ES-S csEBCDICESS }
12100     { EBCDIC-UK csEBCDICUK }
12101     { EBCDIC-US csEBCDICUS }
12102     { UNKNOWN-8BIT csUnknown8BiT }
12103     { MNEMONIC csMnemonic }
12104     { MNEM csMnem }
12105     { VISCII csVISCII }
12106     { VIQR csVIQR }
12107     { KOI8-R csKOI8R }
12108     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
12109     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
12110     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
12111     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
12112     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
12113     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
12114     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
12115     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
12116     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
12117     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
12118     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
12119     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
12120     { IBM1047 IBM-1047 }
12121     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
12122     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
12123     { UNICODE-1-1 csUnicode11 }
12124     { CESU-8 csCESU-8 }
12125     { BOCU-1 csBOCU-1 }
12126     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
12127     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
12128       l8 }
12129     { ISO-8859-15 ISO_8859-15 Latin-9 }
12130     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
12131     { GBK CP936 MS936 windows-936 }
12132     { JIS_Encoding csJISEncoding }
12133     { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
12134     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
12135       EUC-JP }
12136     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
12137     { ISO-10646-UCS-Basic csUnicodeASCII }
12138     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
12139     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
12140     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
12141     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
12142     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
12143     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
12144     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
12145     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
12146     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
12147     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
12148     { Adobe-Standard-Encoding csAdobeStandardEncoding }
12149     { Ventura-US csVenturaUS }
12150     { Ventura-International csVenturaInternational }
12151     { PC8-Danish-Norwegian csPC8DanishNorwegian }
12152     { PC8-Turkish csPC8Turkish }
12153     { IBM-Symbols csIBMSymbols }
12154     { IBM-Thai csIBMThai }
12155     { HP-Legal csHPLegal }
12156     { HP-Pi-font csHPPiFont }
12157     { HP-Math8 csHPMath8 }
12158     { Adobe-Symbol-Encoding csHPPSMath }
12159     { HP-DeskTop csHPDesktop }
12160     { Ventura-Math csVenturaMath }
12161     { Microsoft-Publishing csMicrosoftPublishing }
12162     { Windows-31J csWindows31J }
12163     { GB2312 csGB2312 }
12164     { Big5 csBig5 }
12165 }
12166
12167 proc tcl_encoding {enc} {
12168     global encoding_aliases tcl_encoding_cache
12169     if {[info exists tcl_encoding_cache($enc)]} {
12170         return $tcl_encoding_cache($enc)
12171     }
12172     set names [encoding names]
12173     set lcnames [string tolower $names]
12174     set enc [string tolower $enc]
12175     set i [lsearch -exact $lcnames $enc]
12176     if {$i < 0} {
12177         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
12178         if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
12179             set i [lsearch -exact $lcnames $encx]
12180         }
12181     }
12182     if {$i < 0} {
12183         foreach l $encoding_aliases {
12184             set ll [string tolower $l]
12185             if {[lsearch -exact $ll $enc] < 0} continue
12186             # look through the aliases for one that tcl knows about
12187             foreach e $ll {
12188                 set i [lsearch -exact $lcnames $e]
12189                 if {$i < 0} {
12190                     if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
12191                         set i [lsearch -exact $lcnames $ex]
12192                     }
12193                 }
12194                 if {$i >= 0} break
12195             }
12196             break
12197         }
12198     }
12199     set tclenc {}
12200     if {$i >= 0} {
12201         set tclenc [lindex $names $i]
12202     }
12203     set tcl_encoding_cache($enc) $tclenc
12204     return $tclenc
12205 }
12206
12207 proc gitattr {path attr default} {
12208     global path_attr_cache
12209     if {[info exists path_attr_cache($attr,$path)]} {
12210         set r $path_attr_cache($attr,$path)
12211     } else {
12212         set r "unspecified"
12213         if {![catch {set line [exec git check-attr $attr -- $path]}]} {
12214             regexp "(.*): $attr: (.*)" $line m f r
12215         }
12216         set path_attr_cache($attr,$path) $r
12217     }
12218     if {$r eq "unspecified"} {
12219         return $default
12220     }
12221     return $r
12222 }
12223
12224 proc cache_gitattr {attr pathlist} {
12225     global path_attr_cache
12226     set newlist {}
12227     foreach path $pathlist {
12228         if {![info exists path_attr_cache($attr,$path)]} {
12229             lappend newlist $path
12230         }
12231     }
12232     set lim 1000
12233     if {[tk windowingsystem] == "win32"} {
12234         # windows has a 32k limit on the arguments to a command...
12235         set lim 30
12236     }
12237     while {$newlist ne {}} {
12238         set head [lrange $newlist 0 [expr {$lim - 1}]]
12239         set newlist [lrange $newlist $lim end]
12240         if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
12241             foreach row [split $rlist "\n"] {
12242                 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
12243                     if {[string index $path 0] eq "\""} {
12244                         set path [encoding convertfrom [lindex $path 0]]
12245                     }
12246                     set path_attr_cache($attr,$path) $value
12247                 }
12248             }
12249         }
12250     }
12251 }
12252
12253 proc get_path_encoding {path} {
12254     global gui_encoding perfile_attrs
12255     set tcl_enc $gui_encoding
12256     if {$path ne {} && $perfile_attrs} {
12257         set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
12258         if {$enc2 ne {}} {
12259             set tcl_enc $enc2
12260         }
12261     }
12262     return $tcl_enc
12263 }
12264
12265 ## For msgcat loading, first locate the installation location.
12266 if { [info exists ::env(GITK_MSGSDIR)] } {
12267     ## Msgsdir was manually set in the environment.
12268     set gitk_msgsdir $::env(GITK_MSGSDIR)
12269 } else {
12270     ## Let's guess the prefix from argv0.
12271     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12272     set gitk_libdir [file join $gitk_prefix share gitk lib]
12273     set gitk_msgsdir [file join $gitk_libdir msgs]
12274     unset gitk_prefix
12275 }
12276
12277 ## Internationalization (i18n) through msgcat and gettext. See
12278 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12279 package require msgcat
12280 namespace import ::msgcat::mc
12281 ## And eventually load the actual message catalog
12282 ::msgcat::mcload $gitk_msgsdir
12283
12284 # First check that Tcl/Tk is recent enough
12285 if {[catch {package require Tk 8.4} err]} {
12286     show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
12287                          Gitk requires at least Tcl/Tk 8.4."]
12288     exit 1
12289 }
12290
12291 # on OSX bring the current Wish process window to front
12292 if {[tk windowingsystem] eq "aqua"} {
12293     exec osascript -e [format {
12294         tell application "System Events"
12295             set frontmost of processes whose unix id is %d to true
12296         end tell
12297     } [pid] ]
12298 }
12299
12300 # Unset GIT_TRACE var if set
12301 if { [info exists ::env(GIT_TRACE)] } {
12302     unset ::env(GIT_TRACE)
12303 }
12304
12305 # defaults...
12306 set wrcomcmd "git diff-tree --stdin -p --pretty=email"
12307
12308 set gitencoding {}
12309 catch {
12310     set gitencoding [exec git config --get i18n.commitencoding]
12311 }
12312 catch {
12313     set gitencoding [exec git config --get i18n.logoutputencoding]
12314 }
12315 if {$gitencoding == ""} {
12316     set gitencoding "utf-8"
12317 }
12318 set tclencoding [tcl_encoding $gitencoding]
12319 if {$tclencoding == {}} {
12320     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
12321 }
12322
12323 set gui_encoding [encoding system]
12324 catch {
12325     set enc [exec git config --get gui.encoding]
12326     if {$enc ne {}} {
12327         set tclenc [tcl_encoding $enc]
12328         if {$tclenc ne {}} {
12329             set gui_encoding $tclenc
12330         } else {
12331             puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
12332         }
12333     }
12334 }
12335
12336 set log_showroot true
12337 catch {
12338     set log_showroot [exec git config --bool --get log.showroot]
12339 }
12340
12341 if {[tk windowingsystem] eq "aqua"} {
12342     set mainfont {{Lucida Grande} 9}
12343     set textfont {Monaco 9}
12344     set uifont {{Lucida Grande} 9 bold}
12345 } elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
12346     # fontconfig!
12347     set mainfont {sans 9}
12348     set textfont {monospace 9}
12349     set uifont {sans 9 bold}
12350 } else {
12351     set mainfont {Helvetica 9}
12352     set textfont {Courier 9}
12353     set uifont {Helvetica 9 bold}
12354 }
12355 set tabstop 8
12356 set findmergefiles 0
12357 set maxgraphpct 50
12358 set maxwidth 16
12359 set revlistorder 0
12360 set fastdate 0
12361 set uparrowlen 5
12362 set downarrowlen 5
12363 set mingaplen 100
12364 set cmitmode "patch"
12365 set wrapcomment "none"
12366 set showneartags 1
12367 set hideremotes 0
12368 set maxrefs 20
12369 set visiblerefs {"master"}
12370 set maxlinelen 200
12371 set showlocalchanges 1
12372 set limitdiffs 1
12373 set datetimeformat "%Y-%m-%d %H:%M:%S"
12374 set autoselect 1
12375 set autosellen 40
12376 set perfile_attrs 0
12377 set want_ttk 1
12378
12379 if {[tk windowingsystem] eq "aqua"} {
12380     set extdifftool "opendiff"
12381 } else {
12382     set extdifftool "meld"
12383 }
12384
12385 set colors {"#00ff00" red blue magenta darkgrey brown orange}
12386 if {[tk windowingsystem] eq "win32"} {
12387     set uicolor SystemButtonFace
12388     set uifgcolor SystemButtonText
12389     set uifgdisabledcolor SystemDisabledText
12390     set bgcolor SystemWindow
12391     set fgcolor SystemWindowText
12392     set selectbgcolor SystemHighlight
12393     set web_browser "cmd /c start"
12394 } else {
12395     set uicolor grey85
12396     set uifgcolor black
12397     set uifgdisabledcolor "#999"
12398     set bgcolor white
12399     set fgcolor black
12400     set selectbgcolor gray85
12401     if {[tk windowingsystem] eq "aqua"} {
12402         set web_browser "open"
12403     } else {
12404         set web_browser "xdg-open"
12405     }
12406 }
12407 set diffcolors {"#c30000" "#009800" blue}
12408 set diffbgcolors {"#fff3f3" "#f0fff0"}
12409 set diffcontext 3
12410 set mergecolors {red blue "#00ff00" purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12411 set ignorespace 0
12412 set worddiff ""
12413 set markbgcolor "#e0e0ff"
12414
12415 set headbgcolor "#00ff00"
12416 set headfgcolor black
12417 set headoutlinecolor black
12418 set remotebgcolor #ffddaa
12419 set tagbgcolor yellow
12420 set tagfgcolor black
12421 set tagoutlinecolor black
12422 set reflinecolor black
12423 set filesepbgcolor #aaaaaa
12424 set filesepfgcolor black
12425 set linehoverbgcolor #ffff80
12426 set linehoverfgcolor black
12427 set linehoveroutlinecolor black
12428 set mainheadcirclecolor yellow
12429 set workingfilescirclecolor red
12430 set indexcirclecolor "#00ff00"
12431 set circlecolors {white blue gray blue blue}
12432 set linkfgcolor blue
12433 set circleoutlinecolor $fgcolor
12434 set foundbgcolor yellow
12435 set currentsearchhitbgcolor orange
12436
12437 # button for popping up context menus
12438 if {[tk windowingsystem] eq "aqua"} {
12439     set ctxbut <Button-2>
12440 } else {
12441     set ctxbut <Button-3>
12442 }
12443
12444 catch {
12445     # follow the XDG base directory specification by default. See
12446     # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
12447     if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
12448         # XDG_CONFIG_HOME environment variable is set
12449         set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12450         set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
12451     } else {
12452         # default XDG_CONFIG_HOME
12453         set config_file "~/.config/git/gitk"
12454         set config_file_tmp "~/.config/git/gitk-tmp"
12455     }
12456     if {![file exists $config_file]} {
12457         # for backward compatibility use the old config file if it exists
12458         if {[file exists "~/.gitk"]} {
12459             set config_file "~/.gitk"
12460             set config_file_tmp "~/.gitk-tmp"
12461         } elseif {![file exists [file dirname $config_file]]} {
12462             file mkdir [file dirname $config_file]
12463         }
12464     }
12465     source $config_file
12466 }
12467 config_check_tmp_exists 50
12468
12469 set config_variables {
12470     mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
12471     cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
12472     hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
12473     bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
12474     markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
12475     extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
12476     remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
12477     filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
12478     linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
12479     indexcirclecolor circlecolors linkfgcolor circleoutlinecolor diffbgcolors
12480     web_browser
12481 }
12482 foreach var $config_variables {
12483     config_init_trace $var
12484     trace add variable $var write config_variable_change_cb
12485 }
12486
12487 parsefont mainfont $mainfont
12488 eval font create mainfont [fontflags mainfont]
12489 eval font create mainfontbold [fontflags mainfont 1]
12490
12491 parsefont textfont $textfont
12492 eval font create textfont [fontflags textfont]
12493 eval font create textfontbold [fontflags textfont 1]
12494
12495 parsefont uifont $uifont
12496 eval font create uifont [fontflags uifont]
12497
12498 setui $uicolor
12499
12500 setoptions
12501
12502 # check that we can find a .git directory somewhere...
12503 if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12504     show_error {} . [mc "Cannot find a git repository here."]
12505     exit 1
12506 }
12507
12508 set selecthead {}
12509 set selectheadid {}
12510
12511 set revtreeargs {}
12512 set cmdline_files {}
12513 set i 0
12514 set revtreeargscmd {}
12515 foreach arg $argv {
12516     switch -glob -- $arg {
12517         "" { }
12518         "--" {
12519             set cmdline_files [lrange $argv [expr {$i + 1}] end]
12520             break
12521         }
12522         "--select-commit=*" {
12523             set selecthead [string range $arg 16 end]
12524         }
12525         "--argscmd=*" {
12526             set revtreeargscmd [string range $arg 10 end]
12527         }
12528         default {
12529             lappend revtreeargs $arg
12530         }
12531     }
12532     incr i
12533 }
12534
12535 if {$selecthead eq "HEAD"} {
12536     set selecthead {}
12537 }
12538
12539 if {$i >= [llength $argv] && $revtreeargs ne {}} {
12540     # no -- on command line, but some arguments (other than --argscmd)
12541     if {[catch {
12542         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12543         set cmdline_files [split $f "\n"]
12544         set n [llength $cmdline_files]
12545         set revtreeargs [lrange $revtreeargs 0 end-$n]
12546         # Unfortunately git rev-parse doesn't produce an error when
12547         # something is both a revision and a filename.  To be consistent
12548         # with git log and git rev-list, check revtreeargs for filenames.
12549         foreach arg $revtreeargs {
12550             if {[file exists $arg]} {
12551                 show_error {} . [mc "Ambiguous argument '%s': both revision\
12552                                  and filename" $arg]
12553                 exit 1
12554             }
12555         }
12556     } err]} {
12557         # unfortunately we get both stdout and stderr in $err,
12558         # so look for "fatal:".
12559         set i [string first "fatal:" $err]
12560         if {$i > 0} {
12561             set err [string range $err [expr {$i + 6}] end]
12562         }
12563         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12564         exit 1
12565     }
12566 }
12567
12568 set nullid "0000000000000000000000000000000000000000"
12569 set nullid2 "0000000000000000000000000000000000000001"
12570 set nullfile "/dev/null"
12571
12572 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12573 if {![info exists have_ttk]} {
12574     set have_ttk [llength [info commands ::ttk::style]]
12575 }
12576 set use_ttk [expr {$have_ttk && $want_ttk}]
12577 set NS [expr {$use_ttk ? "ttk" : ""}]
12578
12579 if {$use_ttk} {
12580     setttkstyle
12581 }
12582
12583 regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12584
12585 set show_notes {}
12586 if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12587     set show_notes "--show-notes"
12588 }
12589
12590 set appname "gitk"
12591
12592 set runq {}
12593 set history {}
12594 set historyindex 0
12595 set fh_serial 0
12596 set nhl_names {}
12597 set highlight_paths {}
12598 set findpattern {}
12599 set searchdirn -forwards
12600 set boldids {}
12601 set boldnameids {}
12602 set diffelide {0 0}
12603 set markingmatches 0
12604 set linkentercount 0
12605 set need_redisplay 0
12606 set nrows_drawn 0
12607 set firsttabstop 0
12608
12609 set nextviewnum 1
12610 set curview 0
12611 set selectedview 0
12612 set selectedhlview [mc "None"]
12613 set highlight_related [mc "None"]
12614 set highlight_files {}
12615 set viewfiles(0) {}
12616 set viewperm(0) 0
12617 set viewchanged(0) 0
12618 set viewargs(0) {}
12619 set viewargscmd(0) {}
12620
12621 set selectedline {}
12622 set numcommits 0
12623 set loginstance 0
12624 set cmdlineok 0
12625 set stopped 0
12626 set stuffsaved 0
12627 set patchnum 0
12628 set lserial 0
12629 set hasworktree [hasworktree]
12630 set cdup {}
12631 if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12632     set cdup [exec git rev-parse --show-cdup]
12633 }
12634 set worktree [gitworktree]
12635 setcoords
12636 makewindow
12637 catch {
12638     image create photo gitlogo      -width 16 -height 16
12639
12640     image create photo gitlogominus -width  4 -height  2
12641     gitlogominus put #C00000 -to 0 0 4 2
12642     gitlogo copy gitlogominus -to  1 5
12643     gitlogo copy gitlogominus -to  6 5
12644     gitlogo copy gitlogominus -to 11 5
12645     image delete gitlogominus
12646
12647     image create photo gitlogoplus  -width  4 -height  4
12648     gitlogoplus  put #008000 -to 1 0 3 4
12649     gitlogoplus  put #008000 -to 0 1 4 3
12650     gitlogo copy gitlogoplus  -to  1 9
12651     gitlogo copy gitlogoplus  -to  6 9
12652     gitlogo copy gitlogoplus  -to 11 9
12653     image delete gitlogoplus
12654
12655     image create photo gitlogo32    -width 32 -height 32
12656     gitlogo32 copy gitlogo -zoom 2 2
12657
12658     wm iconphoto . -default gitlogo gitlogo32
12659 }
12660 # wait for the window to become visible
12661 tkwait visibility .
12662 set_window_title
12663 update
12664 readrefs
12665
12666 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12667     # create a view for the files/dirs specified on the command line
12668     set curview 1
12669     set selectedview 1
12670     set nextviewnum 2
12671     set viewname(1) [mc "Command line"]
12672     set viewfiles(1) $cmdline_files
12673     set viewargs(1) $revtreeargs
12674     set viewargscmd(1) $revtreeargscmd
12675     set viewperm(1) 0
12676     set viewchanged(1) 0
12677     set vdatemode(1) 0
12678     addviewmenu 1
12679     .bar.view entryconf [mca "&Edit view..."] -state normal
12680     .bar.view entryconf [mca "&Delete view"] -state normal
12681 }
12682
12683 if {[info exists permviews]} {
12684     foreach v $permviews {
12685         set n $nextviewnum
12686         incr nextviewnum
12687         set viewname($n) [lindex $v 0]
12688         set viewfiles($n) [lindex $v 1]
12689         set viewargs($n) [lindex $v 2]
12690         set viewargscmd($n) [lindex $v 3]
12691         set viewperm($n) 1
12692         set viewchanged($n) 0
12693         addviewmenu $n
12694     }
12695 }
12696
12697 if {[tk windowingsystem] eq "win32"} {
12698     focus -force .
12699 }
12700
12701 getcommits {}
12702
12703 # Local variables:
12704 # mode: tcl
12705 # indent-tabs-mode: t
12706 # tab-width: 8
12707 # End: