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             catch {set _gitworktree [exec git config --get core.worktree]}
  38             if {$_gitworktree eq ""} {
  39                 set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]]
  40             }
  41         }
  42     }
  43     return $_gitworktree
  44 }
  45
  46 # A simple scheduler for compute-intensive stuff.
  47 # The aim is to make sure that event handlers for GUI actions can
  48 # run at least every 50-100 ms.  Unfortunately fileevent handlers are
  49 # run before X event handlers, so reading from a fast source can
  50 # make the GUI completely unresponsive.
  51 proc run args {
  52     global isonrunq runq currunq
  53
  54     set script $args
  55     if {[info exists isonrunq($script)]} return
  56     if {$runq eq {} && ![info exists currunq]} {
  57         after idle dorunq
  58     }
  59     lappend runq [list {} $script]
  60     set isonrunq($script) 1
  61 }
  62
  63 proc filerun {fd script} {
  64     fileevent $fd readable [list filereadable $fd $script]
  65 }
  66
  67 proc filereadable {fd script} {
  68     global runq currunq
  69
  70     fileevent $fd readable {}
  71     if {$runq eq {} && ![info exists currunq]} {
  72         after idle dorunq
  73     }
  74     lappend runq [list $fd $script]
  75 }
  76
  77 proc nukefile {fd} {
  78     global runq
  79
  80     for {set i 0} {$i < [llength $runq]} {} {
  81         if {[lindex $runq $i 0] eq $fd} {
  82             set runq [lreplace $runq $i $i]
  83         } else {
  84             incr i
  85         }
  86     }
  87 }
  88
  89 proc dorunq {} {
  90     global isonrunq runq currunq
  91
  92     set tstart [clock clicks -milliseconds]
  93     set t0 $tstart
  94     while {[llength $runq] > 0} {
  95         set fd [lindex $runq 0 0]
  96         set script [lindex $runq 0 1]
  97         set currunq [lindex $runq 0]
  98         set runq [lrange $runq 1 end]
  99         set repeat [eval $script]
 100         unset currunq
 101         set t1 [clock clicks -milliseconds]
 102         set t [expr {$t1 - $t0}]
 103         if {$repeat ne {} && $repeat} {
 104             if {$fd eq {} || $repeat == 2} {
 105                 # script returns 1 if it wants to be readded
 106                 # file readers return 2 if they could do more straight away
 107                 lappend runq [list $fd $script]
 108             } else {
 109                 fileevent $fd readable [list filereadable $fd $script]
 110             }
 111         } elseif {$fd eq {}} {
 112             unset isonrunq($script)
 113         }
 114         set t0 $t1
 115         if {$t1 - $tstart >= 80} break
 116     }
 117     if {$runq ne {}} {
 118         after idle dorunq
 119     }
 120 }
 121
 122 proc reg_instance {fd} {
 123     global commfd leftover loginstance
 124
 125     set i [incr loginstance]
 126     set commfd($i) $fd
 127     set leftover($i) {}
 128     return $i
 129 }
 130
 131 proc unmerged_files {files} {
 132     global nr_unmerged
 133
 134     # find the list of unmerged files
 135     set mlist {}
 136     set nr_unmerged 0
 137     if {[catch {
 138         set fd [open "| git ls-files -u" r]
 139     } err]} {
 140         show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
 141         exit 1
 142     }
 143     while {[gets $fd line] >= 0} {
 144         set i [string first "\t" $line]
 145         if {$i < 0} continue
 146         set fname [string range $line [expr {$i+1}] end]
 147         if {[lsearch -exact $mlist $fname] >= 0} continue
 148         incr nr_unmerged
 149         if {$files eq {} || [path_filter $files $fname]} {
 150             lappend mlist $fname
 151         }
 152     }
 153     catch {close $fd}
 154     return $mlist
 155 }
 156
 157 proc parseviewargs {n arglist} {
 158     global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
 159     global vinlinediff
 160     global worddiff git_version
 161
 162     set vdatemode($n) 0
 163     set vmergeonly($n) 0
 164     set vinlinediff($n) 0
 165     set glflags {}
 166     set diffargs {}
 167     set nextisval 0
 168     set revargs {}
 169     set origargs $arglist
 170     set allknown 1
 171     set filtered 0
 172     set i -1
 173     foreach arg $arglist {
 174         incr i
 175         if {$nextisval} {
 176             lappend glflags $arg
 177             set nextisval 0
 178             continue
 179         }
 180         switch -glob -- $arg {
 181             "-d" -
 182             "--date-order" {
 183                 set vdatemode($n) 1
 184                 # remove from origargs in case we hit an unknown option
 185                 set origargs [lreplace $origargs $i $i]
 186                 incr i -1
 187             }
 188             "-[puabwcrRBMC]" -
 189             "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
 190             "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
 191             "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
 192             "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
 193             "--ignore-space-change" - "-U*" - "--unified=*" {
 194                 # These request or affect diff output, which we don't want.
 195                 # Some could be used to set our defaults for diff display.
 196                 lappend diffargs $arg
 197             }
 198             "--raw" - "--patch-with-raw" - "--patch-with-stat" -
 199             "--name-only" - "--name-status" - "--color" -
 200             "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
 201             "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
 202             "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
 203             "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
 204             "--objects" - "--objects-edge" - "--reverse" {
 205                 # These cause our parsing of git log's output to fail, or else
 206                 # they're options we want to set ourselves, so ignore them.
 207             }
 208             "--color-words*" - "--word-diff=color" {
 209                 # These trigger a word diff in the console interface,
 210                 # so help the user by enabling our own support
 211                 if {[package vcompare $git_version "1.7.2"] >= 0} {
 212                     set worddiff [mc "Color words"]
 213                 }
 214             }
 215             "--word-diff*" {
 216                 if {[package vcompare $git_version "1.7.2"] >= 0} {
 217                     set worddiff [mc "Markup words"]
 218                 }
 219             }
 220             "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
 221             "--check" - "--exit-code" - "--quiet" - "--topo-order" -
 222             "--full-history" - "--dense" - "--sparse" -
 223             "--follow" - "--left-right" - "--encoding=*" {
 224                 # These are harmless, and some are even useful
 225                 lappend glflags $arg
 226             }
 227             "--diff-filter=*" - "--no-merges" - "--unpacked" -
 228             "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
 229             "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
 230             "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
 231             "--remove-empty" - "--first-parent" - "--cherry-pick" -
 232             "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
 233             "--simplify-by-decoration" {
 234                 # These mean that we get a subset of the commits
 235                 set filtered 1
 236                 lappend glflags $arg
 237             }
 238             "-L*" {
 239                 # Line-log with 'stuck' argument (unstuck form is
 240                 # not supported)
 241                 set filtered 1
 242                 set vinlinediff($n) 1
 243                 set allknown 0
 244                 lappend glflags $arg
 245             }
 246             "-n" {
 247                 # This appears to be the only one that has a value as a
 248                 # separate word following it
 249                 set filtered 1
 250                 set nextisval 1
 251                 lappend glflags $arg
 252             }
 253             "--not" - "--all" {
 254                 lappend revargs $arg
 255             }
 256             "--merge" {
 257                 set vmergeonly($n) 1
 258                 # git rev-parse doesn't understand --merge
 259                 lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
 260             }
 261             "--no-replace-objects" {
 262                 set env(GIT_NO_REPLACE_OBJECTS) "1"
 263             }
 264             "-*" {
 265                 # Other flag arguments including -<n>
 266                 if {[string is digit -strict [string range $arg 1 end]]} {
 267                     set filtered 1
 268                 } else {
 269                     # a flag argument that we don't recognize;
 270                     # that means we can't optimize
 271                     set allknown 0
 272                 }
 273                 lappend glflags $arg
 274             }
 275             default {
 276                 # Non-flag arguments specify commits or ranges of commits
 277                 if {[string match "*...*" $arg]} {
 278                     lappend revargs --gitk-symmetric-diff-marker
 279                 }
 280                 lappend revargs $arg
 281             }
 282         }
 283     }
 284     set vdflags($n) $diffargs
 285     set vflags($n) $glflags
 286     set vrevs($n) $revargs
 287     set vfiltered($n) $filtered
 288     set vorigargs($n) $origargs
 289     return $allknown
 290 }
 291
 292 proc parseviewrevs {view revs} {
 293     global vposids vnegids
 294
 295     if {$revs eq {}} {
 296         set revs HEAD
 297     } elseif {[lsearch -exact $revs --all] >= 0} {
 298         lappend revs HEAD
 299     }
 300     if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
 301         # we get stdout followed by stderr in $err
 302         # for an unknown rev, git rev-parse echoes it and then errors out
 303         set errlines [split $err "\n"]
 304         set badrev {}
 305         for {set l 0} {$l < [llength $errlines]} {incr l} {
 306             set line [lindex $errlines $l]
 307             if {!([string length $line] == 40 && [string is xdigit $line])} {
 308                 if {[string match "fatal:*" $line]} {
 309                     if {[string match "fatal: ambiguous argument*" $line]
 310                         && $badrev ne {}} {
 311                         if {[llength $badrev] == 1} {
 312                             set err "unknown revision $badrev"
 313                         } else {
 314                             set err "unknown revisions: [join $badrev ", "]"
 315                         }
 316                     } else {
 317                         set err [join [lrange $errlines $l end] "\n"]
 318                     }
 319                     break
 320                 }
 321                 lappend badrev $line
 322             }
 323         }
 324         error_popup "[mc "Error parsing revisions:"] $err"
 325         return {}
 326     }
 327     set ret {}
 328     set pos {}
 329     set neg {}
 330     set sdm 0
 331     foreach id [split $ids "\n"] {
 332         if {$id eq "--gitk-symmetric-diff-marker"} {
 333             set sdm 4
 334         } elseif {[string match "^*" $id]} {
 335             if {$sdm != 1} {
 336                 lappend ret $id
 337                 if {$sdm == 3} {
 338                     set sdm 0
 339                 }
 340             }
 341             lappend neg [string range $id 1 end]
 342         } else {
 343             if {$sdm != 2} {
 344                 lappend ret $id
 345             } else {
 346                 lset ret end $id...[lindex $ret end]
 347             }
 348             lappend pos $id
 349         }
 350         incr sdm -1
 351     }
 352     set vposids($view) $pos
 353     set vnegids($view) $neg
 354     return $ret
 355 }
 356
 357 # Start off a git log process and arrange to read its output
 358 proc start_rev_list {view} {
 359     global startmsecs commitidx viewcomplete curview
 360     global tclencoding
 361     global viewargs viewargscmd viewfiles vfilelimit
 362     global showlocalchanges
 363     global viewactive viewinstances vmergeonly
 364     global mainheadid viewmainheadid viewmainheadid_orig
 365     global vcanopt vflags vrevs vorigargs
 366     global show_notes
 367
 368     set startmsecs [clock clicks -milliseconds]
 369     set commitidx($view) 0
 370     # these are set this way for the error exits
 371     set viewcomplete($view) 1
 372     set viewactive($view) 0
 373     varcinit $view
 374
 375     set args $viewargs($view)
 376     if {$viewargscmd($view) ne {}} {
 377         if {[catch {
 378             set str [exec sh -c $viewargscmd($view)]
 379         } err]} {
 380             error_popup "[mc "Error executing --argscmd command:"] $err"
 381             return 0
 382         }
 383         set args [concat $args [split $str "\n"]]
 384     }
 385     set vcanopt($view) [parseviewargs $view $args]
 386
 387     set files $viewfiles($view)
 388     if {$vmergeonly($view)} {
 389         set files [unmerged_files $files]
 390         if {$files eq {}} {
 391             global nr_unmerged
 392             if {$nr_unmerged == 0} {
 393                 error_popup [mc "No files selected: --merge specified but\
 394                              no files are unmerged."]
 395             } else {
 396                 error_popup [mc "No files selected: --merge specified but\
 397                              no unmerged files are within file limit."]
 398             }
 399             return 0
 400         }
 401     }
 402     set vfilelimit($view) $files
 403
 404     if {$vcanopt($view)} {
 405         set revs [parseviewrevs $view $vrevs($view)]
 406         if {$revs eq {}} {
 407             return 0
 408         }
 409         set args [concat $vflags($view) $revs]
 410     } else {
 411         set args $vorigargs($view)
 412     }
 413
 414     if {[catch {
 415         set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 416                         --parents --boundary $args "--" $files] r]
 417     } err]} {
 418         error_popup "[mc "Error executing git log:"] $err"
 419         return 0
 420     }
 421     set i [reg_instance $fd]
 422     set viewinstances($view) [list $i]
 423     set viewmainheadid($view) $mainheadid
 424     set viewmainheadid_orig($view) $mainheadid
 425     if {$files ne {} && $mainheadid ne {}} {
 426         get_viewmainhead $view
 427     }
 428     if {$showlocalchanges && $viewmainheadid($view) ne {}} {
 429         interestedin $viewmainheadid($view) dodiffindex
 430     }
 431     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 432     if {$tclencoding != {}} {
 433         fconfigure $fd -encoding $tclencoding
 434     }
 435     filerun $fd [list getcommitlines $fd $i $view 0]
 436     nowbusy $view [mc "Reading"]
 437     set viewcomplete($view) 0
 438     set viewactive($view) 1
 439     return 1
 440 }
 441
 442 proc stop_instance {inst} {
 443     global commfd leftover
 444
 445     set fd $commfd($inst)
 446     catch {
 447         set pid [pid $fd]
 448
 449         if {$::tcl_platform(platform) eq {windows}} {
 450             exec taskkill /pid $pid
 451         } else {
 452             exec kill $pid
 453         }
 454     }
 455     catch {close $fd}
 456     nukefile $fd
 457     unset commfd($inst)
 458     unset leftover($inst)
 459 }
 460
 461 proc stop_backends {} {
 462     global commfd
 463
 464     foreach inst [array names commfd] {
 465         stop_instance $inst
 466     }
 467 }
 468
 469 proc stop_rev_list {view} {
 470     global viewinstances
 471
 472     foreach inst $viewinstances($view) {
 473         stop_instance $inst
 474     }
 475     set viewinstances($view) {}
 476 }
 477
 478 proc reset_pending_select {selid} {
 479     global pending_select mainheadid selectheadid
 480
 481     if {$selid ne {}} {
 482         set pending_select $selid
 483     } elseif {$selectheadid ne {}} {
 484         set pending_select $selectheadid
 485     } else {
 486         set pending_select $mainheadid
 487     }
 488 }
 489
 490 proc getcommits {selid} {
 491     global canv curview need_redisplay viewactive
 492
 493     initlayout
 494     if {[start_rev_list $curview]} {
 495         reset_pending_select $selid
 496         show_status [mc "Reading commits..."]
 497         set need_redisplay 1
 498     } else {
 499         show_status [mc "No commits selected"]
 500     }
 501 }
 502
 503 proc updatecommits {} {
 504     global curview vcanopt vorigargs vfilelimit viewinstances
 505     global viewactive viewcomplete tclencoding
 506     global startmsecs showneartags showlocalchanges
 507     global mainheadid viewmainheadid viewmainheadid_orig pending_select
 508     global hasworktree
 509     global varcid vposids vnegids vflags vrevs
 510     global show_notes
 511
 512     set hasworktree [hasworktree]
 513     rereadrefs
 514     set view $curview
 515     if {$mainheadid ne $viewmainheadid_orig($view)} {
 516         if {$showlocalchanges} {
 517             dohidelocalchanges
 518         }
 519         set viewmainheadid($view) $mainheadid
 520         set viewmainheadid_orig($view) $mainheadid
 521         if {$vfilelimit($view) ne {}} {
 522             get_viewmainhead $view
 523         }
 524     }
 525     if {$showlocalchanges} {
 526         doshowlocalchanges
 527     }
 528     if {$vcanopt($view)} {
 529         set oldpos $vposids($view)
 530         set oldneg $vnegids($view)
 531         set revs [parseviewrevs $view $vrevs($view)]
 532         if {$revs eq {}} {
 533             return
 534         }
 535         # note: getting the delta when negative refs change is hard,
 536         # and could require multiple git log invocations, so in that
 537         # case we ask git log for all the commits (not just the delta)
 538         if {$oldneg eq $vnegids($view)} {
 539             set newrevs {}
 540             set npos 0
 541             # take out positive refs that we asked for before or
 542             # that we have already seen
 543             foreach rev $revs {
 544                 if {[string length $rev] == 40} {
 545                     if {[lsearch -exact $oldpos $rev] < 0
 546                         && ![info exists varcid($view,$rev)]} {
 547                         lappend newrevs $rev
 548                         incr npos
 549                     }
 550                 } else {
 551                     lappend $newrevs $rev
 552                 }
 553             }
 554             if {$npos == 0} return
 555             set revs $newrevs
 556             set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
 557         }
 558         set args [concat $vflags($view) $revs --not $oldpos]
 559     } else {
 560         set args $vorigargs($view)
 561     }
 562     if {[catch {
 563         set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 564                         --parents --boundary $args "--" $vfilelimit($view)] r]
 565     } err]} {
 566         error_popup "[mc "Error executing git log:"] $err"
 567         return
 568     }
 569     if {$viewactive($view) == 0} {
 570         set startmsecs [clock clicks -milliseconds]
 571     }
 572     set i [reg_instance $fd]
 573     lappend viewinstances($view) $i
 574     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 575     if {$tclencoding != {}} {
 576         fconfigure $fd -encoding $tclencoding
 577     }
 578     filerun $fd [list getcommitlines $fd $i $view 1]
 579     incr viewactive($view)
 580     set viewcomplete($view) 0
 581     reset_pending_select {}
 582     nowbusy $view [mc "Reading"]
 583     if {$showneartags} {
 584         getallcommits
 585     }
 586 }
 587
 588 proc reloadcommits {} {
 589     global curview viewcomplete selectedline currentid thickerline
 590     global showneartags treediffs commitinterest cached_commitrow
 591     global targetid commitinfo
 592
 593     set selid {}
 594     if {$selectedline ne {}} {
 595         set selid $currentid
 596     }
 597
 598     if {!$viewcomplete($curview)} {
 599         stop_rev_list $curview
 600     }
 601     resetvarcs $curview
 602     set selectedline {}
 603     unset -nocomplain currentid
 604     unset -nocomplain thickerline
 605     unset -nocomplain treediffs
 606     readrefs
 607     changedrefs
 608     if {$showneartags} {
 609         getallcommits
 610     }
 611     clear_display
 612     unset -nocomplain commitinfo
 613     unset -nocomplain commitinterest
 614     unset -nocomplain cached_commitrow
 615     unset -nocomplain targetid
 616     setcanvscroll
 617     getcommits $selid
 618     return 0
 619 }
 620
 621 # This makes a string representation of a positive integer which
 622 # sorts as a string in numerical order
 623 proc strrep {n} {
 624     if {$n < 16} {
 625         return [format "%x" $n]
 626     } elseif {$n < 256} {
 627         return [format "x%.2x" $n]
 628     } elseif {$n < 65536} {
 629         return [format "y%.4x" $n]
 630     }
 631     return [format "z%.8x" $n]
 632 }
 633
 634 # Procedures used in reordering commits from git log (without
 635 # --topo-order) into the order for display.
 636
 637 proc varcinit {view} {
 638     global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
 639     global vtokmod varcmod vrowmod varcix vlastins
 640
 641     set varcstart($view) {{}}
 642     set vupptr($view) {0}
 643     set vdownptr($view) {0}
 644     set vleftptr($view) {0}
 645     set vbackptr($view) {0}
 646     set varctok($view) {{}}
 647     set varcrow($view) {{}}
 648     set vtokmod($view) {}
 649     set varcmod($view) 0
 650     set vrowmod($view) 0
 651     set varcix($view) {{}}
 652     set vlastins($view) {0}
 653 }
 654
 655 proc resetvarcs {view} {
 656     global varcid varccommits parents children vseedcount ordertok
 657     global vshortids
 658
 659     foreach vid [array names varcid $view,*] {
 660         unset varcid($vid)
 661         unset children($vid)
 662         unset parents($vid)
 663     }
 664     foreach vid [array names vshortids $view,*] {
 665         unset vshortids($vid)
 666     }
 667     # some commits might have children but haven't been seen yet
 668     foreach vid [array names children $view,*] {
 669         unset children($vid)
 670     }
 671     foreach va [array names varccommits $view,*] {
 672         unset varccommits($va)
 673     }
 674     foreach vd [array names vseedcount $view,*] {
 675         unset vseedcount($vd)
 676     }
 677     unset -nocomplain ordertok
 678 }
 679
 680 # returns a list of the commits with no children
 681 proc seeds {v} {
 682     global vdownptr vleftptr varcstart
 683
 684     set ret {}
 685     set a [lindex $vdownptr($v) 0]
 686     while {$a != 0} {
 687         lappend ret [lindex $varcstart($v) $a]
 688         set a [lindex $vleftptr($v) $a]
 689     }
 690     return $ret
 691 }
 692
 693 proc newvarc {view id} {
 694     global varcid varctok parents children vdatemode
 695     global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
 696     global commitdata commitinfo vseedcount varccommits vlastins
 697
 698     set a [llength $varctok($view)]
 699     set vid $view,$id
 700     if {[llength $children($vid)] == 0 || $vdatemode($view)} {
 701         if {![info exists commitinfo($id)]} {
 702             parsecommit $id $commitdata($id) 1
 703         }
 704         set cdate [lindex [lindex $commitinfo($id) 4] 0]
 705         if {![string is integer -strict $cdate]} {
 706             set cdate 0
 707         }
 708         if {![info exists vseedcount($view,$cdate)]} {
 709             set vseedcount($view,$cdate) -1
 710         }
 711         set c [incr vseedcount($view,$cdate)]
 712         set cdate [expr {$cdate ^ 0xffffffff}]
 713         set tok "s[strrep $cdate][strrep $c]"
 714     } else {
 715         set tok {}
 716     }
 717     set ka 0
 718     if {[llength $children($vid)] > 0} {
 719         set kid [lindex $children($vid) end]
 720         set k $varcid($view,$kid)
 721         if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
 722             set ki $kid
 723             set ka $k
 724             set tok [lindex $varctok($view) $k]
 725         }
 726     }
 727     if {$ka != 0} {
 728         set i [lsearch -exact $parents($view,$ki) $id]
 729         set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 730         append tok [strrep $j]
 731     }
 732     set c [lindex $vlastins($view) $ka]
 733     if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
 734         set c $ka
 735         set b [lindex $vdownptr($view) $ka]
 736     } else {
 737         set b [lindex $vleftptr($view) $c]
 738     }
 739     while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 740         set c $b
 741         set b [lindex $vleftptr($view) $c]
 742     }
 743     if {$c == $ka} {
 744         lset vdownptr($view) $ka $a
 745         lappend vbackptr($view) 0
 746     } else {
 747         lset vleftptr($view) $c $a
 748         lappend vbackptr($view) $c
 749     }
 750     lset vlastins($view) $ka $a
 751     lappend vupptr($view) $ka
 752     lappend vleftptr($view) $b
 753     if {$b != 0} {
 754         lset vbackptr($view) $b $a
 755     }
 756     lappend varctok($view) $tok
 757     lappend varcstart($view) $id
 758     lappend vdownptr($view) 0
 759     lappend varcrow($view) {}
 760     lappend varcix($view) {}
 761     set varccommits($view,$a) {}
 762     lappend vlastins($view) 0
 763     return $a
 764 }
 765
 766 proc splitvarc {p v} {
 767     global varcid varcstart varccommits varctok vtokmod
 768     global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
 769
 770     set oa $varcid($v,$p)
 771     set otok [lindex $varctok($v) $oa]
 772     set ac $varccommits($v,$oa)
 773     set i [lsearch -exact $varccommits($v,$oa) $p]
 774     if {$i <= 0} return
 775     set na [llength $varctok($v)]
 776     # "%" sorts before "0"...
 777     set tok "$otok%[strrep $i]"
 778     lappend varctok($v) $tok
 779     lappend varcrow($v) {}
 780     lappend varcix($v) {}
 781     set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 782     set varccommits($v,$na) [lrange $ac $i end]
 783     lappend varcstart($v) $p
 784     foreach id $varccommits($v,$na) {
 785         set varcid($v,$id) $na
 786     }
 787     lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 788     lappend vlastins($v) [lindex $vlastins($v) $oa]
 789     lset vdownptr($v) $oa $na
 790     lset vlastins($v) $oa 0
 791     lappend vupptr($v) $oa
 792     lappend vleftptr($v) 0
 793     lappend vbackptr($v) 0
 794     for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 795         lset vupptr($v) $b $na
 796     }
 797     if {[string compare $otok $vtokmod($v)] <= 0} {
 798         modify_arc $v $oa
 799     }
 800 }
 801
 802 proc renumbervarc {a v} {
 803     global parents children varctok varcstart varccommits
 804     global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
 805
 806     set t1 [clock clicks -milliseconds]
 807     set todo {}
 808     set isrelated($a) 1
 809     set kidchanged($a) 1
 810     set ntot 0
 811     while {$a != 0} {
 812         if {[info exists isrelated($a)]} {
 813             lappend todo $a
 814             set id [lindex $varccommits($v,$a) end]
 815             foreach p $parents($v,$id) {
 816                 if {[info exists varcid($v,$p)]} {
 817                     set isrelated($varcid($v,$p)) 1
 818                 }
 819             }
 820         }
 821         incr ntot
 822         set b [lindex $vdownptr($v) $a]
 823         if {$b == 0} {
 824             while {$a != 0} {
 825                 set b [lindex $vleftptr($v) $a]
 826                 if {$b != 0} break
 827                 set a [lindex $vupptr($v) $a]
 828             }
 829         }
 830         set a $b
 831     }
 832     foreach a $todo {
 833         if {![info exists kidchanged($a)]} continue
 834         set id [lindex $varcstart($v) $a]
 835         if {[llength $children($v,$id)] > 1} {
 836             set children($v,$id) [lsort -command [list vtokcmp $v] \
 837                                       $children($v,$id)]
 838         }
 839         set oldtok [lindex $varctok($v) $a]
 840         if {!$vdatemode($v)} {
 841             set tok {}
 842         } else {
 843             set tok $oldtok
 844         }
 845         set ka 0
 846         set kid [last_real_child $v,$id]
 847         if {$kid ne {}} {
 848             set k $varcid($v,$kid)
 849             if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
 850                 set ki $kid
 851                 set ka $k
 852                 set tok [lindex $varctok($v) $k]
 853             }
 854         }
 855         if {$ka != 0} {
 856             set i [lsearch -exact $parents($v,$ki) $id]
 857             set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 858             append tok [strrep $j]
 859         }
 860         if {$tok eq $oldtok} {
 861             continue
 862         }
 863         set id [lindex $varccommits($v,$a) end]
 864         foreach p $parents($v,$id) {
 865             if {[info exists varcid($v,$p)]} {
 866                 set kidchanged($varcid($v,$p)) 1
 867             } else {
 868                 set sortkids($p) 1
 869             }
 870         }
 871         lset varctok($v) $a $tok
 872         set b [lindex $vupptr($v) $a]
 873         if {$b != $ka} {
 874             if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
 875                 modify_arc $v $ka
 876             }
 877             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 878                 modify_arc $v $b
 879             }
 880             set c [lindex $vbackptr($v) $a]
 881             set d [lindex $vleftptr($v) $a]
 882             if {$c == 0} {
 883                 lset vdownptr($v) $b $d
 884             } else {
 885                 lset vleftptr($v) $c $d
 886             }
 887             if {$d != 0} {
 888                 lset vbackptr($v) $d $c
 889             }
 890             if {[lindex $vlastins($v) $b] == $a} {
 891                 lset vlastins($v) $b $c
 892             }
 893             lset vupptr($v) $a $ka
 894             set c [lindex $vlastins($v) $ka]
 895             if {$c == 0 || \
 896                     [string compare $tok [lindex $varctok($v) $c]] < 0} {
 897                 set c $ka
 898                 set b [lindex $vdownptr($v) $ka]
 899             } else {
 900                 set b [lindex $vleftptr($v) $c]
 901             }
 902             while {$b != 0 && \
 903                       [string compare $tok [lindex $varctok($v) $b]] >= 0} {
 904                 set c $b
 905                 set b [lindex $vleftptr($v) $c]
 906             }
 907             if {$c == $ka} {
 908                 lset vdownptr($v) $ka $a
 909                 lset vbackptr($v) $a 0
 910             } else {
 911                 lset vleftptr($v) $c $a
 912                 lset vbackptr($v) $a $c
 913             }
 914             lset vleftptr($v) $a $b
 915             if {$b != 0} {
 916                 lset vbackptr($v) $b $a
 917             }
 918             lset vlastins($v) $ka $a
 919         }
 920     }
 921     foreach id [array names sortkids] {
 922         if {[llength $children($v,$id)] > 1} {
 923             set children($v,$id) [lsort -command [list vtokcmp $v] \
 924                                       $children($v,$id)]
 925         }
 926     }
 927     set t2 [clock clicks -milliseconds]
 928     #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 929 }
 930
 931 # Fix up the graph after we have found out that in view $v,
 932 # $p (a commit that we have already seen) is actually the parent
 933 # of the last commit in arc $a.
 934 proc fix_reversal {p a v} {
 935     global varcid varcstart varctok vupptr
 936
 937     set pa $varcid($v,$p)
 938     if {$p ne [lindex $varcstart($v) $pa]} {
 939         splitvarc $p $v
 940         set pa $varcid($v,$p)
 941     }
 942     # seeds always need to be renumbered
 943     if {[lindex $vupptr($v) $pa] == 0 ||
 944         [string compare [lindex $varctok($v) $a] \
 945              [lindex $varctok($v) $pa]] > 0} {
 946         renumbervarc $pa $v
 947     }
 948 }
 949
 950 proc insertrow {id p v} {
 951     global cmitlisted children parents varcid varctok vtokmod
 952     global varccommits ordertok commitidx numcommits curview
 953     global targetid targetrow vshortids
 954
 955     readcommit $id
 956     set vid $v,$id
 957     set cmitlisted($vid) 1
 958     set children($vid) {}
 959     set parents($vid) [list $p]
 960     set a [newvarc $v $id]
 961     set varcid($vid) $a
 962     lappend vshortids($v,[string range $id 0 3]) $id
 963     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
 964         modify_arc $v $a
 965     }
 966     lappend varccommits($v,$a) $id
 967     set vp $v,$p
 968     if {[llength [lappend children($vp) $id]] > 1} {
 969         set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
 970         unset -nocomplain ordertok
 971     }
 972     fix_reversal $p $a $v
 973     incr commitidx($v)
 974     if {$v == $curview} {
 975         set numcommits $commitidx($v)
 976         setcanvscroll
 977         if {[info exists targetid]} {
 978             if {![comes_before $targetid $p]} {
 979                 incr targetrow
 980             }
 981         }
 982     }
 983 }
 984
 985 proc insertfakerow {id p} {
 986     global varcid varccommits parents children cmitlisted
 987     global commitidx varctok vtokmod targetid targetrow curview numcommits
 988
 989     set v $curview
 990     set a $varcid($v,$p)
 991     set i [lsearch -exact $varccommits($v,$a) $p]
 992     if {$i < 0} {
 993         puts "oops: insertfakerow can't find [shortids $p] on arc $a"
 994         return
 995     }
 996     set children($v,$id) {}
 997     set parents($v,$id) [list $p]
 998     set varcid($v,$id) $a
 999     lappend children($v,$p) $id
1000     set cmitlisted($v,$id) 1
1001     set numcommits [incr commitidx($v)]
1002     # note we deliberately don't update varcstart($v) even if $i == 0
1003     set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
1004     modify_arc $v $a $i
1005     if {[info exists targetid]} {
1006         if {![comes_before $targetid $p]} {
1007             incr targetrow
1008         }
1009     }
1010     setcanvscroll
1011     drawvisible
1012 }
1013
1014 proc removefakerow {id} {
1015     global varcid varccommits parents children commitidx
1016     global varctok vtokmod cmitlisted currentid selectedline
1017     global targetid curview numcommits
1018
1019     set v $curview
1020     if {[llength $parents($v,$id)] != 1} {
1021         puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1022         return
1023     }
1024     set p [lindex $parents($v,$id) 0]
1025     set a $varcid($v,$id)
1026     set i [lsearch -exact $varccommits($v,$a) $id]
1027     if {$i < 0} {
1028         puts "oops: removefakerow can't find [shortids $id] on arc $a"
1029         return
1030     }
1031     unset varcid($v,$id)
1032     set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1033     unset parents($v,$id)
1034     unset children($v,$id)
1035     unset cmitlisted($v,$id)
1036     set numcommits [incr commitidx($v) -1]
1037     set j [lsearch -exact $children($v,$p) $id]
1038     if {$j >= 0} {
1039         set children($v,$p) [lreplace $children($v,$p) $j $j]
1040     }
1041     modify_arc $v $a $i
1042     if {[info exist currentid] && $id eq $currentid} {
1043         unset currentid
1044         set selectedline {}
1045     }
1046     if {[info exists targetid] && $targetid eq $id} {
1047         set targetid $p
1048     }
1049     setcanvscroll
1050     drawvisible
1051 }
1052
1053 proc real_children {vp} {
1054     global children nullid nullid2
1055
1056     set kids {}
1057     foreach id $children($vp) {
1058         if {$id ne $nullid && $id ne $nullid2} {
1059             lappend kids $id
1060         }
1061     }
1062     return $kids
1063 }
1064
1065 proc first_real_child {vp} {
1066     global children nullid nullid2
1067
1068     foreach id $children($vp) {
1069         if {$id ne $nullid && $id ne $nullid2} {
1070             return $id
1071         }
1072     }
1073     return {}
1074 }
1075
1076 proc last_real_child {vp} {
1077     global children nullid nullid2
1078
1079     set kids $children($vp)
1080     for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1081         set id [lindex $kids $i]
1082         if {$id ne $nullid && $id ne $nullid2} {
1083             return $id
1084         }
1085     }
1086     return {}
1087 }
1088
1089 proc vtokcmp {v a b} {
1090     global varctok varcid
1091
1092     return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1093                 [lindex $varctok($v) $varcid($v,$b)]]
1094 }
1095
1096 # This assumes that if lim is not given, the caller has checked that
1097 # arc a's token is less than $vtokmod($v)
1098 proc modify_arc {v a {lim {}}} {
1099     global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1100
1101     if {$lim ne {}} {
1102         set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1103         if {$c > 0} return
1104         if {$c == 0} {
1105             set r [lindex $varcrow($v) $a]
1106             if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1107         }
1108     }
1109     set vtokmod($v) [lindex $varctok($v) $a]
1110     set varcmod($v) $a
1111     if {$v == $curview} {
1112         while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1113             set a [lindex $vupptr($v) $a]
1114             set lim {}
1115         }
1116         set r 0
1117         if {$a != 0} {
1118             if {$lim eq {}} {
1119                 set lim [llength $varccommits($v,$a)]
1120             }
1121             set r [expr {[lindex $varcrow($v) $a] + $lim}]
1122         }
1123         set vrowmod($v) $r
1124         undolayout $r
1125     }
1126 }
1127
1128 proc update_arcrows {v} {
1129     global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1130     global varcid vrownum varcorder varcix varccommits
1131     global vupptr vdownptr vleftptr varctok
1132     global displayorder parentlist curview cached_commitrow
1133
1134     if {$vrowmod($v) == $commitidx($v)} return
1135     if {$v == $curview} {
1136         if {[llength $displayorder] > $vrowmod($v)} {
1137             set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1138             set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1139         }
1140         unset -nocomplain cached_commitrow
1141     }
1142     set narctot [expr {[llength $varctok($v)] - 1}]
1143     set a $varcmod($v)
1144     while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1145         # go up the tree until we find something that has a row number,
1146         # or we get to a seed
1147         set a [lindex $vupptr($v) $a]
1148     }
1149     if {$a == 0} {
1150         set a [lindex $vdownptr($v) 0]
1151         if {$a == 0} return
1152         set vrownum($v) {0}
1153         set varcorder($v) [list $a]
1154         lset varcix($v) $a 0
1155         lset varcrow($v) $a 0
1156         set arcn 0
1157         set row 0
1158     } else {
1159         set arcn [lindex $varcix($v) $a]
1160         if {[llength $vrownum($v)] > $arcn + 1} {
1161             set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1162             set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1163         }
1164         set row [lindex $varcrow($v) $a]
1165     }
1166     while {1} {
1167         set p $a
1168         incr row [llength $varccommits($v,$a)]
1169         # go down if possible
1170         set b [lindex $vdownptr($v) $a]
1171         if {$b == 0} {
1172             # if not, go left, or go up until we can go left
1173             while {$a != 0} {
1174                 set b [lindex $vleftptr($v) $a]
1175                 if {$b != 0} break
1176                 set a [lindex $vupptr($v) $a]
1177             }
1178             if {$a == 0} break
1179         }
1180         set a $b
1181         incr arcn
1182         lappend vrownum($v) $row
1183         lappend varcorder($v) $a
1184         lset varcix($v) $a $arcn
1185         lset varcrow($v) $a $row
1186     }
1187     set vtokmod($v) [lindex $varctok($v) $p]
1188     set varcmod($v) $p
1189     set vrowmod($v) $row
1190     if {[info exists currentid]} {
1191         set selectedline [rowofcommit $currentid]
1192     }
1193 }
1194
1195 # Test whether view $v contains commit $id
1196 proc commitinview {id v} {
1197     global varcid
1198
1199     return [info exists varcid($v,$id)]
1200 }
1201
1202 # Return the row number for commit $id in the current view
1203 proc rowofcommit {id} {
1204     global varcid varccommits varcrow curview cached_commitrow
1205     global varctok vtokmod
1206
1207     set v $curview
1208     if {![info exists varcid($v,$id)]} {
1209         puts "oops rowofcommit no arc for [shortids $id]"
1210         return {}
1211     }
1212     set a $varcid($v,$id)
1213     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1214         update_arcrows $v
1215     }
1216     if {[info exists cached_commitrow($id)]} {
1217         return $cached_commitrow($id)
1218     }
1219     set i [lsearch -exact $varccommits($v,$a) $id]
1220     if {$i < 0} {
1221         puts "oops didn't find commit [shortids $id] in arc $a"
1222         return {}
1223     }
1224     incr i [lindex $varcrow($v) $a]
1225     set cached_commitrow($id) $i
1226     return $i
1227 }
1228
1229 # Returns 1 if a is on an earlier row than b, otherwise 0
1230 proc comes_before {a b} {
1231     global varcid varctok curview
1232
1233     set v $curview
1234     if {$a eq $b || ![info exists varcid($v,$a)] || \
1235             ![info exists varcid($v,$b)]} {
1236         return 0
1237     }
1238     if {$varcid($v,$a) != $varcid($v,$b)} {
1239         return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1240                            [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1241     }
1242     return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1243 }
1244
1245 proc bsearch {l elt} {
1246     if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1247         return 0
1248     }
1249     set lo 0
1250     set hi [llength $l]
1251     while {$hi - $lo > 1} {
1252         set mid [expr {int(($lo + $hi) / 2)}]
1253         set t [lindex $l $mid]
1254         if {$elt < $t} {
1255             set hi $mid
1256         } elseif {$elt > $t} {
1257             set lo $mid
1258         } else {
1259             return $mid
1260         }
1261     }
1262     return $lo
1263 }
1264
1265 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
1266 proc make_disporder {start end} {
1267     global vrownum curview commitidx displayorder parentlist
1268     global varccommits varcorder parents vrowmod varcrow
1269     global d_valid_start d_valid_end
1270
1271     if {$end > $vrowmod($curview)} {
1272         update_arcrows $curview
1273     }
1274     set ai [bsearch $vrownum($curview) $start]
1275     set start [lindex $vrownum($curview) $ai]
1276     set narc [llength $vrownum($curview)]
1277     for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1278         set a [lindex $varcorder($curview) $ai]
1279         set l [llength $displayorder]
1280         set al [llength $varccommits($curview,$a)]
1281         if {$l < $r + $al} {
1282             if {$l < $r} {
1283                 set pad [ntimes [expr {$r - $l}] {}]
1284                 set displayorder [concat $displayorder $pad]
1285                 set parentlist [concat $parentlist $pad]
1286             } elseif {$l > $r} {
1287                 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1288                 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1289             }
1290             foreach id $varccommits($curview,$a) {
1291                 lappend displayorder $id
1292                 lappend parentlist $parents($curview,$id)
1293             }
1294         } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1295             set i $r
1296             foreach id $varccommits($curview,$a) {
1297                 lset displayorder $i $id
1298                 lset parentlist $i $parents($curview,$id)
1299                 incr i
1300             }
1301         }
1302         incr r $al
1303     }
1304 }
1305
1306 proc commitonrow {row} {
1307     global displayorder
1308
1309     set id [lindex $displayorder $row]
1310     if {$id eq {}} {
1311         make_disporder $row [expr {$row + 1}]
1312         set id [lindex $displayorder $row]
1313     }
1314     return $id
1315 }
1316
1317 proc closevarcs {v} {
1318     global varctok varccommits varcid parents children
1319     global cmitlisted commitidx vtokmod curview numcommits
1320
1321     set missing_parents 0
1322     set scripts {}
1323     set narcs [llength $varctok($v)]
1324     for {set a 1} {$a < $narcs} {incr a} {
1325         set id [lindex $varccommits($v,$a) end]
1326         foreach p $parents($v,$id) {
1327             if {[info exists varcid($v,$p)]} continue
1328             # add p as a new commit
1329             incr missing_parents
1330             set cmitlisted($v,$p) 0
1331             set parents($v,$p) {}
1332             if {[llength $children($v,$p)] == 1 &&
1333                 [llength $parents($v,$id)] == 1} {
1334                 set b $a
1335             } else {
1336                 set b [newvarc $v $p]
1337             }
1338             set varcid($v,$p) $b
1339             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1340                 modify_arc $v $b
1341             }
1342             lappend varccommits($v,$b) $p
1343             incr commitidx($v)
1344             if {$v == $curview} {
1345                 set numcommits $commitidx($v)
1346             }
1347             set scripts [check_interest $p $scripts]
1348         }
1349     }
1350     if {$missing_parents > 0} {
1351         foreach s $scripts {
1352             eval $s
1353         }
1354     }
1355 }
1356
1357 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1358 # Assumes we already have an arc for $rwid.
1359 proc rewrite_commit {v id rwid} {
1360     global children parents varcid varctok vtokmod varccommits
1361
1362     foreach ch $children($v,$id) {
1363         # make $rwid be $ch's parent in place of $id
1364         set i [lsearch -exact $parents($v,$ch) $id]
1365         if {$i < 0} {
1366             puts "oops rewrite_commit didn't find $id in parent list for $ch"
1367         }
1368         set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1369         # add $ch to $rwid's children and sort the list if necessary
1370         if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1371             set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1372                                         $children($v,$rwid)]
1373         }
1374         # fix the graph after joining $id to $rwid
1375         set a $varcid($v,$ch)
1376         fix_reversal $rwid $a $v
1377         # parentlist is wrong for the last element of arc $a
1378         # even if displayorder is right, hence the 3rd arg here
1379         modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1380     }
1381 }
1382
1383 # Mechanism for registering a command to be executed when we come
1384 # across a particular commit.  To handle the case when only the
1385 # prefix of the commit is known, the commitinterest array is now
1386 # indexed by the first 4 characters of the ID.  Each element is a
1387 # list of id, cmd pairs.
1388 proc interestedin {id cmd} {
1389     global commitinterest
1390
1391     lappend commitinterest([string range $id 0 3]) $id $cmd
1392 }
1393
1394 proc check_interest {id scripts} {
1395     global commitinterest
1396
1397     set prefix [string range $id 0 3]
1398     if {[info exists commitinterest($prefix)]} {
1399         set newlist {}
1400         foreach {i script} $commitinterest($prefix) {
1401             if {[string match "$i*" $id]} {
1402                 lappend scripts [string map [list "%I" $id "%P" $i] $script]
1403             } else {
1404                 lappend newlist $i $script
1405             }
1406         }
1407         if {$newlist ne {}} {
1408             set commitinterest($prefix) $newlist
1409         } else {
1410             unset commitinterest($prefix)
1411         }
1412     }
1413     return $scripts
1414 }
1415
1416 proc getcommitlines {fd inst view updating}  {
1417     global cmitlisted leftover
1418     global commitidx commitdata vdatemode
1419     global parents children curview hlview
1420     global idpending ordertok
1421     global varccommits varcid varctok vtokmod vfilelimit vshortids
1422
1423     set stuff [read $fd 500000]
1424     # git log doesn't terminate the last commit with a null...
1425     if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1426         set stuff "\0"
1427     }
1428     if {$stuff == {}} {
1429         if {![eof $fd]} {
1430             return 1
1431         }
1432         global commfd viewcomplete viewactive viewname
1433         global viewinstances
1434         unset commfd($inst)
1435         set i [lsearch -exact $viewinstances($view) $inst]
1436         if {$i >= 0} {
1437             set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1438         }
1439         # set it blocking so we wait for the process to terminate
1440         fconfigure $fd -blocking 1
1441         if {[catch {close $fd} err]} {
1442             set fv {}
1443             if {$view != $curview} {
1444                 set fv " for the \"$viewname($view)\" view"
1445             }
1446             if {[string range $err 0 4] == "usage"} {
1447                 set err "Gitk: error reading commits$fv:\
1448                         bad arguments to git log."
1449                 if {$viewname($view) eq [mc "Command line"]} {
1450                     append err \
1451                         "  (Note: arguments to gitk are passed to git log\
1452                          to allow selection of commits to be displayed.)"
1453                 }
1454             } else {
1455                 set err "Error reading commits$fv: $err"
1456             }
1457             error_popup $err
1458         }
1459         if {[incr viewactive($view) -1] <= 0} {
1460             set viewcomplete($view) 1
1461             # Check if we have seen any ids listed as parents that haven't
1462             # appeared in the list
1463             closevarcs $view
1464             notbusy $view
1465         }
1466         if {$view == $curview} {
1467             run chewcommits
1468         }
1469         return 0
1470     }
1471     set start 0
1472     set gotsome 0
1473     set scripts {}
1474     while 1 {
1475         set i [string first "\0" $stuff $start]
1476         if {$i < 0} {
1477             append leftover($inst) [string range $stuff $start end]
1478             break
1479         }
1480         if {$start == 0} {
1481             set cmit $leftover($inst)
1482             append cmit [string range $stuff 0 [expr {$i - 1}]]
1483             set leftover($inst) {}
1484         } else {
1485             set cmit [string range $stuff $start [expr {$i - 1}]]
1486         }
1487         set start [expr {$i + 1}]
1488         set j [string first "\n" $cmit]
1489         set ok 0
1490         set listed 1
1491         if {$j >= 0 && [string match "commit *" $cmit]} {
1492             set ids [string range $cmit 7 [expr {$j - 1}]]
1493             if {[string match {[-^<>]*} $ids]} {
1494                 switch -- [string index $ids 0] {
1495                     "-" {set listed 0}
1496                     "^" {set listed 2}
1497                     "<" {set listed 3}
1498                     ">" {set listed 4}
1499                 }
1500                 set ids [string range $ids 1 end]
1501             }
1502             set ok 1
1503             foreach id $ids {
1504                 if {[string length $id] != 40} {
1505                     set ok 0
1506                     break
1507                 }
1508             }
1509         }
1510         if {!$ok} {
1511             set shortcmit $cmit
1512             if {[string length $shortcmit] > 80} {
1513                 set shortcmit "[string range $shortcmit 0 80]..."
1514             }
1515             error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1516             exit 1
1517         }
1518         set id [lindex $ids 0]
1519         set vid $view,$id
1520
1521         lappend vshortids($view,[string range $id 0 3]) $id
1522
1523         if {!$listed && $updating && ![info exists varcid($vid)] &&
1524             $vfilelimit($view) ne {}} {
1525             # git log doesn't rewrite parents for unlisted commits
1526             # when doing path limiting, so work around that here
1527             # by working out the rewritten parent with git rev-list
1528             # and if we already know about it, using the rewritten
1529             # parent as a substitute parent for $id's children.
1530             if {![catch {
1531                 set rwid [exec git rev-list --first-parent --max-count=1 \
1532                               $id -- $vfilelimit($view)]
1533             }]} {
1534                 if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1535                     # use $rwid in place of $id
1536                     rewrite_commit $view $id $rwid
1537                     continue
1538                 }
1539             }
1540         }
1541
1542         set a 0
1543         if {[info exists varcid($vid)]} {
1544             if {$cmitlisted($vid) || !$listed} continue
1545             set a $varcid($vid)
1546         }
1547         if {$listed} {
1548             set olds [lrange $ids 1 end]
1549         } else {
1550             set olds {}
1551         }
1552         set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1553         set cmitlisted($vid) $listed
1554         set parents($vid) $olds
1555         if {![info exists children($vid)]} {
1556             set children($vid) {}
1557         } elseif {$a == 0 && [llength $children($vid)] == 1} {
1558             set k [lindex $children($vid) 0]
1559             if {[llength $parents($view,$k)] == 1 &&
1560                 (!$vdatemode($view) ||
1561                  $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1562                 set a $varcid($view,$k)
1563             }
1564         }
1565         if {$a == 0} {
1566             # new arc
1567             set a [newvarc $view $id]
1568         }
1569         if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1570             modify_arc $view $a
1571         }
1572         if {![info exists varcid($vid)]} {
1573             set varcid($vid) $a
1574             lappend varccommits($view,$a) $id
1575             incr commitidx($view)
1576         }
1577
1578         set i 0
1579         foreach p $olds {
1580             if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1581                 set vp $view,$p
1582                 if {[llength [lappend children($vp) $id]] > 1 &&
1583                     [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1584                     set children($vp) [lsort -command [list vtokcmp $view] \
1585                                            $children($vp)]
1586                     unset -nocomplain ordertok
1587                 }
1588                 if {[info exists varcid($view,$p)]} {
1589                     fix_reversal $p $a $view
1590                 }
1591             }
1592             incr i
1593         }
1594
1595         set scripts [check_interest $id $scripts]
1596         set gotsome 1
1597     }
1598     if {$gotsome} {
1599         global numcommits hlview
1600
1601         if {$view == $curview} {
1602             set numcommits $commitidx($view)
1603             run chewcommits
1604         }
1605         if {[info exists hlview] && $view == $hlview} {
1606             # we never actually get here...
1607             run vhighlightmore
1608         }
1609         foreach s $scripts {
1610             eval $s
1611         }
1612     }
1613     return 2
1614 }
1615
1616 proc chewcommits {} {
1617     global curview hlview viewcomplete
1618     global pending_select
1619
1620     layoutmore
1621     if {$viewcomplete($curview)} {
1622         global commitidx varctok
1623         global numcommits startmsecs
1624
1625         if {[info exists pending_select]} {
1626             update
1627             reset_pending_select {}
1628
1629             if {[commitinview $pending_select $curview]} {
1630                 selectline [rowofcommit $pending_select] 1
1631             } else {
1632                 set row [first_real_row]
1633                 selectline $row 1
1634             }
1635         }
1636         if {$commitidx($curview) > 0} {
1637             #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1638             #puts "overall $ms ms for $numcommits commits"
1639             #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1640         } else {
1641             show_status [mc "No commits selected"]
1642         }
1643         notbusy layout
1644     }
1645     return 0
1646 }
1647
1648 proc do_readcommit {id} {
1649     global tclencoding
1650
1651     # Invoke git-log to handle automatic encoding conversion
1652     set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1653     # Read the results using i18n.logoutputencoding
1654     fconfigure $fd -translation lf -eofchar {}
1655     if {$tclencoding != {}} {
1656         fconfigure $fd -encoding $tclencoding
1657     }
1658     set contents [read $fd]
1659     close $fd
1660     # Remove the heading line
1661     regsub {^commit [0-9a-f]+\n} $contents {} contents
1662
1663     return $contents
1664 }
1665
1666 proc readcommit {id} {
1667     if {[catch {set contents [do_readcommit $id]}]} return
1668     parsecommit $id $contents 1
1669 }
1670
1671 proc parsecommit {id contents listed} {
1672     global commitinfo
1673
1674     set inhdr 1
1675     set comment {}
1676     set headline {}
1677     set auname {}
1678     set audate {}
1679     set comname {}
1680     set comdate {}
1681     set hdrend [string first "\n\n" $contents]
1682     if {$hdrend < 0} {
1683         # should never happen...
1684         set hdrend [string length $contents]
1685     }
1686     set header [string range $contents 0 [expr {$hdrend - 1}]]
1687     set comment [string range $contents [expr {$hdrend + 2}] end]
1688     foreach line [split $header "\n"] {
1689         set line [split $line " "]
1690         set tag [lindex $line 0]
1691         if {$tag == "author"} {
1692             set audate [lrange $line end-1 end]
1693             set auname [join [lrange $line 1 end-2] " "]
1694         } elseif {$tag == "committer"} {
1695             set comdate [lrange $line end-1 end]
1696             set comname [join [lrange $line 1 end-2] " "]
1697         }
1698     }
1699     set headline {}
1700     # take the first non-blank line of the comment as the headline
1701     set headline [string trimleft $comment]
1702     set i [string first "\n" $headline]
1703     if {$i >= 0} {
1704         set headline [string range $headline 0 $i]
1705     }
1706     set headline [string trimright $headline]
1707     set i [string first "\r" $headline]
1708     if {$i >= 0} {
1709         set headline [string trimright [string range $headline 0 $i]]
1710     }
1711     if {!$listed} {
1712         # git log indents the comment by 4 spaces;
1713         # if we got this via git cat-file, add the indentation
1714         set newcomment {}
1715         foreach line [split $comment "\n"] {
1716             append newcomment "    "
1717             append newcomment $line
1718             append newcomment "\n"
1719         }
1720         set comment $newcomment
1721     }
1722     set hasnote [string first "\nNotes:\n" $contents]
1723     set diff ""
1724     # If there is diff output shown in the git-log stream, split it
1725     # out.  But get rid of the empty line that always precedes the
1726     # diff.
1727     set i [string first "\n\ndiff" $comment]
1728     if {$i >= 0} {
1729         set diff [string range $comment $i+1 end]
1730         set comment [string range $comment 0 $i-1]
1731     }
1732     set commitinfo($id) [list $headline $auname $audate \
1733                              $comname $comdate $comment $hasnote $diff]
1734 }
1735
1736 proc getcommit {id} {
1737     global commitdata commitinfo
1738
1739     if {[info exists commitdata($id)]} {
1740         parsecommit $id $commitdata($id) 1
1741     } else {
1742         readcommit $id
1743         if {![info exists commitinfo($id)]} {
1744             set commitinfo($id) [list [mc "No commit information available"]]
1745         }
1746     }
1747     return 1
1748 }
1749
1750 # Expand an abbreviated commit ID to a list of full 40-char IDs that match
1751 # and are present in the current view.
1752 # This is fairly slow...
1753 proc longid {prefix} {
1754     global varcid curview vshortids
1755
1756     set ids {}
1757     if {[string length $prefix] >= 4} {
1758         set vshortid $curview,[string range $prefix 0 3]
1759         if {[info exists vshortids($vshortid)]} {
1760             foreach id $vshortids($vshortid) {
1761                 if {[string match "$prefix*" $id]} {
1762                     if {[lsearch -exact $ids $id] < 0} {
1763                         lappend ids $id
1764                         if {[llength $ids] >= 2} break
1765                     }
1766                 }
1767             }
1768         }
1769     } else {
1770         foreach match [array names varcid "$curview,$prefix*"] {
1771             lappend ids [lindex [split $match ","] 1]
1772             if {[llength $ids] >= 2} break
1773         }
1774     }
1775     return $ids
1776 }
1777
1778 proc readrefs {} {
1779     global tagids idtags headids idheads tagobjid
1780     global otherrefids idotherrefs mainhead mainheadid
1781     global selecthead selectheadid
1782     global hideremotes
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     while {[gets $refd line] >= 0} {
1789         if {[string index $line 40] ne " "} continue
1790         set id [string range $line 0 39]
1791         set ref [string range $line 41 end]
1792         if {![string match "refs/*" $ref]} continue
1793         set name [string range $ref 5 end]
1794         if {[string match "remotes/*" $name]} {
1795             if {![string match "*/HEAD" $name] && !$hideremotes} {
1796                 set headids($name) $id
1797                 lappend idheads($id) $name
1798             }
1799         } elseif {[string match "heads/*" $name]} {
1800             set name [string range $name 6 end]
1801             set headids($name) $id
1802             lappend idheads($id) $name
1803         } elseif {[string match "tags/*" $name]} {
1804             # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1805             # which is what we want since the former is the commit ID
1806             set name [string range $name 5 end]
1807             if {[string match "*^{}" $name]} {
1808                 set name [string range $name 0 end-3]
1809             } else {
1810                 set tagobjid($name) $id
1811             }
1812             set tagids($name) $id
1813             lappend idtags($id) $name
1814         } else {
1815             set otherrefids($name) $id
1816             lappend idotherrefs($id) $name
1817         }
1818     }
1819     catch {close $refd}
1820     set mainhead {}
1821     set mainheadid {}
1822     catch {
1823         set mainheadid [exec git rev-parse HEAD]
1824         set thehead [exec git symbolic-ref HEAD]
1825         if {[string match "refs/heads/*" $thehead]} {
1826             set mainhead [string range $thehead 11 end]
1827         }
1828     }
1829     set selectheadid {}
1830     if {$selecthead ne {}} {
1831         catch {
1832             set selectheadid [exec git rev-parse --verify $selecthead]
1833         }
1834     }
1835 }
1836
1837 # skip over fake commits
1838 proc first_real_row {} {
1839     global nullid nullid2 numcommits
1840
1841     for {set row 0} {$row < $numcommits} {incr row} {
1842         set id [commitonrow $row]
1843         if {$id ne $nullid && $id ne $nullid2} {
1844             break
1845         }
1846     }
1847     return $row
1848 }
1849
1850 # update things for a head moved to a child of its previous location
1851 proc movehead {id name} {
1852     global headids idheads
1853
1854     removehead $headids($name) $name
1855     set headids($name) $id
1856     lappend idheads($id) $name
1857 }
1858
1859 # update things when a head has been removed
1860 proc removehead {id name} {
1861     global headids idheads
1862
1863     if {$idheads($id) eq $name} {
1864         unset idheads($id)
1865     } else {
1866         set i [lsearch -exact $idheads($id) $name]
1867         if {$i >= 0} {
1868             set idheads($id) [lreplace $idheads($id) $i $i]
1869         }
1870     }
1871     unset headids($name)
1872 }
1873
1874 proc ttk_toplevel {w args} {
1875     global use_ttk
1876     eval [linsert $args 0 ::toplevel $w]
1877     if {$use_ttk} {
1878         place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1879     }
1880     return $w
1881 }
1882
1883 proc make_transient {window origin} {
1884     global have_tk85
1885
1886     # In MacOS Tk 8.4 transient appears to work by setting
1887     # overrideredirect, which is utterly useless, since the
1888     # windows get no border, and are not even kept above
1889     # the parent.
1890     if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1891
1892     wm transient $window $origin
1893
1894     # Windows fails to place transient windows normally, so
1895     # schedule a callback to center them on the parent.
1896     if {[tk windowingsystem] eq {win32}} {
1897         after idle [list tk::PlaceWindow $window widget $origin]
1898     }
1899 }
1900
1901 proc show_error {w top msg} {
1902     global NS
1903     if {![info exists NS]} {set NS ""}
1904     if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1905     message $w.m -text $msg -justify center -aspect 400
1906     pack $w.m -side top -fill x -padx 20 -pady 20
1907     ${NS}::button $w.ok -default active -text [mc OK] -command "destroy $top"
1908     pack $w.ok -side bottom -fill x
1909     bind $top <Visibility> "grab $top; focus $top"
1910     bind $top <Key-Return> "destroy $top"
1911     bind $top <Key-space>  "destroy $top"
1912     bind $top <Key-Escape> "destroy $top"
1913     tkwait window $top
1914 }
1915
1916 proc error_popup {msg {owner .}} {
1917     if {[tk windowingsystem] eq "win32"} {
1918         tk_messageBox -icon error -type ok -title [wm title .] \
1919             -parent $owner -message $msg
1920     } else {
1921         set w .error
1922         ttk_toplevel $w
1923         make_transient $w $owner
1924         show_error $w $w $msg
1925     }
1926 }
1927
1928 proc confirm_popup {msg {owner .}} {
1929     global confirm_ok NS
1930     set confirm_ok 0
1931     set w .confirm
1932     ttk_toplevel $w
1933     make_transient $w $owner
1934     message $w.m -text $msg -justify center -aspect 400
1935     pack $w.m -side top -fill x -padx 20 -pady 20
1936     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1937     pack $w.ok -side left -fill x
1938     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1939     pack $w.cancel -side right -fill x
1940     bind $w <Visibility> "grab $w; focus $w"
1941     bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1942     bind $w <Key-space>  "set confirm_ok 1; destroy $w"
1943     bind $w <Key-Escape> "destroy $w"
1944     tk::PlaceWindow $w widget $owner
1945     tkwait window $w
1946     return $confirm_ok
1947 }
1948
1949 proc setoptions {} {
1950     global use_ttk
1951
1952     if {[tk windowingsystem] ne "win32"} {
1953         option add *Panedwindow.showHandle 1 startupFile
1954         option add *Panedwindow.sashRelief raised startupFile
1955         if {[tk windowingsystem] ne "aqua"} {
1956             option add *Menu.font uifont startupFile
1957         }
1958     } else {
1959         option add *Menu.TearOff 0 startupFile
1960     }
1961     option add *Button.font uifont startupFile
1962     option add *Checkbutton.font uifont startupFile
1963     option add *Radiobutton.font uifont startupFile
1964     option add *Menubutton.font uifont startupFile
1965     option add *Label.font uifont startupFile
1966     option add *Message.font uifont startupFile
1967     option add *Entry.font textfont startupFile
1968     option add *Text.font textfont startupFile
1969     option add *Labelframe.font uifont startupFile
1970     option add *Spinbox.font textfont startupFile
1971     option add *Listbox.font mainfont startupFile
1972 }
1973
1974 proc setttkstyle {} {
1975     eval font configure TkDefaultFont [fontflags mainfont]
1976     eval font configure TkTextFont [fontflags textfont]
1977     eval font configure TkHeadingFont [fontflags mainfont]
1978     eval font configure TkCaptionFont [fontflags mainfont] -weight bold
1979     eval font configure TkTooltipFont [fontflags uifont]
1980     eval font configure TkFixedFont   [fontflags textfont]
1981     eval font configure TkIconFont    [fontflags uifont]
1982     eval font configure TkMenuFont    [fontflags uifont]
1983     eval font configure TkSmallCaptionFont [fontflags uifont]
1984 }
1985
1986 # Make a menu and submenus.
1987 # m is the window name for the menu, items is the list of menu items to add.
1988 # Each item is a list {mc label type description options...}
1989 # mc is ignored; it's so we can put mc there to alert xgettext
1990 # label is the string that appears in the menu
1991 # type is cascade, command or radiobutton (should add checkbutton)
1992 # description depends on type; it's the sublist for cascade, the
1993 # command to invoke for command, or {variable value} for radiobutton
1994 proc makemenu {m items} {
1995     menu $m
1996     if {[tk windowingsystem] eq {aqua}} {
1997         set Meta1 Cmd
1998     } else {
1999         set Meta1 Ctrl
2000     }
2001     foreach i $items {
2002         set name [mc [lindex $i 1]]
2003         set type [lindex $i 2]
2004         set thing [lindex $i 3]
2005         set params [list $type]
2006         if {$name ne {}} {
2007             set u [string first "&" [string map {&& x} $name]]
2008             lappend params -label [string map {&& & & {}} $name]
2009             if {$u >= 0} {
2010                 lappend params -underline $u
2011             }
2012         }
2013         switch -- $type {
2014             "cascade" {
2015                 set submenu [string tolower [string map {& ""} [lindex $i 1]]]
2016                 lappend params -menu $m.$submenu
2017             }
2018             "command" {
2019                 lappend params -command $thing
2020             }
2021             "radiobutton" {
2022                 lappend params -variable [lindex $thing 0] \
2023                     -value [lindex $thing 1]
2024             }
2025         }
2026         set tail [lrange $i 4 end]
2027         regsub -all {\yMeta1\y} $tail $Meta1 tail
2028         eval $m add $params $tail
2029         if {$type eq "cascade"} {
2030             makemenu $m.$submenu $thing
2031         }
2032     }
2033 }
2034
2035 # translate string and remove ampersands
2036 proc mca {str} {
2037     return [string map {&& & & {}} [mc $str]]
2038 }
2039
2040 proc cleardropsel {w} {
2041     $w selection clear
2042 }
2043 proc makedroplist {w varname args} {
2044     global use_ttk
2045     if {$use_ttk} {
2046         set width 0
2047         foreach label $args {
2048             set cx [string length $label]
2049             if {$cx > $width} {set width $cx}
2050         }
2051         set gm [ttk::combobox $w -width $width -state readonly\
2052                     -textvariable $varname -values $args \
2053                     -exportselection false]
2054         bind $gm <<ComboboxSelected>> [list $gm selection clear]
2055     } else {
2056         set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2057     }
2058     return $gm
2059 }
2060
2061 proc makewindow {} {
2062     global canv canv2 canv3 linespc charspc ctext cflist cscroll
2063     global tabstop
2064     global findtype findtypemenu findloc findstring fstring geometry
2065     global entries sha1entry sha1string sha1but
2066     global diffcontextstring diffcontext
2067     global ignorespace
2068     global maincursor textcursor curtextcursor
2069     global rowctxmenu fakerowmenu mergemax wrapcomment
2070     global highlight_files gdttype
2071     global searchstring sstring
2072     global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
2073     global uifgcolor uifgdisabledcolor
2074     global filesepbgcolor filesepfgcolor
2075     global mergecolors foundbgcolor currentsearchhitbgcolor
2076     global headctxmenu progresscanv progressitem progresscoords statusw
2077     global fprogitem fprogcoord lastprogupdate progupdatepending
2078     global rprogitem rprogcoord rownumsel numcommits
2079     global have_tk85 use_ttk NS
2080     global git_version
2081     global worddiff
2082
2083     # The "mc" arguments here are purely so that xgettext
2084     # sees the following string as needing to be translated
2085     set file {
2086         mc "&File" cascade {
2087             {mc "&Update" command updatecommits -accelerator F5}
2088             {mc "&Reload" command reloadcommits -accelerator Shift-F5}
2089             {mc "Reread re&ferences" command rereadrefs}
2090             {mc "&List references" command showrefs -accelerator F2}
2091             {xx "" separator}
2092             {mc "Start git &gui" command {exec git gui &}}
2093             {xx "" separator}
2094             {mc "&Quit" command doquit -accelerator Meta1-Q}
2095         }}
2096     set edit {
2097         mc "&Edit" cascade {
2098             {mc "&Preferences" command doprefs}
2099         }}
2100     set view {
2101         mc "&View" cascade {
2102             {mc "&New view..." command {newview 0} -accelerator Shift-F4}
2103             {mc "&Edit view..." command editview -state disabled -accelerator F4}
2104             {mc "&Delete view" command delview -state disabled}
2105             {xx "" separator}
2106             {mc "&All files" radiobutton {selectedview 0} -command {showview 0}}
2107         }}
2108     if {[tk windowingsystem] ne "aqua"} {
2109         set help {
2110         mc "&Help" cascade {
2111             {mc "&About gitk" command about}
2112             {mc "&Key bindings" command keys}
2113         }}
2114         set bar [list $file $edit $view $help]
2115     } else {
2116         proc ::tk::mac::ShowPreferences {} {doprefs}
2117         proc ::tk::mac::Quit {} {doquit}
2118         lset file end [lreplace [lindex $file end] end-1 end]
2119         set apple {
2120         xx "&Apple" cascade {
2121             {mc "&About gitk" command about}
2122             {xx "" separator}
2123         }}
2124         set help {
2125         mc "&Help" cascade {
2126             {mc "&Key bindings" command keys}
2127         }}
2128         set bar [list $apple $file $view $help]
2129     }
2130     makemenu .bar $bar
2131     . configure -menu .bar
2132
2133     if {$use_ttk} {
2134         # cover the non-themed toplevel with a themed frame.
2135         place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2136     }
2137
2138     # the gui has upper and lower half, parts of a paned window.
2139     ${NS}::panedwindow .ctop -orient vertical
2140
2141     # possibly use assumed geometry
2142     if {![info exists geometry(pwsash0)]} {
2143         set geometry(topheight) [expr {15 * $linespc}]
2144         set geometry(topwidth) [expr {80 * $charspc}]
2145         set geometry(botheight) [expr {15 * $linespc}]
2146         set geometry(botwidth) [expr {50 * $charspc}]
2147         set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2148         set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2149     }
2150
2151     # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2152     ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2153     ${NS}::frame .tf.histframe
2154     ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2155     if {!$use_ttk} {
2156         .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2157     }
2158
2159     # create three canvases
2160     set cscroll .tf.histframe.csb
2161     set canv .tf.histframe.pwclist.canv
2162     canvas $canv \
2163         -selectbackground $selectbgcolor \
2164         -background $bgcolor -bd 0 \
2165         -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2166     .tf.histframe.pwclist add $canv
2167     set canv2 .tf.histframe.pwclist.canv2
2168     canvas $canv2 \
2169         -selectbackground $selectbgcolor \
2170         -background $bgcolor -bd 0 -yscrollincr $linespc
2171     .tf.histframe.pwclist add $canv2
2172     set canv3 .tf.histframe.pwclist.canv3
2173     canvas $canv3 \
2174         -selectbackground $selectbgcolor \
2175         -background $bgcolor -bd 0 -yscrollincr $linespc
2176     .tf.histframe.pwclist add $canv3
2177     if {$use_ttk} {
2178         bind .tf.histframe.pwclist <Map> {
2179             bind %W <Map> {}
2180             .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2181             .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2182         }
2183     } else {
2184         eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2185         eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2186     }
2187
2188     # a scroll bar to rule them
2189     ${NS}::scrollbar $cscroll -command {allcanvs yview}
2190     if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2191     pack $cscroll -side right -fill y
2192     bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2193     lappend bglist $canv $canv2 $canv3
2194     pack .tf.histframe.pwclist -fill both -expand 1 -side left
2195
2196     # we have two button bars at bottom of top frame. Bar 1
2197     ${NS}::frame .tf.bar
2198     ${NS}::frame .tf.lbar -height 15
2199
2200     set sha1entry .tf.bar.sha1
2201     set entries $sha1entry
2202     set sha1but .tf.bar.sha1label
2203     button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2204         -command gotocommit -width 8
2205     $sha1but conf -disabledforeground [$sha1but cget -foreground]
2206     pack .tf.bar.sha1label -side left
2207     ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2208     trace add variable sha1string write sha1change
2209     pack $sha1entry -side left -pady 2
2210
2211     set bm_left_data {
2212         #define left_width 16
2213         #define left_height 16
2214         static unsigned char left_bits[] = {
2215         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2216         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2217         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2218     }
2219     set bm_right_data {
2220         #define right_width 16
2221         #define right_height 16
2222         static unsigned char right_bits[] = {
2223         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2224         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2225         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2226     }
2227     image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2228     image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2229     image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2230     image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
2231
2232     ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2233     if {$use_ttk} {
2234         .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2235     } else {
2236         .tf.bar.leftbut configure -image bm-left
2237     }
2238     pack .tf.bar.leftbut -side left -fill y
2239     ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2240     if {$use_ttk} {
2241         .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2242     } else {
2243         .tf.bar.rightbut configure -image bm-right
2244     }
2245     pack .tf.bar.rightbut -side left -fill y
2246
2247     ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2248     set rownumsel {}
2249     ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2250         -relief sunken -anchor e
2251     ${NS}::label .tf.bar.rowlabel2 -text "/"
2252     ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2253         -relief sunken -anchor e
2254     pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2255         -side left
2256     if {!$use_ttk} {
2257         foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2258     }
2259     global selectedline
2260     trace add variable selectedline write selectedline_change
2261
2262     # Status label and progress bar
2263     set statusw .tf.bar.status
2264     ${NS}::label $statusw -width 15 -relief sunken
2265     pack $statusw -side left -padx 5
2266     if {$use_ttk} {
2267         set progresscanv [ttk::progressbar .tf.bar.progress]
2268     } else {
2269         set h [expr {[font metrics uifont -linespace] + 2}]
2270         set progresscanv .tf.bar.progress
2271         canvas $progresscanv -relief sunken -height $h -borderwidth 2
2272         set progressitem [$progresscanv create rect -1 0 0 $h -fill "#00ff00"]
2273         set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2274         set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2275     }
2276     pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2277     set progresscoords {0 0}
2278     set fprogcoord 0
2279     set rprogcoord 0
2280     bind $progresscanv <Configure> adjustprogress
2281     set lastprogupdate [clock clicks -milliseconds]
2282     set progupdatepending 0
2283
2284     # build up the bottom bar of upper window
2285     ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2286
2287     set bm_down_data {
2288         #define down_width 16
2289         #define down_height 16
2290         static unsigned char down_bits[] = {
2291         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2292         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2293         0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
2294         0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
2295     }
2296     image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
2297     ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
2298     .tf.lbar.fnext configure -image bm-down
2299
2300     set bm_up_data {
2301         #define up_width 16
2302         #define up_height 16
2303         static unsigned char up_bits[] = {
2304         0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
2305         0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
2306         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2307         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
2308     }
2309     image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
2310     ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
2311     .tf.lbar.fprev configure -image bm-up
2312
2313     ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2314
2315     pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2316         -side left -fill y
2317     set gdttype [mc "containing:"]
2318     set gm [makedroplist .tf.lbar.gdttype gdttype \
2319                 [mc "containing:"] \
2320                 [mc "touching paths:"] \
2321                 [mc "adding/removing string:"] \
2322                 [mc "changing lines matching:"]]
2323     trace add variable gdttype write gdttype_change
2324     pack .tf.lbar.gdttype -side left -fill y
2325
2326     set findstring {}
2327     set fstring .tf.lbar.findstring
2328     lappend entries $fstring
2329     ${NS}::entry $fstring -width 30 -textvariable findstring
2330     trace add variable findstring write find_change
2331     set findtype [mc "Exact"]
2332     set findtypemenu [makedroplist .tf.lbar.findtype \
2333                           findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2334     trace add variable findtype write findcom_change
2335     set findloc [mc "All fields"]
2336     makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2337         [mc "Comments"] [mc "Author"] [mc "Committer"]
2338     trace add variable findloc write find_change
2339     pack .tf.lbar.findloc -side right
2340     pack .tf.lbar.findtype -side right
2341     pack $fstring -side left -expand 1 -fill x
2342
2343     # Finish putting the upper half of the viewer together
2344     pack .tf.lbar -in .tf -side bottom -fill x
2345     pack .tf.bar -in .tf -side bottom -fill x
2346     pack .tf.histframe -fill both -side top -expand 1
2347     .ctop add .tf
2348     if {!$use_ttk} {
2349         .ctop paneconfigure .tf -height $geometry(topheight)
2350         .ctop paneconfigure .tf -width $geometry(topwidth)
2351     }
2352
2353     # now build up the bottom
2354     ${NS}::panedwindow .pwbottom -orient horizontal
2355
2356     # lower left, a text box over search bar, scroll bar to the right
2357     # if we know window height, then that will set the lower text height, otherwise
2358     # we set lower text height which will drive window height
2359     if {[info exists geometry(main)]} {
2360         ${NS}::frame .bleft -width $geometry(botwidth)
2361     } else {
2362         ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2363     }
2364     ${NS}::frame .bleft.top
2365     ${NS}::frame .bleft.mid
2366     ${NS}::frame .bleft.bottom
2367
2368     # gap between sub-widgets
2369     set wgap [font measure uifont "i"]
2370
2371     ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2372     pack .bleft.top.search -side left -padx 5
2373     set sstring .bleft.top.sstring
2374     set searchstring ""
2375     ${NS}::entry $sstring -width 20 -textvariable searchstring
2376     lappend entries $sstring
2377     trace add variable searchstring write incrsearch
2378     pack $sstring -side left -expand 1 -fill x
2379     ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2380         -command changediffdisp -variable diffelide -value {0 0}
2381     ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2382         -command changediffdisp -variable diffelide -value {0 1}
2383     ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2384         -command changediffdisp -variable diffelide -value {1 0}
2385
2386     ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2387     pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left -ipadx $wgap
2388     spinbox .bleft.mid.diffcontext -width 5 \
2389         -from 0 -increment 1 -to 10000000 \
2390         -validate all -validatecommand "diffcontextvalidate %P" \
2391         -textvariable diffcontextstring
2392     .bleft.mid.diffcontext set $diffcontext
2393     trace add variable diffcontextstring write diffcontextchange
2394     lappend entries .bleft.mid.diffcontext
2395     pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left -ipadx $wgap
2396     ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2397         -command changeignorespace -variable ignorespace
2398     pack .bleft.mid.ignspace -side left -padx 5
2399
2400     set worddiff [mc "Line diff"]
2401     if {[package vcompare $git_version "1.7.2"] >= 0} {
2402         makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2403             [mc "Markup words"] [mc "Color words"]
2404         trace add variable worddiff write changeworddiff
2405         pack .bleft.mid.worddiff -side left -padx 5
2406     }
2407
2408     set ctext .bleft.bottom.ctext
2409     text $ctext -background $bgcolor -foreground $fgcolor \
2410         -state disabled -undo 0 -font textfont \
2411         -yscrollcommand scrolltext -wrap none \
2412         -xscrollcommand ".bleft.bottom.sbhorizontal set"
2413     if {$have_tk85} {
2414         $ctext conf -tabstyle wordprocessor
2415     }
2416     ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2417     ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2418     pack .bleft.top -side top -fill x
2419     pack .bleft.mid -side top -fill x
2420     grid $ctext .bleft.bottom.sb -sticky nsew
2421     grid .bleft.bottom.sbhorizontal -sticky ew
2422     grid columnconfigure .bleft.bottom 0 -weight 1
2423     grid rowconfigure .bleft.bottom 0 -weight 1
2424     grid rowconfigure .bleft.bottom 1 -weight 0
2425     pack .bleft.bottom -side top -fill both -expand 1
2426     lappend bglist $ctext
2427     lappend fglist $ctext
2428
2429     $ctext tag conf comment -wrap $wrapcomment
2430     $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
2431     $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2432     $ctext tag conf d0 -fore [lindex $diffcolors 0]
2433     $ctext tag conf dresult -fore [lindex $diffcolors 1]
2434     $ctext tag conf m0 -fore [lindex $mergecolors 0]
2435     $ctext tag conf m1 -fore [lindex $mergecolors 1]
2436     $ctext tag conf m2 -fore [lindex $mergecolors 2]
2437     $ctext tag conf m3 -fore [lindex $mergecolors 3]
2438     $ctext tag conf m4 -fore [lindex $mergecolors 4]
2439     $ctext tag conf m5 -fore [lindex $mergecolors 5]
2440     $ctext tag conf m6 -fore [lindex $mergecolors 6]
2441     $ctext tag conf m7 -fore [lindex $mergecolors 7]
2442     $ctext tag conf m8 -fore [lindex $mergecolors 8]
2443     $ctext tag conf m9 -fore [lindex $mergecolors 9]
2444     $ctext tag conf m10 -fore [lindex $mergecolors 10]
2445     $ctext tag conf m11 -fore [lindex $mergecolors 11]
2446     $ctext tag conf m12 -fore [lindex $mergecolors 12]
2447     $ctext tag conf m13 -fore [lindex $mergecolors 13]
2448     $ctext tag conf m14 -fore [lindex $mergecolors 14]
2449     $ctext tag conf m15 -fore [lindex $mergecolors 15]
2450     $ctext tag conf mmax -fore darkgrey
2451     set mergemax 16
2452     $ctext tag conf mresult -font textfontbold
2453     $ctext tag conf msep -font textfontbold
2454     $ctext tag conf found -back $foundbgcolor
2455     $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
2456     $ctext tag conf wwrap -wrap word -lmargin2 1c
2457     $ctext tag conf bold -font textfontbold
2458
2459     .pwbottom add .bleft
2460     if {!$use_ttk} {
2461         .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2462     }
2463
2464     # lower right
2465     ${NS}::frame .bright
2466     ${NS}::frame .bright.mode
2467     ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2468         -command reselectline -variable cmitmode -value "patch"
2469     ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2470         -command reselectline -variable cmitmode -value "tree"
2471     grid .bright.mode.patch .bright.mode.tree -sticky ew
2472     pack .bright.mode -side top -fill x
2473     set cflist .bright.cfiles
2474     set indent [font measure mainfont "nn"]
2475     text $cflist \
2476         -selectbackground $selectbgcolor \
2477         -background $bgcolor -foreground $fgcolor \
2478         -font mainfont \
2479         -tabs [list $indent [expr {2 * $indent}]] \
2480         -yscrollcommand ".bright.sb set" \
2481         -cursor [. cget -cursor] \
2482         -spacing1 1 -spacing3 1
2483     lappend bglist $cflist
2484     lappend fglist $cflist
2485     ${NS}::scrollbar .bright.sb -command "$cflist yview"
2486     pack .bright.sb -side right -fill y
2487     pack $cflist -side left -fill both -expand 1
2488     $cflist tag configure highlight \
2489         -background [$cflist cget -selectbackground]
2490     $cflist tag configure bold -font mainfontbold
2491
2492     .pwbottom add .bright
2493     .ctop add .pwbottom
2494
2495     # restore window width & height if known
2496     if {[info exists geometry(main)]} {
2497         if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2498             if {$w > [winfo screenwidth .]} {
2499                 set w [winfo screenwidth .]
2500             }
2501             if {$h > [winfo screenheight .]} {
2502                 set h [winfo screenheight .]
2503             }
2504             wm geometry . "${w}x$h"
2505         }
2506     }
2507
2508     if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2509         wm state . $geometry(state)
2510     }
2511
2512     if {[tk windowingsystem] eq {aqua}} {
2513         set M1B M1
2514         set ::BM "3"
2515     } else {
2516         set M1B Control
2517         set ::BM "2"
2518     }
2519
2520     if {$use_ttk} {
2521         bind .ctop <Map> {
2522             bind %W <Map> {}
2523             %W sashpos 0 $::geometry(topheight)
2524         }
2525         bind .pwbottom <Map> {
2526             bind %W <Map> {}
2527             %W sashpos 0 $::geometry(botwidth)
2528         }
2529     }
2530
2531     bind .pwbottom <Configure> {resizecdetpanes %W %w}
2532     pack .ctop -fill both -expand 1
2533     bindall <1> {selcanvline %W %x %y}
2534     #bindall <B1-Motion> {selcanvline %W %x %y}
2535     if {[tk windowingsystem] == "win32"} {
2536         bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2537         bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2538     } else {
2539         bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2540         bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2541         bind $ctext <Button> {
2542             if {"%b" eq 6} {
2543                 $ctext xview scroll -5 units
2544             } elseif {"%b" eq 7} {
2545                 $ctext xview scroll 5 units
2546             }
2547         }
2548         if {[tk windowingsystem] eq "aqua"} {
2549             bindall <MouseWheel> {
2550                 set delta [expr {- (%D)}]
2551                 allcanvs yview scroll $delta units
2552             }
2553             bindall <Shift-MouseWheel> {
2554                 set delta [expr {- (%D)}]
2555                 $canv xview scroll $delta units
2556             }
2557         }
2558     }
2559     bindall <$::BM> "canvscan mark %W %x %y"
2560     bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2561     bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2562     bind . <$M1B-Key-w> doquit
2563     bindkey <Home> selfirstline
2564     bindkey <End> sellastline
2565     bind . <Key-Up> "selnextline -1"
2566     bind . <Key-Down> "selnextline 1"
2567     bind . <Shift-Key-Up> "dofind -1 0"
2568     bind . <Shift-Key-Down> "dofind 1 0"
2569     bindkey <Key-Right> "goforw"
2570     bindkey <Key-Left> "goback"
2571     bind . <Key-Prior> "selnextpage -1"
2572     bind . <Key-Next> "selnextpage 1"
2573     bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2574     bind . <$M1B-End> "allcanvs yview moveto 1.0"
2575     bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2576     bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2577     bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2578     bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2579     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2580     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2581     bindkey <Key-space> "$ctext yview scroll 1 pages"
2582     bindkey p "selnextline -1"
2583     bindkey n "selnextline 1"
2584     bindkey z "goback"
2585     bindkey x "goforw"
2586     bindkey k "selnextline -1"
2587     bindkey j "selnextline 1"
2588     bindkey h "goback"
2589     bindkey l "goforw"
2590     bindkey b prevfile
2591     bindkey d "$ctext yview scroll 18 units"
2592     bindkey u "$ctext yview scroll -18 units"
2593     bindkey g {$sha1entry delete 0 end; focus $sha1entry}
2594     bindkey / {focus $fstring}
2595     bindkey <Key-KP_Divide> {focus $fstring}
2596     bindkey <Key-Return> {dofind 1 1}
2597     bindkey ? {dofind -1 1}
2598     bindkey f nextfile
2599     bind . <F5> updatecommits
2600     bindmodfunctionkey Shift 5 reloadcommits
2601     bind . <F2> showrefs
2602     bindmodfunctionkey Shift 4 {newview 0}
2603     bind . <F4> edit_or_newview
2604     bind . <$M1B-q> doquit
2605     bind . <$M1B-f> {dofind 1 1}
2606     bind . <$M1B-g> {dofind 1 0}
2607     bind . <$M1B-r> dosearchback
2608     bind . <$M1B-s> dosearch
2609     bind . <$M1B-equal> {incrfont 1}
2610     bind . <$M1B-plus> {incrfont 1}
2611     bind . <$M1B-KP_Add> {incrfont 1}
2612     bind . <$M1B-minus> {incrfont -1}
2613     bind . <$M1B-KP_Subtract> {incrfont -1}
2614     wm protocol . WM_DELETE_WINDOW doquit
2615     bind . <Destroy> {stop_backends}
2616     bind . <Button-1> "click %W"
2617     bind $fstring <Key-Return> {dofind 1 1}
2618     bind $sha1entry <Key-Return> {gotocommit; break}
2619     bind $sha1entry <<PasteSelection>> clearsha1
2620     bind $sha1entry <<Paste>> clearsha1
2621     bind $cflist <1> {sel_flist %W %x %y; break}
2622     bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2623     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2624     global ctxbut
2625     bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2626     bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2627     bind $ctext <Button-1> {focus %W}
2628     bind $ctext <<Selection>> rehighlight_search_results
2629     for {set i 1} {$i < 10} {incr i} {
2630         bind . <$M1B-Key-$i> [list go_to_parent $i]
2631     }
2632
2633     set maincursor [. cget -cursor]
2634     set textcursor [$ctext cget -cursor]
2635     set curtextcursor $textcursor
2636
2637     set rowctxmenu .rowctxmenu
2638     makemenu $rowctxmenu {
2639         {mc "Diff this -> selected" command {diffvssel 0}}
2640         {mc "Diff selected -> this" command {diffvssel 1}}
2641         {mc "Make patch" command mkpatch}
2642         {mc "Create tag" command mktag}
2643         {mc "Copy commit summary" command copysummary}
2644         {mc "Write commit to file" command writecommit}
2645         {mc "Create new branch" command mkbranch}
2646         {mc "Cherry-pick this commit" command cherrypick}
2647         {mc "Reset HEAD branch to here" command resethead}
2648         {mc "Mark this commit" command markhere}
2649         {mc "Return to mark" command gotomark}
2650         {mc "Find descendant of this and mark" command find_common_desc}
2651         {mc "Compare with marked commit" command compare_commits}
2652         {mc "Diff this -> marked commit" command {diffvsmark 0}}
2653         {mc "Diff marked commit -> this" command {diffvsmark 1}}
2654         {mc "Revert this commit" command revert}
2655     }
2656     $rowctxmenu configure -tearoff 0
2657
2658     set fakerowmenu .fakerowmenu
2659     makemenu $fakerowmenu {
2660         {mc "Diff this -> selected" command {diffvssel 0}}
2661         {mc "Diff selected -> this" command {diffvssel 1}}
2662         {mc "Make patch" command mkpatch}
2663         {mc "Diff this -> marked commit" command {diffvsmark 0}}
2664         {mc "Diff marked commit -> this" command {diffvsmark 1}}
2665     }
2666     $fakerowmenu configure -tearoff 0
2667
2668     set headctxmenu .headctxmenu
2669     makemenu $headctxmenu {
2670         {mc "Check out this branch" command cobranch}
2671         {mc "Rename this branch" command mvbranch}
2672         {mc "Remove this branch" command rmbranch}
2673         {mc "Copy branch name" command {clipboard clear; clipboard append $headmenuhead}}
2674     }
2675     $headctxmenu configure -tearoff 0
2676
2677     global flist_menu
2678     set flist_menu .flistctxmenu
2679     makemenu $flist_menu {
2680         {mc "Highlight this too" command {flist_hl 0}}
2681         {mc "Highlight this only" command {flist_hl 1}}
2682         {mc "External diff" command {external_diff}}
2683         {mc "Blame parent commit" command {external_blame 1}}
2684         {mc "Copy path" command {clipboard clear; clipboard append $flist_menu_file}}
2685     }
2686     $flist_menu configure -tearoff 0
2687
2688     global diff_menu
2689     set diff_menu .diffctxmenu
2690     makemenu $diff_menu {
2691         {mc "Show origin of this line" command show_line_source}
2692         {mc "Run git gui blame on this line" command {external_blame_diff}}
2693     }
2694     $diff_menu configure -tearoff 0
2695 }
2696
2697 # Windows sends all mouse wheel events to the current focused window, not
2698 # the one where the mouse hovers, so bind those events here and redirect
2699 # to the correct window
2700 proc windows_mousewheel_redirector {W X Y D} {
2701     global canv canv2 canv3
2702     set w [winfo containing -displayof $W $X $Y]
2703     if {$w ne ""} {
2704         set u [expr {$D < 0 ? 5 : -5}]
2705         if {$w == $canv || $w == $canv2 || $w == $canv3} {
2706             allcanvs yview scroll $u units
2707         } else {
2708             catch {
2709                 $w yview scroll $u units
2710             }
2711         }
2712     }
2713 }
2714
2715 # Update row number label when selectedline changes
2716 proc selectedline_change {n1 n2 op} {
2717     global selectedline rownumsel
2718
2719     if {$selectedline eq {}} {
2720         set rownumsel {}
2721     } else {
2722         set rownumsel [expr {$selectedline + 1}]
2723     }
2724 }
2725
2726 # mouse-2 makes all windows scan vertically, but only the one
2727 # the cursor is in scans horizontally
2728 proc canvscan {op w x y} {
2729     global canv canv2 canv3
2730     foreach c [list $canv $canv2 $canv3] {
2731         if {$c == $w} {
2732             $c scan $op $x $y
2733         } else {
2734             $c scan $op 0 $y
2735         }
2736     }
2737 }
2738
2739 proc scrollcanv {cscroll f0 f1} {
2740     $cscroll set $f0 $f1
2741     drawvisible
2742     flushhighlights
2743 }
2744
2745 # when we make a key binding for the toplevel, make sure
2746 # it doesn't get triggered when that key is pressed in the
2747 # find string entry widget.
2748 proc bindkey {ev script} {
2749     global entries
2750     bind . $ev $script
2751     set escript [bind Entry $ev]
2752     if {$escript == {}} {
2753         set escript [bind Entry <Key>]
2754     }
2755     foreach e $entries {
2756         bind $e $ev "$escript; break"
2757     }
2758 }
2759
2760 proc bindmodfunctionkey {mod n script} {
2761     bind . <$mod-F$n> $script
2762     catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2763 }
2764
2765 # set the focus back to the toplevel for any click outside
2766 # the entry widgets
2767 proc click {w} {
2768     global ctext entries
2769     foreach e [concat $entries $ctext] {
2770         if {$w == $e} return
2771     }
2772     focus .
2773 }
2774
2775 # Adjust the progress bar for a change in requested extent or canvas size
2776 proc adjustprogress {} {
2777     global progresscanv progressitem progresscoords
2778     global fprogitem fprogcoord lastprogupdate progupdatepending
2779     global rprogitem rprogcoord use_ttk
2780
2781     if {$use_ttk} {
2782         $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2783         return
2784     }
2785
2786     set w [expr {[winfo width $progresscanv] - 4}]
2787     set x0 [expr {$w * [lindex $progresscoords 0]}]
2788     set x1 [expr {$w * [lindex $progresscoords 1]}]
2789     set h [winfo height $progresscanv]
2790     $progresscanv coords $progressitem $x0 0 $x1 $h
2791     $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2792     $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2793     set now [clock clicks -milliseconds]
2794     if {$now >= $lastprogupdate + 100} {
2795         set progupdatepending 0
2796         update
2797     } elseif {!$progupdatepending} {
2798         set progupdatepending 1
2799         after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2800     }
2801 }
2802
2803 proc doprogupdate {} {
2804     global lastprogupdate progupdatepending
2805
2806     if {$progupdatepending} {
2807         set progupdatepending 0
2808         set lastprogupdate [clock clicks -milliseconds]
2809         update
2810     }
2811 }
2812
2813 proc config_check_tmp_exists {tries_left} {
2814     global config_file_tmp
2815
2816     if {[file exists $config_file_tmp]} {
2817         incr tries_left -1
2818         if {$tries_left > 0} {
2819             after 100 [list config_check_tmp_exists $tries_left]
2820         } else {
2821             error_popup "There appears to be a stale $config_file_tmp\
2822  file, which will prevent gitk from saving its configuration on exit.\
2823  Please remove it if it is not being used by any existing gitk process."
2824         }
2825     }
2826 }
2827
2828 proc config_init_trace {name} {
2829     global config_variable_changed config_variable_original
2830
2831     upvar #0 $name var
2832     set config_variable_changed($name) 0
2833     set config_variable_original($name) $var
2834 }
2835
2836 proc config_variable_change_cb {name name2 op} {
2837     global config_variable_changed config_variable_original
2838
2839     upvar #0 $name var
2840     if {$op eq "write" &&
2841         (![info exists config_variable_original($name)] ||
2842          $config_variable_original($name) ne $var)} {
2843         set config_variable_changed($name) 1
2844     }
2845 }
2846
2847 proc savestuff {w} {
2848     global stuffsaved
2849     global config_file config_file_tmp
2850     global config_variables config_variable_changed
2851     global viewchanged
2852
2853     upvar #0 viewname current_viewname
2854     upvar #0 viewfiles current_viewfiles
2855     upvar #0 viewargs current_viewargs
2856     upvar #0 viewargscmd current_viewargscmd
2857     upvar #0 viewperm current_viewperm
2858     upvar #0 nextviewnum current_nextviewnum
2859     upvar #0 use_ttk current_use_ttk
2860
2861     if {$stuffsaved} return
2862     if {![winfo viewable .]} return
2863     set remove_tmp 0
2864     if {[catch {
2865         set try_count 0
2866         while {[catch {set f [open $config_file_tmp {WRONLY CREAT EXCL}]}]} {
2867             if {[incr try_count] > 50} {
2868                 error "Unable to write config file: $config_file_tmp exists"
2869             }
2870             after 100
2871         }
2872         set remove_tmp 1
2873         if {$::tcl_platform(platform) eq {windows}} {
2874             file attributes $config_file_tmp -hidden true
2875         }
2876         if {[file exists $config_file]} {
2877             source $config_file
2878         }
2879         foreach var_name $config_variables {
2880             upvar #0 $var_name var
2881             upvar 0 $var_name old_var
2882             if {!$config_variable_changed($var_name) && [info exists old_var]} {
2883                 puts $f [list set $var_name $old_var]
2884             } else {
2885                 puts $f [list set $var_name $var]
2886             }
2887         }
2888
2889         puts $f "set geometry(main) [wm geometry .]"
2890         puts $f "set geometry(state) [wm state .]"
2891         puts $f "set geometry(topwidth) [winfo width .tf]"
2892         puts $f "set geometry(topheight) [winfo height .tf]"
2893         if {$current_use_ttk} {
2894             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2895             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2896         } else {
2897             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2898             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2899         }
2900         puts $f "set geometry(botwidth) [winfo width .bleft]"
2901         puts $f "set geometry(botheight) [winfo height .bleft]"
2902
2903         array set view_save {}
2904         array set views {}
2905         if {![info exists permviews]} { set permviews {} }
2906         foreach view $permviews {
2907             set view_save([lindex $view 0]) 1
2908             set views([lindex $view 0]) $view
2909         }
2910         puts -nonewline $f "set permviews {"
2911         for {set v 1} {$v < $current_nextviewnum} {incr v} {
2912             if {$viewchanged($v)} {
2913                 if {$current_viewperm($v)} {
2914                     set views($current_viewname($v)) [list $current_viewname($v) $current_viewfiles($v) $current_viewargs($v) $current_viewargscmd($v)]
2915                 } else {
2916                     set view_save($current_viewname($v)) 0
2917                 }
2918             }
2919         }
2920         # write old and updated view to their places and append remaining to the end
2921         foreach view $permviews {
2922             set view_name [lindex $view 0]
2923             if {$view_save($view_name)} {
2924                 puts $f "{$views($view_name)}"
2925             }
2926             unset views($view_name)
2927         }
2928         foreach view_name [array names views] {
2929             puts $f "{$views($view_name)}"
2930         }
2931         puts $f "}"
2932         close $f
2933         file rename -force $config_file_tmp $config_file
2934         set remove_tmp 0
2935     } err]} {
2936         puts "Error saving config: $err"
2937     }
2938     if {$remove_tmp} {
2939         file delete -force $config_file_tmp
2940     }
2941     set stuffsaved 1
2942 }
2943
2944 proc resizeclistpanes {win w} {
2945     global oldwidth use_ttk
2946     if {[info exists oldwidth($win)]} {
2947         if {$use_ttk} {
2948             set s0 [$win sashpos 0]
2949             set s1 [$win sashpos 1]
2950         } else {
2951             set s0 [$win sash coord 0]
2952             set s1 [$win sash coord 1]
2953         }
2954         if {$w < 60} {
2955             set sash0 [expr {int($w/2 - 2)}]
2956             set sash1 [expr {int($w*5/6 - 2)}]
2957         } else {
2958             set factor [expr {1.0 * $w / $oldwidth($win)}]
2959             set sash0 [expr {int($factor * [lindex $s0 0])}]
2960             set sash1 [expr {int($factor * [lindex $s1 0])}]
2961             if {$sash0 < 30} {
2962                 set sash0 30
2963             }
2964             if {$sash1 < $sash0 + 20} {
2965                 set sash1 [expr {$sash0 + 20}]
2966             }
2967             if {$sash1 > $w - 10} {
2968                 set sash1 [expr {$w - 10}]
2969                 if {$sash0 > $sash1 - 20} {
2970                     set sash0 [expr {$sash1 - 20}]
2971                 }
2972             }
2973         }
2974         if {$use_ttk} {
2975             $win sashpos 0 $sash0
2976             $win sashpos 1 $sash1
2977         } else {
2978             $win sash place 0 $sash0 [lindex $s0 1]
2979             $win sash place 1 $sash1 [lindex $s1 1]
2980         }
2981     }
2982     set oldwidth($win) $w
2983 }
2984
2985 proc resizecdetpanes {win w} {
2986     global oldwidth use_ttk
2987     if {[info exists oldwidth($win)]} {
2988         if {$use_ttk} {
2989             set s0 [$win sashpos 0]
2990         } else {
2991             set s0 [$win sash coord 0]
2992         }
2993         if {$w < 60} {
2994             set sash0 [expr {int($w*3/4 - 2)}]
2995         } else {
2996             set factor [expr {1.0 * $w / $oldwidth($win)}]
2997             set sash0 [expr {int($factor * [lindex $s0 0])}]
2998             if {$sash0 < 45} {
2999                 set sash0 45
3000             }
3001             if {$sash0 > $w - 15} {
3002                 set sash0 [expr {$w - 15}]
3003             }
3004         }
3005         if {$use_ttk} {
3006             $win sashpos 0 $sash0
3007         } else {
3008             $win sash place 0 $sash0 [lindex $s0 1]
3009         }
3010     }
3011     set oldwidth($win) $w
3012 }
3013
3014 proc allcanvs args {
3015     global canv canv2 canv3
3016     eval $canv $args
3017     eval $canv2 $args
3018     eval $canv3 $args
3019 }
3020
3021 proc bindall {event action} {
3022     global canv canv2 canv3
3023     bind $canv $event $action
3024     bind $canv2 $event $action
3025     bind $canv3 $event $action
3026 }
3027
3028 proc about {} {
3029     global bgcolor NS
3030     set w .about
3031     if {[winfo exists $w]} {
3032         raise $w
3033         return
3034     }
3035     ttk_toplevel $w
3036     wm title $w [mc "About gitk"]
3037     make_transient $w .
3038     message $w.m -text [mc "
3039 Gitk - a commit viewer for git
3040
3041 Copyright \u00a9 2005-2016 Paul Mackerras
3042
3043 Use and redistribute under the terms of the GNU General Public License"] \
3044             -justify center -aspect 400 -border 2 -bg $bgcolor -relief groove
3045     pack $w.m -side top -fill x -padx 2 -pady 2
3046     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3047     pack $w.ok -side bottom
3048     bind $w <Visibility> "focus $w.ok"
3049     bind $w <Key-Escape> "destroy $w"
3050     bind $w <Key-Return> "destroy $w"
3051     tk::PlaceWindow $w widget .
3052 }
3053
3054 proc keys {} {
3055     global bgcolor NS
3056     set w .keys
3057     if {[winfo exists $w]} {
3058         raise $w
3059         return
3060     }
3061     if {[tk windowingsystem] eq {aqua}} {
3062         set M1T Cmd
3063     } else {
3064         set M1T Ctrl
3065     }
3066     ttk_toplevel $w
3067     wm title $w [mc "Gitk key bindings"]
3068     make_transient $w .
3069     message $w.m -text "
3070 [mc "Gitk key bindings:"]
3071
3072 [mc "<%s-Q>             Quit" $M1T]
3073 [mc "<%s-W>             Close window" $M1T]
3074 [mc "<Home>             Move to first commit"]
3075 [mc "<End>              Move to last commit"]
3076 [mc "<Up>, p, k Move up one commit"]
3077 [mc "<Down>, n, j       Move down one commit"]
3078 [mc "<Left>, z, h       Go back in history list"]
3079 [mc "<Right>, x, l      Go forward in history list"]
3080 [mc "<%s-n>     Go to n-th parent of current commit in history list" $M1T]
3081 [mc "<PageUp>   Move up one page in commit list"]
3082 [mc "<PageDown> Move down one page in commit list"]
3083 [mc "<%s-Home>  Scroll to top of commit list" $M1T]
3084 [mc "<%s-End>   Scroll to bottom of commit list" $M1T]
3085 [mc "<%s-Up>    Scroll commit list up one line" $M1T]
3086 [mc "<%s-Down>  Scroll commit list down one line" $M1T]
3087 [mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
3088 [mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
3089 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
3090 [mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
3091 [mc "<Delete>, b        Scroll diff view up one page"]
3092 [mc "<Backspace>        Scroll diff view up one page"]
3093 [mc "<Space>            Scroll diff view down one page"]
3094 [mc "u          Scroll diff view up 18 lines"]
3095 [mc "d          Scroll diff view down 18 lines"]
3096 [mc "<%s-F>             Find" $M1T]
3097 [mc "<%s-G>             Move to next find hit" $M1T]
3098 [mc "<Return>   Move to next find hit"]
3099 [mc "g          Go to commit"]
3100 [mc "/          Focus the search box"]
3101 [mc "?          Move to previous find hit"]
3102 [mc "f          Scroll diff view to next file"]
3103 [mc "<%s-S>             Search for next hit in diff view" $M1T]
3104 [mc "<%s-R>             Search for previous hit in diff view" $M1T]
3105 [mc "<%s-KP+>   Increase font size" $M1T]
3106 [mc "<%s-plus>  Increase font size" $M1T]
3107 [mc "<%s-KP->   Decrease font size" $M1T]
3108 [mc "<%s-minus> Decrease font size" $M1T]
3109 [mc "<F5>               Update"]
3110 " \
3111             -justify left -bg $bgcolor -border 2 -relief groove
3112     pack $w.m -side top -fill both -padx 2 -pady 2
3113     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3114     bind $w <Key-Escape> [list destroy $w]
3115     pack $w.ok -side bottom
3116     bind $w <Visibility> "focus $w.ok"
3117     bind $w <Key-Escape> "destroy $w"
3118     bind $w <Key-Return> "destroy $w"
3119 }
3120
3121 # Procedures for manipulating the file list window at the
3122 # bottom right of the overall window.
3123
3124 proc treeview {w l openlevs} {
3125     global treecontents treediropen treeheight treeparent treeindex
3126
3127     set ix 0
3128     set treeindex() 0
3129     set lev 0
3130     set prefix {}
3131     set prefixend -1
3132     set prefendstack {}
3133     set htstack {}
3134     set ht 0
3135     set treecontents() {}
3136     $w conf -state normal
3137     foreach f $l {
3138         while {[string range $f 0 $prefixend] ne $prefix} {
3139             if {$lev <= $openlevs} {
3140                 $w mark set e:$treeindex($prefix) "end -1c"
3141                 $w mark gravity e:$treeindex($prefix) left
3142             }
3143             set treeheight($prefix) $ht
3144             incr ht [lindex $htstack end]
3145             set htstack [lreplace $htstack end end]
3146             set prefixend [lindex $prefendstack end]
3147             set prefendstack [lreplace $prefendstack end end]
3148             set prefix [string range $prefix 0 $prefixend]
3149             incr lev -1
3150         }
3151         set tail [string range $f [expr {$prefixend+1}] end]
3152         while {[set slash [string first "/" $tail]] >= 0} {
3153             lappend htstack $ht
3154             set ht 0
3155             lappend prefendstack $prefixend
3156             incr prefixend [expr {$slash + 1}]
3157             set d [string range $tail 0 $slash]
3158             lappend treecontents($prefix) $d
3159             set oldprefix $prefix
3160             append prefix $d
3161             set treecontents($prefix) {}
3162             set treeindex($prefix) [incr ix]
3163             set treeparent($prefix) $oldprefix
3164             set tail [string range $tail [expr {$slash+1}] end]
3165             if {$lev <= $openlevs} {
3166                 set ht 1
3167                 set treediropen($prefix) [expr {$lev < $openlevs}]
3168                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3169                 $w mark set d:$ix "end -1c"
3170                 $w mark gravity d:$ix left
3171                 set str "\n"
3172                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3173                 $w insert end $str
3174                 $w image create end -align center -image $bm -padx 1 \
3175                     -name a:$ix
3176                 $w insert end $d [highlight_tag $prefix]
3177                 $w mark set s:$ix "end -1c"
3178                 $w mark gravity s:$ix left
3179             }
3180             incr lev
3181         }
3182         if {$tail ne {}} {
3183             if {$lev <= $openlevs} {
3184                 incr ht
3185                 set str "\n"
3186                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3187                 $w insert end $str
3188                 $w insert end $tail [highlight_tag $f]
3189             }
3190             lappend treecontents($prefix) $tail
3191         }
3192     }
3193     while {$htstack ne {}} {
3194         set treeheight($prefix) $ht
3195         incr ht [lindex $htstack end]
3196         set htstack [lreplace $htstack end end]
3197         set prefixend [lindex $prefendstack end]
3198         set prefendstack [lreplace $prefendstack end end]
3199         set prefix [string range $prefix 0 $prefixend]
3200     }
3201     $w conf -state disabled
3202 }
3203
3204 proc linetoelt {l} {
3205     global treeheight treecontents
3206
3207     set y 2
3208     set prefix {}
3209     while {1} {
3210         foreach e $treecontents($prefix) {
3211             if {$y == $l} {
3212                 return "$prefix$e"
3213             }
3214             set n 1
3215             if {[string index $e end] eq "/"} {
3216                 set n $treeheight($prefix$e)
3217                 if {$y + $n > $l} {
3218                     append prefix $e
3219                     incr y
3220                     break
3221                 }
3222             }
3223             incr y $n
3224         }
3225     }
3226 }
3227
3228 proc highlight_tree {y prefix} {
3229     global treeheight treecontents cflist
3230
3231     foreach e $treecontents($prefix) {
3232         set path $prefix$e
3233         if {[highlight_tag $path] ne {}} {
3234             $cflist tag add bold $y.0 "$y.0 lineend"
3235         }
3236         incr y
3237         if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3238             set y [highlight_tree $y $path]
3239         }
3240     }
3241     return $y
3242 }
3243
3244 proc treeclosedir {w dir} {
3245     global treediropen treeheight treeparent treeindex
3246
3247     set ix $treeindex($dir)
3248     $w conf -state normal
3249     $w delete s:$ix e:$ix
3250     set treediropen($dir) 0
3251     $w image configure a:$ix -image tri-rt
3252     $w conf -state disabled
3253     set n [expr {1 - $treeheight($dir)}]
3254     while {$dir ne {}} {
3255         incr treeheight($dir) $n
3256         set dir $treeparent($dir)
3257     }
3258 }
3259
3260 proc treeopendir {w dir} {
3261     global treediropen treeheight treeparent treecontents treeindex
3262
3263     set ix $treeindex($dir)
3264     $w conf -state normal
3265     $w image configure a:$ix -image tri-dn
3266     $w mark set e:$ix s:$ix
3267     $w mark gravity e:$ix right
3268     set lev 0
3269     set str "\n"
3270     set n [llength $treecontents($dir)]
3271     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3272         incr lev
3273         append str "\t"
3274         incr treeheight($x) $n
3275     }
3276     foreach e $treecontents($dir) {
3277         set de $dir$e
3278         if {[string index $e end] eq "/"} {
3279             set iy $treeindex($de)
3280             $w mark set d:$iy e:$ix
3281             $w mark gravity d:$iy left
3282             $w insert e:$ix $str
3283             set treediropen($de) 0
3284             $w image create e:$ix -align center -image tri-rt -padx 1 \
3285                 -name a:$iy
3286             $w insert e:$ix $e [highlight_tag $de]
3287             $w mark set s:$iy e:$ix
3288             $w mark gravity s:$iy left
3289             set treeheight($de) 1
3290         } else {
3291             $w insert e:$ix $str
3292             $w insert e:$ix $e [highlight_tag $de]
3293         }
3294     }
3295     $w mark gravity e:$ix right
3296     $w conf -state disabled
3297     set treediropen($dir) 1
3298     set top [lindex [split [$w index @0,0] .] 0]
3299     set ht [$w cget -height]
3300     set l [lindex [split [$w index s:$ix] .] 0]
3301     if {$l < $top} {
3302         $w yview $l.0
3303     } elseif {$l + $n + 1 > $top + $ht} {
3304         set top [expr {$l + $n + 2 - $ht}]
3305         if {$l < $top} {
3306             set top $l
3307         }
3308         $w yview $top.0
3309     }
3310 }
3311
3312 proc treeclick {w x y} {
3313     global treediropen cmitmode ctext cflist cflist_top
3314
3315     if {$cmitmode ne "tree"} return
3316     if {![info exists cflist_top]} return
3317     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3318     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3319     $cflist tag add highlight $l.0 "$l.0 lineend"
3320     set cflist_top $l
3321     if {$l == 1} {
3322         $ctext yview 1.0
3323         return
3324     }
3325     set e [linetoelt $l]
3326     if {[string index $e end] ne "/"} {
3327         showfile $e
3328     } elseif {$treediropen($e)} {
3329         treeclosedir $w $e
3330     } else {
3331         treeopendir $w $e
3332     }
3333 }
3334
3335 proc setfilelist {id} {
3336     global treefilelist cflist jump_to_here
3337
3338     treeview $cflist $treefilelist($id) 0
3339     if {$jump_to_here ne {}} {
3340         set f [lindex $jump_to_here 0]
3341         if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3342             showfile $f
3343         }
3344     }
3345 }
3346
3347 image create bitmap tri-rt -background black -foreground blue -data {
3348     #define tri-rt_width 13
3349     #define tri-rt_height 13
3350     static unsigned char tri-rt_bits[] = {
3351        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3352        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3353        0x00, 0x00};
3354 } -maskdata {
3355     #define tri-rt-mask_width 13
3356     #define tri-rt-mask_height 13
3357     static unsigned char tri-rt-mask_bits[] = {
3358        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3359        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3360        0x08, 0x00};
3361 }
3362 image create bitmap tri-dn -background black -foreground blue -data {
3363     #define tri-dn_width 13
3364     #define tri-dn_height 13
3365     static unsigned char tri-dn_bits[] = {
3366        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3367        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3368        0x00, 0x00};
3369 } -maskdata {
3370     #define tri-dn-mask_width 13
3371     #define tri-dn-mask_height 13
3372     static unsigned char tri-dn-mask_bits[] = {
3373        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3374        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3375        0x00, 0x00};
3376 }
3377
3378 image create bitmap reficon-T -background black -foreground yellow -data {
3379     #define tagicon_width 13
3380     #define tagicon_height 9
3381     static unsigned char tagicon_bits[] = {
3382        0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3383        0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3384 } -maskdata {
3385     #define tagicon-mask_width 13
3386     #define tagicon-mask_height 9
3387     static unsigned char tagicon-mask_bits[] = {
3388        0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3389        0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3390 }
3391 set rectdata {
3392     #define headicon_width 13
3393     #define headicon_height 9
3394     static unsigned char headicon_bits[] = {
3395        0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3396        0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3397 }
3398 set rectmask {
3399     #define headicon-mask_width 13
3400     #define headicon-mask_height 9
3401     static unsigned char headicon-mask_bits[] = {
3402        0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3403        0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3404 }
3405 image create bitmap reficon-H -background black -foreground "#00ff00" \
3406     -data $rectdata -maskdata $rectmask
3407 image create bitmap reficon-R -background black -foreground "#ffddaa" \
3408     -data $rectdata -maskdata $rectmask
3409 image create bitmap reficon-o -background black -foreground "#ddddff" \
3410     -data $rectdata -maskdata $rectmask
3411
3412 proc init_flist {first} {
3413     global cflist cflist_top difffilestart
3414
3415     $cflist conf -state normal
3416     $cflist delete 0.0 end
3417     if {$first ne {}} {
3418         $cflist insert end $first
3419         set cflist_top 1
3420         $cflist tag add highlight 1.0 "1.0 lineend"
3421     } else {
3422         unset -nocomplain cflist_top
3423     }
3424     $cflist conf -state disabled
3425     set difffilestart {}
3426 }
3427
3428 proc highlight_tag {f} {
3429     global highlight_paths
3430
3431     foreach p $highlight_paths {
3432         if {[string match $p $f]} {
3433             return "bold"
3434         }
3435     }
3436     return {}
3437 }
3438
3439 proc highlight_filelist {} {
3440     global cmitmode cflist
3441
3442     $cflist conf -state normal
3443     if {$cmitmode ne "tree"} {
3444         set end [lindex [split [$cflist index end] .] 0]
3445         for {set l 2} {$l < $end} {incr l} {
3446             set line [$cflist get $l.0 "$l.0 lineend"]
3447             if {[highlight_tag $line] ne {}} {
3448                 $cflist tag add bold $l.0 "$l.0 lineend"
3449             }
3450         }
3451     } else {
3452         highlight_tree 2 {}
3453     }
3454     $cflist conf -state disabled
3455 }
3456
3457 proc unhighlight_filelist {} {
3458     global cflist
3459
3460     $cflist conf -state normal
3461     $cflist tag remove bold 1.0 end
3462     $cflist conf -state disabled
3463 }
3464
3465 proc add_flist {fl} {
3466     global cflist
3467
3468     $cflist conf -state normal
3469     foreach f $fl {
3470         $cflist insert end "\n"
3471         $cflist insert end $f [highlight_tag $f]
3472     }
3473     $cflist conf -state disabled
3474 }
3475
3476 proc sel_flist {w x y} {
3477     global ctext difffilestart cflist cflist_top cmitmode
3478
3479     if {$cmitmode eq "tree"} return
3480     if {![info exists cflist_top]} return
3481     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3482     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3483     $cflist tag add highlight $l.0 "$l.0 lineend"
3484     set cflist_top $l
3485     if {$l == 1} {
3486         $ctext yview 1.0
3487     } else {
3488         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3489     }
3490     suppress_highlighting_file_for_current_scrollpos
3491 }
3492
3493 proc pop_flist_menu {w X Y x y} {
3494     global ctext cflist cmitmode flist_menu flist_menu_file
3495     global treediffs diffids
3496
3497     stopfinding
3498     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3499     if {$l <= 1} return
3500     if {$cmitmode eq "tree"} {
3501         set e [linetoelt $l]
3502         if {[string index $e end] eq "/"} return
3503     } else {
3504         set e [lindex $treediffs($diffids) [expr {$l-2}]]
3505     }
3506     set flist_menu_file $e
3507     set xdiffstate "normal"
3508     if {$cmitmode eq "tree"} {
3509         set xdiffstate "disabled"
3510     }
3511     # Disable "External diff" item in tree mode
3512     $flist_menu entryconf 2 -state $xdiffstate
3513     tk_popup $flist_menu $X $Y
3514 }
3515
3516 proc find_ctext_fileinfo {line} {
3517     global ctext_file_names ctext_file_lines
3518
3519     set ok [bsearch $ctext_file_lines $line]
3520     set tline [lindex $ctext_file_lines $ok]
3521
3522     if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3523         return {}
3524     } else {
3525         return [list [lindex $ctext_file_names $ok] $tline]
3526     }
3527 }
3528
3529 proc pop_diff_menu {w X Y x y} {
3530     global ctext diff_menu flist_menu_file
3531     global diff_menu_txtpos diff_menu_line
3532     global diff_menu_filebase
3533
3534     set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3535     set diff_menu_line [lindex $diff_menu_txtpos 0]
3536     # don't pop up the menu on hunk-separator or file-separator lines
3537     if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3538         return
3539     }
3540     stopfinding
3541     set f [find_ctext_fileinfo $diff_menu_line]
3542     if {$f eq {}} return
3543     set flist_menu_file [lindex $f 0]
3544     set diff_menu_filebase [lindex $f 1]
3545     tk_popup $diff_menu $X $Y
3546 }
3547
3548 proc flist_hl {only} {
3549     global flist_menu_file findstring gdttype
3550
3551     set x [shellquote $flist_menu_file]
3552     if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3553         set findstring $x
3554     } else {
3555         append findstring " " $x
3556     }
3557     set gdttype [mc "touching paths:"]
3558 }
3559
3560 proc gitknewtmpdir {} {
3561     global diffnum gitktmpdir gitdir env
3562
3563     if {![info exists gitktmpdir]} {
3564         if {[info exists env(GITK_TMPDIR)]} {
3565             set tmpdir $env(GITK_TMPDIR)
3566         } elseif {[info exists env(TMPDIR)]} {
3567             set tmpdir $env(TMPDIR)
3568         } else {
3569             set tmpdir $gitdir
3570         }
3571         set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
3572         if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
3573             set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3574         }
3575         if {[catch {file mkdir $gitktmpdir} err]} {
3576             error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3577             unset gitktmpdir
3578             return {}
3579         }
3580         set diffnum 0
3581     }
3582     incr diffnum
3583     set diffdir [file join $gitktmpdir $diffnum]
3584     if {[catch {file mkdir $diffdir} err]} {
3585         error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3586         return {}
3587     }
3588     return $diffdir
3589 }
3590
3591 proc save_file_from_commit {filename output what} {
3592     global nullfile
3593
3594     if {[catch {exec git show $filename -- > $output} err]} {
3595         if {[string match "fatal: bad revision *" $err]} {
3596             return $nullfile
3597         }
3598         error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3599         return {}
3600     }
3601     return $output
3602 }
3603
3604 proc external_diff_get_one_file {diffid filename diffdir} {
3605     global nullid nullid2 nullfile
3606     global worktree
3607
3608     if {$diffid == $nullid} {
3609         set difffile [file join $worktree $filename]
3610         if {[file exists $difffile]} {
3611             return $difffile
3612         }
3613         return $nullfile
3614     }
3615     if {$diffid == $nullid2} {
3616         set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3617         return [save_file_from_commit :$filename $difffile index]
3618     }
3619     set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3620     return [save_file_from_commit $diffid:$filename $difffile \
3621                "revision $diffid"]
3622 }
3623
3624 proc external_diff {} {
3625     global nullid nullid2
3626     global flist_menu_file
3627     global diffids
3628     global extdifftool
3629
3630     if {[llength $diffids] == 1} {
3631         # no reference commit given
3632         set diffidto [lindex $diffids 0]
3633         if {$diffidto eq $nullid} {
3634             # diffing working copy with index
3635             set diffidfrom $nullid2
3636         } elseif {$diffidto eq $nullid2} {
3637             # diffing index with HEAD
3638             set diffidfrom "HEAD"
3639         } else {
3640             # use first parent commit
3641             global parentlist selectedline
3642             set diffidfrom [lindex $parentlist $selectedline 0]
3643         }
3644     } else {
3645         set diffidfrom [lindex $diffids 0]
3646         set diffidto [lindex $diffids 1]
3647     }
3648
3649     # make sure that several diffs wont collide
3650     set diffdir [gitknewtmpdir]
3651     if {$diffdir eq {}} return
3652
3653     # gather files to diff
3654     set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3655     set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3656
3657     if {$difffromfile ne {} && $difftofile ne {}} {
3658         set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3659         if {[catch {set fl [open |$cmd r]} err]} {
3660             file delete -force $diffdir
3661             error_popup "$extdifftool: [mc "command failed:"] $err"
3662         } else {
3663             fconfigure $fl -blocking 0
3664             filerun $fl [list delete_at_eof $fl $diffdir]
3665         }
3666     }
3667 }
3668
3669 proc find_hunk_blamespec {base line} {
3670     global ctext
3671
3672     # Find and parse the hunk header
3673     set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3674     if {$s_lix eq {}} return
3675
3676     set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3677     if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3678             s_line old_specs osz osz1 new_line nsz]} {
3679         return
3680     }
3681
3682     # base lines for the parents
3683     set base_lines [list $new_line]
3684     foreach old_spec [lrange [split $old_specs " "] 1 end] {
3685         if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3686                 old_spec old_line osz]} {
3687             return
3688         }
3689         lappend base_lines $old_line
3690     }
3691
3692     # Now scan the lines to determine offset within the hunk
3693     set max_parent [expr {[llength $base_lines]-2}]
3694     set dline 0
3695     set s_lno [lindex [split $s_lix "."] 0]
3696
3697     # Determine if the line is removed
3698     set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3699     if {[string match {[-+ ]*} $chunk]} {
3700         set removed_idx [string first "-" $chunk]
3701         # Choose a parent index
3702         if {$removed_idx >= 0} {
3703             set parent $removed_idx
3704         } else {
3705             set unchanged_idx [string first " " $chunk]
3706             if {$unchanged_idx >= 0} {
3707                 set parent $unchanged_idx
3708             } else {
3709                 # blame the current commit
3710                 set parent -1
3711             }
3712         }
3713         # then count other lines that belong to it
3714         for {set i $line} {[incr i -1] > $s_lno} {} {
3715             set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3716             # Determine if the line is removed
3717             set removed_idx [string first "-" $chunk]
3718             if {$parent >= 0} {
3719                 set code [string index $chunk $parent]
3720                 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3721                     incr dline
3722                 }
3723             } else {
3724                 if {$removed_idx < 0} {
3725                     incr dline
3726                 }
3727             }
3728         }
3729         incr parent
3730     } else {
3731         set parent 0
3732     }
3733
3734     incr dline [lindex $base_lines $parent]
3735     return [list $parent $dline]
3736 }
3737
3738 proc external_blame_diff {} {
3739     global currentid cmitmode
3740     global diff_menu_txtpos diff_menu_line
3741     global diff_menu_filebase flist_menu_file
3742
3743     if {$cmitmode eq "tree"} {
3744         set parent_idx 0
3745         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3746     } else {
3747         set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3748         if {$hinfo ne {}} {
3749             set parent_idx [lindex $hinfo 0]
3750             set line [lindex $hinfo 1]
3751         } else {
3752             set parent_idx 0
3753             set line 0
3754         }
3755     }
3756
3757     external_blame $parent_idx $line
3758 }
3759
3760 # Find the SHA1 ID of the blob for file $fname in the index
3761 # at stage 0 or 2
3762 proc index_sha1 {fname} {
3763     set f [open [list | git ls-files -s $fname] r]
3764     while {[gets $f line] >= 0} {
3765         set info [lindex [split $line "\t"] 0]
3766         set stage [lindex $info 2]
3767         if {$stage eq "0" || $stage eq "2"} {
3768             close $f
3769             return [lindex $info 1]
3770         }
3771     }
3772     close $f
3773     return {}
3774 }
3775
3776 # Turn an absolute path into one relative to the current directory
3777 proc make_relative {f} {
3778     if {[file pathtype $f] eq "relative"} {
3779         return $f
3780     }
3781     set elts [file split $f]
3782     set here [file split [pwd]]
3783     set ei 0
3784     set hi 0
3785     set res {}
3786     foreach d $here {
3787         if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3788             lappend res ".."
3789         } else {
3790             incr ei
3791         }
3792         incr hi
3793     }
3794     set elts [concat $res [lrange $elts $ei end]]
3795     return [eval file join $elts]
3796 }
3797
3798 proc external_blame {parent_idx {line {}}} {
3799     global flist_menu_file cdup
3800     global nullid nullid2
3801     global parentlist selectedline currentid
3802
3803     if {$parent_idx > 0} {
3804         set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3805     } else {
3806         set base_commit $currentid
3807     }
3808
3809     if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3810         error_popup [mc "No such commit"]
3811         return
3812     }
3813
3814     set cmdline [list git gui blame]
3815     if {$line ne {} && $line > 1} {
3816         lappend cmdline "--line=$line"
3817     }
3818     set f [file join $cdup $flist_menu_file]
3819     # Unfortunately it seems git gui blame doesn't like
3820     # being given an absolute path...
3821     set f [make_relative $f]
3822     lappend cmdline $base_commit $f
3823     if {[catch {eval exec $cmdline &} err]} {
3824         error_popup "[mc "git gui blame: command failed:"] $err"
3825     }
3826 }
3827
3828 proc show_line_source {} {
3829     global cmitmode currentid parents curview blamestuff blameinst
3830     global diff_menu_line diff_menu_filebase flist_menu_file
3831     global nullid nullid2 gitdir cdup
3832
3833     set from_index {}
3834     if {$cmitmode eq "tree"} {
3835         set id $currentid
3836         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3837     } else {
3838         set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3839         if {$h eq {}} return
3840         set pi [lindex $h 0]
3841         if {$pi == 0} {
3842             mark_ctext_line $diff_menu_line
3843             return
3844         }
3845         incr pi -1
3846         if {$currentid eq $nullid} {
3847             if {$pi > 0} {
3848                 # must be a merge in progress...
3849                 if {[catch {
3850                     # get the last line from .git/MERGE_HEAD
3851                     set f [open [file join $gitdir MERGE_HEAD] r]
3852                     set id [lindex [split [read $f] "\n"] end-1]
3853                     close $f
3854                 } err]} {
3855                     error_popup [mc "Couldn't read merge head: %s" $err]
3856                     return
3857                 }
3858             } elseif {$parents($curview,$currentid) eq $nullid2} {
3859                 # need to do the blame from the index
3860                 if {[catch {
3861                     set from_index [index_sha1 $flist_menu_file]
3862                 } err]} {
3863                     error_popup [mc "Error reading index: %s" $err]
3864                     return
3865                 }
3866             } else {
3867                 set id $parents($curview,$currentid)
3868             }
3869         } else {
3870             set id [lindex $parents($curview,$currentid) $pi]
3871         }
3872         set line [lindex $h 1]
3873     }
3874     set blameargs {}
3875     if {$from_index ne {}} {
3876         lappend blameargs | git cat-file blob $from_index
3877     }
3878     lappend blameargs | git blame -p -L$line,+1
3879     if {$from_index ne {}} {
3880         lappend blameargs --contents -
3881     } else {
3882         lappend blameargs $id
3883     }
3884     lappend blameargs -- [file join $cdup $flist_menu_file]
3885     if {[catch {
3886         set f [open $blameargs r]
3887     } err]} {
3888         error_popup [mc "Couldn't start git blame: %s" $err]
3889         return
3890     }
3891     nowbusy blaming [mc "Searching"]
3892     fconfigure $f -blocking 0
3893     set i [reg_instance $f]
3894     set blamestuff($i) {}
3895     set blameinst $i
3896     filerun $f [list read_line_source $f $i]
3897 }
3898
3899 proc stopblaming {} {
3900     global blameinst
3901
3902     if {[info exists blameinst]} {
3903         stop_instance $blameinst
3904         unset blameinst
3905         notbusy blaming
3906     }
3907 }
3908
3909 proc read_line_source {fd inst} {
3910     global blamestuff curview commfd blameinst nullid nullid2
3911
3912     while {[gets $fd line] >= 0} {
3913         lappend blamestuff($inst) $line
3914     }
3915     if {![eof $fd]} {
3916         return 1
3917     }
3918     unset commfd($inst)
3919     unset blameinst
3920     notbusy blaming
3921     fconfigure $fd -blocking 1
3922     if {[catch {close $fd} err]} {
3923         error_popup [mc "Error running git blame: %s" $err]
3924         return 0
3925     }
3926
3927     set fname {}
3928     set line [split [lindex $blamestuff($inst) 0] " "]
3929     set id [lindex $line 0]
3930     set lnum [lindex $line 1]
3931     if {[string length $id] == 40 && [string is xdigit $id] &&
3932         [string is digit -strict $lnum]} {
3933         # look for "filename" line
3934         foreach l $blamestuff($inst) {
3935             if {[string match "filename *" $l]} {
3936                 set fname [string range $l 9 end]
3937                 break
3938             }
3939         }
3940     }
3941     if {$fname ne {}} {
3942         # all looks good, select it
3943         if {$id eq $nullid} {
3944             # blame uses all-zeroes to mean not committed,
3945             # which would mean a change in the index
3946             set id $nullid2
3947         }
3948         if {[commitinview $id $curview]} {
3949             selectline [rowofcommit $id] 1 [list $fname $lnum] 1
3950         } else {
3951             error_popup [mc "That line comes from commit %s, \
3952                              which is not in this view" [shortids $id]]
3953         }
3954     } else {
3955         puts "oops couldn't parse git blame output"
3956     }
3957     return 0
3958 }
3959
3960 # delete $dir when we see eof on $f (presumably because the child has exited)
3961 proc delete_at_eof {f dir} {
3962     while {[gets $f line] >= 0} {}
3963     if {[eof $f]} {
3964         if {[catch {close $f} err]} {
3965             error_popup "[mc "External diff viewer failed:"] $err"
3966         }
3967         file delete -force $dir
3968         return 0
3969     }
3970     return 1
3971 }
3972
3973 # Functions for adding and removing shell-type quoting
3974
3975 proc shellquote {str} {
3976     if {![string match "*\['\"\\ \t]*" $str]} {
3977         return $str
3978     }
3979     if {![string match "*\['\"\\]*" $str]} {
3980         return "\"$str\""
3981     }
3982     if {![string match "*'*" $str]} {
3983         return "'$str'"
3984     }
3985     return "\"[string map {\" \\\" \\ \\\\} $str]\""
3986 }
3987
3988 proc shellarglist {l} {
3989     set str {}
3990     foreach a $l {
3991         if {$str ne {}} {
3992             append str " "
3993         }
3994         append str [shellquote $a]
3995     }
3996     return $str
3997 }
3998
3999 proc shelldequote {str} {
4000     set ret {}
4001     set used -1
4002     while {1} {
4003         incr used
4004         if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
4005             append ret [string range $str $used end]
4006             set used [string length $str]
4007             break
4008         }
4009         set first [lindex $first 0]
4010         set ch [string index $str $first]
4011         if {$first > $used} {
4012             append ret [string range $str $used [expr {$first - 1}]]
4013             set used $first
4014         }
4015         if {$ch eq " " || $ch eq "\t"} break
4016         incr used
4017         if {$ch eq "'"} {
4018             set first [string first "'" $str $used]
4019             if {$first < 0} {
4020                 error "unmatched single-quote"
4021             }
4022             append ret [string range $str $used [expr {$first - 1}]]
4023             set used $first
4024             continue
4025         }
4026         if {$ch eq "\\"} {
4027             if {$used >= [string length $str]} {
4028                 error "trailing backslash"
4029             }
4030             append ret [string index $str $used]
4031             continue
4032         }
4033         # here ch == "\""
4034         while {1} {
4035             if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
4036                 error "unmatched double-quote"
4037             }
4038             set first [lindex $first 0]
4039             set ch [string index $str $first]
4040             if {$first > $used} {
4041                 append ret [string range $str $used [expr {$first - 1}]]
4042                 set used $first
4043             }
4044             if {$ch eq "\""} break
4045             incr used
4046             append ret [string index $str $used]
4047             incr used
4048         }
4049     }
4050     return [list $used $ret]
4051 }
4052
4053 proc shellsplit {str} {
4054     set l {}
4055     while {1} {
4056         set str [string trimleft $str]
4057         if {$str eq {}} break
4058         set dq [shelldequote $str]
4059         set n [lindex $dq 0]
4060         set word [lindex $dq 1]
4061         set str [string range $str $n end]
4062         lappend l $word
4063     }
4064     return $l
4065 }
4066
4067 proc set_window_title {} {
4068     global appname curview viewname vrevs
4069     set rev [mc "All files"]
4070     if {$curview ne 0} {
4071         if {$viewname($curview) eq [mc "Command line"]} {
4072             set rev [string map {"--gitk-symmetric-diff-marker" "--merge"} $vrevs($curview)]
4073         } else {
4074             set rev $viewname($curview)
4075         }
4076     }
4077     wm title . "[reponame]: $rev - $appname"
4078 }
4079
4080 # Code to implement multiple views
4081
4082 proc newview {ishighlight} {
4083     global nextviewnum newviewname newishighlight
4084     global revtreeargs viewargscmd newviewopts curview
4085
4086     set newishighlight $ishighlight
4087     set top .gitkview
4088     if {[winfo exists $top]} {
4089         raise $top
4090         return
4091     }
4092     decode_view_opts $nextviewnum $revtreeargs
4093     set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
4094     set newviewopts($nextviewnum,perm) 0
4095     set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
4096     vieweditor $top $nextviewnum [mc "Gitk view definition"]
4097 }
4098
4099 set known_view_options {
4100     {perm      b    .  {}               {mc "Remember this view"}}
4101     {reflabel  l    +  {}               {mc "References (space separated list):"}}
4102     {refs      t15  .. {}               {mc "Branches & tags:"}}
4103     {allrefs   b    *. "--all"          {mc "All refs"}}
4104     {branches  b    .  "--branches"     {mc "All (local) branches"}}
4105     {tags      b    .  "--tags"         {mc "All tags"}}
4106     {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
4107     {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
4108     {author    t15  .. "--author=*"     {mc "Author:"}}
4109     {committer t15  .  "--committer=*"  {mc "Committer:"}}
4110     {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
4111     {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
4112     {igrep     b    .. "--invert-grep"  {mc "Matches no Commit Info criteria"}}
4113     {changes_l l    +  {}               {mc "Changes to Files:"}}
4114     {pickaxe_s r0   .  {}               {mc "Fixed String"}}
4115     {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
4116     {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
4117     {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
4118     {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
4119     {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
4120     {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
4121     {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
4122     {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
4123     {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
4124     {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
4125     {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
4126     {first     b    .  "--first-parent" {mc "Limit to first parent"}}
4127     {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
4128     {args      t50  *. {}               {mc "Additional arguments to git log:"}}
4129     {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
4130     {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
4131     }
4132
4133 # Convert $newviewopts($n, ...) into args for git log.
4134 proc encode_view_opts {n} {
4135     global known_view_options newviewopts
4136
4137     set rargs [list]
4138     foreach opt $known_view_options {
4139         set patterns [lindex $opt 3]
4140         if {$patterns eq {}} continue
4141         set pattern [lindex $patterns 0]
4142
4143         if {[lindex $opt 1] eq "b"} {
4144             set val $newviewopts($n,[lindex $opt 0])
4145             if {$val} {
4146                 lappend rargs $pattern
4147             }
4148         } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4149             regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4150             set val $newviewopts($n,$button_id)
4151             if {$val eq $value} {
4152                 lappend rargs $pattern
4153             }
4154         } else {
4155             set val $newviewopts($n,[lindex $opt 0])
4156             set val [string trim $val]
4157             if {$val ne {}} {
4158                 set pfix [string range $pattern 0 end-1]
4159                 lappend rargs $pfix$val
4160             }
4161         }
4162     }
4163     set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4164     return [concat $rargs [shellsplit $newviewopts($n,args)]]
4165 }
4166
4167 # Fill $newviewopts($n, ...) based on args for git log.
4168 proc decode_view_opts {n view_args} {
4169     global known_view_options newviewopts
4170
4171     foreach opt $known_view_options {
4172         set id [lindex $opt 0]
4173         if {[lindex $opt 1] eq "b"} {
4174             # Checkboxes
4175             set val 0
4176         } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4177             # Radiobuttons
4178             regexp {^(.*_)} $id uselessvar id
4179             set val 0
4180         } else {
4181             # Text fields
4182             set val {}
4183         }
4184         set newviewopts($n,$id) $val
4185     }
4186     set oargs [list]
4187     set refargs [list]
4188     foreach arg $view_args {
4189         if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4190             && ![info exists found(limit)]} {
4191             set newviewopts($n,limit) $cnt
4192             set found(limit) 1
4193             continue
4194         }
4195         catch { unset val }
4196         foreach opt $known_view_options {
4197             set id [lindex $opt 0]
4198             if {[info exists found($id)]} continue
4199             foreach pattern [lindex $opt 3] {
4200                 if {![string match $pattern $arg]} continue
4201                 if {[lindex $opt 1] eq "b"} {
4202                     # Check buttons
4203                     set val 1
4204                 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4205                     # Radio buttons
4206                     regexp {^(.*_)} $id uselessvar id
4207                     set val $num
4208                 } else {
4209                     # Text input fields
4210                     set size [string length $pattern]
4211                     set val [string range $arg [expr {$size-1}] end]
4212                 }
4213                 set newviewopts($n,$id) $val
4214                 set found($id) 1
4215                 break
4216             }
4217             if {[info exists val]} break
4218         }
4219         if {[info exists val]} continue
4220         if {[regexp {^-} $arg]} {
4221             lappend oargs $arg
4222         } else {
4223             lappend refargs $arg
4224         }
4225     }
4226     set newviewopts($n,refs) [shellarglist $refargs]
4227     set newviewopts($n,args) [shellarglist $oargs]
4228 }
4229
4230 proc edit_or_newview {} {
4231     global curview
4232
4233     if {$curview > 0} {
4234         editview
4235     } else {
4236         newview 0
4237     }
4238 }
4239
4240 proc editview {} {
4241     global curview
4242     global viewname viewperm newviewname newviewopts
4243     global viewargs viewargscmd
4244
4245     set top .gitkvedit-$curview
4246     if {[winfo exists $top]} {
4247         raise $top
4248         return
4249     }
4250     decode_view_opts $curview $viewargs($curview)
4251     set newviewname($curview)      $viewname($curview)
4252     set newviewopts($curview,perm) $viewperm($curview)
4253     set newviewopts($curview,cmd)  $viewargscmd($curview)
4254     vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4255 }
4256
4257 proc vieweditor {top n title} {
4258     global newviewname newviewopts viewfiles bgcolor
4259     global known_view_options NS
4260
4261     ttk_toplevel $top
4262     wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4263     make_transient $top .
4264
4265     # View name
4266     ${NS}::frame $top.nfr
4267     ${NS}::label $top.nl -text [mc "View Name"]
4268     ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4269     pack $top.nfr -in $top -fill x -pady 5 -padx 3
4270     pack $top.nl -in $top.nfr -side left -padx {0 5}
4271     pack $top.name -in $top.nfr -side left -padx {0 25}
4272
4273     # View options
4274     set cframe $top.nfr
4275     set cexpand 0
4276     set cnt 0
4277     foreach opt $known_view_options {
4278         set id [lindex $opt 0]
4279         set type [lindex $opt 1]
4280         set flags [lindex $opt 2]
4281         set title [eval [lindex $opt 4]]
4282         set lxpad 0
4283
4284         if {$flags eq "+" || $flags eq "*"} {
4285             set cframe $top.fr$cnt
4286             incr cnt
4287             ${NS}::frame $cframe
4288             pack $cframe -in $top -fill x -pady 3 -padx 3
4289             set cexpand [expr {$flags eq "*"}]
4290         } elseif {$flags eq ".." || $flags eq "*."} {
4291             set cframe $top.fr$cnt
4292             incr cnt
4293             ${NS}::frame $cframe
4294             pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4295             set cexpand [expr {$flags eq "*."}]
4296         } else {
4297             set lxpad 5
4298         }
4299
4300         if {$type eq "l"} {
4301             ${NS}::label $cframe.l_$id -text $title
4302             pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4303         } elseif {$type eq "b"} {
4304             ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4305             pack $cframe.c_$id -in $cframe -side left \
4306                 -padx [list $lxpad 0] -expand $cexpand -anchor w
4307         } elseif {[regexp {^r(\d+)$} $type type sz]} {
4308             regexp {^(.*_)} $id uselessvar button_id
4309             ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4310             pack $cframe.c_$id -in $cframe -side left \
4311                 -padx [list $lxpad 0] -expand $cexpand -anchor w
4312         } elseif {[regexp {^t(\d+)$} $type type sz]} {
4313             ${NS}::label $cframe.l_$id -text $title
4314             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4315                 -textvariable newviewopts($n,$id)
4316             pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4317             pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4318         } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4319             ${NS}::label $cframe.l_$id -text $title
4320             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4321                 -textvariable newviewopts($n,$id)
4322             pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4323             pack $cframe.e_$id -in $cframe -side top -fill x
4324         } elseif {$type eq "path"} {
4325             ${NS}::label $top.l -text $title
4326             pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4327             text $top.t -width 40 -height 5 -background $bgcolor
4328             if {[info exists viewfiles($n)]} {
4329                 foreach f $viewfiles($n) {
4330                     $top.t insert end $f
4331                     $top.t insert end "\n"
4332                 }
4333                 $top.t delete {end - 1c} end
4334                 $top.t mark set insert 0.0
4335             }
4336             pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4337         }
4338     }
4339
4340     ${NS}::frame $top.buts
4341     ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4342     ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4343     ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4344     bind $top <Control-Return> [list newviewok $top $n]
4345     bind $top <F5> [list newviewok $top $n 1]
4346     bind $top <Escape> [list destroy $top]
4347     grid $top.buts.ok $top.buts.apply $top.buts.can
4348     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4349     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4350     grid columnconfigure $top.buts 2 -weight 1 -uniform a
4351     pack $top.buts -in $top -side top -fill x
4352     focus $top.t
4353 }
4354
4355 proc doviewmenu {m first cmd op argv} {
4356     set nmenu [$m index end]
4357     for {set i $first} {$i <= $nmenu} {incr i} {
4358         if {[$m entrycget $i -command] eq $cmd} {
4359             eval $m $op $i $argv
4360             break
4361         }
4362     }
4363 }
4364
4365 proc allviewmenus {n op args} {
4366     # global viewhlmenu
4367
4368     doviewmenu .bar.view 5 [list showview $n] $op $args
4369     # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4370 }
4371
4372 proc newviewok {top n {apply 0}} {
4373     global nextviewnum newviewperm newviewname newishighlight
4374     global viewname viewfiles viewperm viewchanged selectedview curview
4375     global viewargs viewargscmd newviewopts viewhlmenu
4376
4377     if {[catch {
4378         set newargs [encode_view_opts $n]
4379     } err]} {
4380         error_popup "[mc "Error in commit selection arguments:"] $err" $top
4381         return
4382     }
4383     set files {}
4384     foreach f [split [$top.t get 0.0 end] "\n"] {
4385         set ft [string trim $f]
4386         if {$ft ne {}} {
4387             lappend files $ft
4388         }
4389     }
4390     if {![info exists viewfiles($n)]} {
4391         # creating a new view
4392         incr nextviewnum
4393         set viewname($n) $newviewname($n)
4394         set viewperm($n) $newviewopts($n,perm)
4395         set viewchanged($n) 1
4396         set viewfiles($n) $files
4397         set viewargs($n) $newargs
4398         set viewargscmd($n) $newviewopts($n,cmd)
4399         addviewmenu $n
4400         if {!$newishighlight} {
4401             run showview $n
4402         } else {
4403             run addvhighlight $n
4404         }
4405     } else {
4406         # editing an existing view
4407         set viewperm($n) $newviewopts($n,perm)
4408         set viewchanged($n) 1
4409         if {$newviewname($n) ne $viewname($n)} {
4410             set viewname($n) $newviewname($n)
4411             doviewmenu .bar.view 5 [list showview $n] \
4412                 entryconf [list -label $viewname($n)]
4413             # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4414                 # entryconf [list -label $viewname($n) -value $viewname($n)]
4415         }
4416         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4417                 $newviewopts($n,cmd) ne $viewargscmd($n)} {
4418             set viewfiles($n) $files
4419             set viewargs($n) $newargs
4420             set viewargscmd($n) $newviewopts($n,cmd)
4421             if {$curview == $n} {
4422                 run reloadcommits
4423             }
4424         }
4425     }
4426     if {$apply} return
4427     catch {destroy $top}
4428 }
4429
4430 proc delview {} {
4431     global curview viewperm hlview selectedhlview viewchanged
4432
4433     if {$curview == 0} return
4434     if {[info exists hlview] && $hlview == $curview} {
4435         set selectedhlview [mc "None"]
4436         unset hlview
4437     }
4438     allviewmenus $curview delete
4439     set viewperm($curview) 0
4440     set viewchanged($curview) 1
4441     showview 0
4442 }
4443
4444 proc addviewmenu {n} {
4445     global viewname viewhlmenu
4446
4447     .bar.view add radiobutton -label $viewname($n) \
4448         -command [list showview $n] -variable selectedview -value $n
4449     #$viewhlmenu add radiobutton -label $viewname($n) \
4450     #   -command [list addvhighlight $n] -variable selectedhlview
4451 }
4452
4453 proc showview {n} {
4454     global curview cached_commitrow ordertok
4455     global displayorder parentlist rowidlist rowisopt rowfinal
4456     global colormap rowtextx nextcolor canvxmax
4457     global numcommits viewcomplete
4458     global selectedline currentid canv canvy0
4459     global treediffs
4460     global pending_select mainheadid
4461     global commitidx
4462     global selectedview
4463     global hlview selectedhlview commitinterest
4464
4465     if {$n == $curview} return
4466     set selid {}
4467     set ymax [lindex [$canv cget -scrollregion] 3]
4468     set span [$canv yview]
4469     set ytop [expr {[lindex $span 0] * $ymax}]
4470     set ybot [expr {[lindex $span 1] * $ymax}]
4471     set yscreen [expr {($ybot - $ytop) / 2}]
4472     if {$selectedline ne {}} {
4473         set selid $currentid
4474         set y [yc $selectedline]
4475         if {$ytop < $y && $y < $ybot} {
4476             set yscreen [expr {$y - $ytop}]
4477         }
4478     } elseif {[info exists pending_select]} {
4479         set selid $pending_select
4480         unset pending_select
4481     }
4482     unselectline
4483     normalline
4484     unset -nocomplain treediffs
4485     clear_display
4486     if {[info exists hlview] && $hlview == $n} {
4487         unset hlview
4488         set selectedhlview [mc "None"]
4489     }
4490     unset -nocomplain commitinterest
4491     unset -nocomplain cached_commitrow
4492     unset -nocomplain ordertok
4493
4494     set curview $n
4495     set selectedview $n
4496     .bar.view entryconf [mca "&Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4497     .bar.view entryconf [mca "&Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4498
4499     run refill_reflist
4500     if {![info exists viewcomplete($n)]} {
4501         getcommits $selid
4502         return
4503     }
4504
4505     set displayorder {}
4506     set parentlist {}
4507     set rowidlist {}
4508     set rowisopt {}
4509     set rowfinal {}
4510     set numcommits $commitidx($n)
4511
4512     unset -nocomplain colormap
4513     unset -nocomplain rowtextx
4514     set nextcolor 0
4515     set canvxmax [$canv cget -width]
4516     set curview $n
4517     set row 0
4518     setcanvscroll
4519     set yf 0
4520     set row {}
4521     if {$selid ne {} && [commitinview $selid $n]} {
4522         set row [rowofcommit $selid]
4523         # try to get the selected row in the same position on the screen
4524         set ymax [lindex [$canv cget -scrollregion] 3]
4525         set ytop [expr {[yc $row] - $yscreen}]
4526         if {$ytop < 0} {
4527             set ytop 0
4528         }
4529         set yf [expr {$ytop * 1.0 / $ymax}]
4530     }
4531     allcanvs yview moveto $yf
4532     drawvisible
4533     if {$row ne {}} {
4534         selectline $row 0
4535     } elseif {!$viewcomplete($n)} {
4536         reset_pending_select $selid
4537     } else {
4538         reset_pending_select {}
4539
4540         if {[commitinview $pending_select $curview]} {
4541             selectline [rowofcommit $pending_select] 1
4542         } else {
4543             set row [first_real_row]
4544             if {$row < $numcommits} {
4545                 selectline $row 0
4546             }
4547         }
4548     }
4549     if {!$viewcomplete($n)} {
4550         if {$numcommits == 0} {
4551             show_status [mc "Reading commits..."]
4552         }
4553     } elseif {$numcommits == 0} {
4554         show_status [mc "No commits selected"]
4555     }
4556     set_window_title
4557 }
4558
4559 # Stuff relating to the highlighting facility
4560
4561 proc ishighlighted {id} {
4562     global vhighlights fhighlights nhighlights rhighlights
4563
4564     if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4565         return $nhighlights($id)
4566     }
4567     if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4568         return $vhighlights($id)
4569     }
4570     if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4571         return $fhighlights($id)
4572     }
4573     if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4574         return $rhighlights($id)
4575     }
4576     return 0
4577 }
4578
4579 proc bolden {id font} {
4580     global canv linehtag currentid boldids need_redisplay markedid
4581
4582     # need_redisplay = 1 means the display is stale and about to be redrawn
4583     if {$need_redisplay} return
4584     lappend boldids $id
4585     $canv itemconf $linehtag($id) -font $font
4586     if {[info exists currentid] && $id eq $currentid} {
4587         $canv delete secsel
4588         set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4589                    -outline {{}} -tags secsel \
4590                    -fill [$canv cget -selectbackground]]
4591         $canv lower $t
4592     }
4593     if {[info exists markedid] && $id eq $markedid} {
4594         make_idmark $id
4595     }
4596 }
4597
4598 proc bolden_name {id font} {
4599     global canv2 linentag currentid boldnameids need_redisplay
4600
4601     if {$need_redisplay} return
4602     lappend boldnameids $id
4603     $canv2 itemconf $linentag($id) -font $font
4604     if {[info exists currentid] && $id eq $currentid} {
4605         $canv2 delete secsel
4606         set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4607                    -outline {{}} -tags secsel \
4608                    -fill [$canv2 cget -selectbackground]]
4609         $canv2 lower $t
4610     }
4611 }
4612
4613 proc unbolden {} {
4614     global boldids
4615
4616     set stillbold {}
4617     foreach id $boldids {
4618         if {![ishighlighted $id]} {
4619             bolden $id mainfont
4620         } else {
4621             lappend stillbold $id
4622         }
4623     }
4624     set boldids $stillbold
4625 }
4626
4627 proc addvhighlight {n} {
4628     global hlview viewcomplete curview vhl_done commitidx
4629
4630     if {[info exists hlview]} {
4631         delvhighlight
4632     }
4633     set hlview $n
4634     if {$n != $curview && ![info exists viewcomplete($n)]} {
4635         start_rev_list $n
4636     }
4637     set vhl_done $commitidx($hlview)
4638     if {$vhl_done > 0} {
4639         drawvisible
4640     }
4641 }
4642
4643 proc delvhighlight {} {
4644     global hlview vhighlights
4645
4646     if {![info exists hlview]} return
4647     unset hlview
4648     unset -nocomplain vhighlights
4649     unbolden
4650 }
4651
4652 proc vhighlightmore {} {
4653     global hlview vhl_done commitidx vhighlights curview
4654
4655     set max $commitidx($hlview)
4656     set vr [visiblerows]
4657     set r0 [lindex $vr 0]
4658     set r1 [lindex $vr 1]
4659     for {set i $vhl_done} {$i < $max} {incr i} {
4660         set id [commitonrow $i $hlview]
4661         if {[commitinview $id $curview]} {
4662             set row [rowofcommit $id]
4663             if {$r0 <= $row && $row <= $r1} {
4664                 if {![highlighted $row]} {
4665                     bolden $id mainfontbold
4666                 }
4667                 set vhighlights($id) 1
4668             }
4669         }
4670     }
4671     set vhl_done $max
4672     return 0
4673 }
4674
4675 proc askvhighlight {row id} {
4676     global hlview vhighlights iddrawn
4677
4678     if {[commitinview $id $hlview]} {
4679         if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4680             bolden $id mainfontbold
4681         }
4682         set vhighlights($id) 1
4683     } else {
4684         set vhighlights($id) 0
4685     }
4686 }
4687
4688 proc hfiles_change {} {
4689     global highlight_files filehighlight fhighlights fh_serial
4690     global highlight_paths
4691
4692     if {[info exists filehighlight]} {
4693         # delete previous highlights
4694         catch {close $filehighlight}
4695         unset filehighlight
4696         unset -nocomplain fhighlights
4697         unbolden
4698         unhighlight_filelist
4699     }
4700     set highlight_paths {}
4701     after cancel do_file_hl $fh_serial
4702     incr fh_serial
4703     if {$highlight_files ne {}} {
4704         after 300 do_file_hl $fh_serial
4705     }
4706 }
4707
4708 proc gdttype_change {name ix op} {
4709     global gdttype highlight_files findstring findpattern
4710
4711     stopfinding
4712     if {$findstring ne {}} {
4713         if {$gdttype eq [mc "containing:"]} {
4714             if {$highlight_files ne {}} {
4715                 set highlight_files {}
4716                 hfiles_change
4717             }
4718             findcom_change
4719         } else {
4720             if {$findpattern ne {}} {
4721                 set findpattern {}
4722                 findcom_change
4723             }
4724             set highlight_files $findstring
4725             hfiles_change
4726         }
4727         drawvisible
4728     }
4729     # enable/disable findtype/findloc menus too
4730 }
4731
4732 proc find_change {name ix op} {
4733     global gdttype findstring highlight_files
4734
4735     stopfinding
4736     if {$gdttype eq [mc "containing:"]} {
4737         findcom_change
4738     } else {
4739         if {$highlight_files ne $findstring} {
4740             set highlight_files $findstring
4741             hfiles_change
4742         }
4743     }
4744     drawvisible
4745 }
4746
4747 proc findcom_change args {
4748     global nhighlights boldnameids
4749     global findpattern findtype findstring gdttype
4750
4751     stopfinding
4752     # delete previous highlights, if any
4753     foreach id $boldnameids {
4754         bolden_name $id mainfont
4755     }
4756     set boldnameids {}
4757     unset -nocomplain nhighlights
4758     unbolden
4759     unmarkmatches
4760     if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4761         set findpattern {}
4762     } elseif {$findtype eq [mc "Regexp"]} {
4763         set findpattern $findstring
4764     } else {
4765         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4766                    $findstring]
4767         set findpattern "*$e*"
4768     }
4769 }
4770
4771 proc makepatterns {l} {
4772     set ret {}
4773     foreach e $l {
4774         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4775         if {[string index $ee end] eq "/"} {
4776             lappend ret "$ee*"
4777         } else {
4778             lappend ret $ee
4779             lappend ret "$ee/*"
4780         }
4781     }
4782     return $ret
4783 }
4784
4785 proc do_file_hl {serial} {
4786     global highlight_files filehighlight highlight_paths gdttype fhl_list
4787     global cdup findtype
4788
4789     if {$gdttype eq [mc "touching paths:"]} {
4790         # If "exact" match then convert backslashes to forward slashes.
4791         # Most useful to support Windows-flavoured file paths.
4792         if {$findtype eq [mc "Exact"]} {
4793             set highlight_files [string map {"\\" "/"} $highlight_files]
4794         }
4795         if {[catch {set paths [shellsplit $highlight_files]}]} return
4796         set highlight_paths [makepatterns $paths]
4797         highlight_filelist
4798         set relative_paths {}
4799         foreach path $paths {
4800             lappend relative_paths [file join $cdup $path]
4801         }
4802         set gdtargs [concat -- $relative_paths]
4803     } elseif {$gdttype eq [mc "adding/removing string:"]} {
4804         set gdtargs [list "-S$highlight_files"]
4805     } elseif {$gdttype eq [mc "changing lines matching:"]} {
4806         set gdtargs [list "-G$highlight_files"]
4807     } else {
4808         # must be "containing:", i.e. we're searching commit info
4809         return
4810     }
4811     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4812     set filehighlight [open $cmd r+]
4813     fconfigure $filehighlight -blocking 0
4814     filerun $filehighlight readfhighlight
4815     set fhl_list {}
4816     drawvisible
4817     flushhighlights
4818 }
4819
4820 proc flushhighlights {} {
4821     global filehighlight fhl_list
4822
4823     if {[info exists filehighlight]} {
4824         lappend fhl_list {}
4825         puts $filehighlight ""
4826         flush $filehighlight
4827     }
4828 }
4829
4830 proc askfilehighlight {row id} {
4831     global filehighlight fhighlights fhl_list
4832
4833     lappend fhl_list $id
4834     set fhighlights($id) -1
4835     puts $filehighlight $id
4836 }
4837
4838 proc readfhighlight {} {
4839     global filehighlight fhighlights curview iddrawn
4840     global fhl_list find_dirn
4841
4842     if {![info exists filehighlight]} {
4843         return 0
4844     }
4845     set nr 0
4846     while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4847         set line [string trim $line]
4848         set i [lsearch -exact $fhl_list $line]
4849         if {$i < 0} continue
4850         for {set j 0} {$j < $i} {incr j} {
4851             set id [lindex $fhl_list $j]
4852             set fhighlights($id) 0
4853         }
4854         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4855         if {$line eq {}} continue
4856         if {![commitinview $line $curview]} continue
4857         if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4858             bolden $line mainfontbold
4859         }
4860         set fhighlights($line) 1
4861     }
4862     if {[eof $filehighlight]} {
4863         # strange...
4864         puts "oops, git diff-tree died"
4865         catch {close $filehighlight}
4866         unset filehighlight
4867         return 0
4868     }
4869     if {[info exists find_dirn]} {
4870         run findmore
4871     }
4872     return 1
4873 }
4874
4875 proc doesmatch {f} {
4876     global findtype findpattern
4877
4878     if {$findtype eq [mc "Regexp"]} {
4879         return [regexp $findpattern $f]
4880     } elseif {$findtype eq [mc "IgnCase"]} {
4881         return [string match -nocase $findpattern $f]
4882     } else {
4883         return [string match $findpattern $f]
4884     }
4885 }
4886
4887 proc askfindhighlight {row id} {
4888     global nhighlights commitinfo iddrawn
4889     global findloc
4890     global markingmatches
4891
4892     if {![info exists commitinfo($id)]} {
4893         getcommit $id
4894     }
4895     set info $commitinfo($id)
4896     set isbold 0
4897     set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
4898     foreach f $info ty $fldtypes {
4899         if {$ty eq ""} continue
4900         if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4901             [doesmatch $f]} {
4902             if {$ty eq [mc "Author"]} {
4903                 set isbold 2
4904                 break
4905             }
4906             set isbold 1
4907         }
4908     }
4909     if {$isbold && [info exists iddrawn($id)]} {
4910         if {![ishighlighted $id]} {
4911             bolden $id mainfontbold
4912             if {$isbold > 1} {
4913                 bolden_name $id mainfontbold
4914             }
4915         }
4916         if {$markingmatches} {
4917             markrowmatches $row $id
4918         }
4919     }
4920     set nhighlights($id) $isbold
4921 }
4922
4923 proc markrowmatches {row id} {
4924     global canv canv2 linehtag linentag commitinfo findloc
4925
4926     set headline [lindex $commitinfo($id) 0]
4927     set author [lindex $commitinfo($id) 1]
4928     $canv delete match$row
4929     $canv2 delete match$row
4930     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4931         set m [findmatches $headline]
4932         if {$m ne {}} {
4933             markmatches $canv $row $headline $linehtag($id) $m \
4934                 [$canv itemcget $linehtag($id) -font] $row
4935         }
4936     }
4937     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4938         set m [findmatches $author]
4939         if {$m ne {}} {
4940             markmatches $canv2 $row $author $linentag($id) $m \
4941                 [$canv2 itemcget $linentag($id) -font] $row
4942         }
4943     }
4944 }
4945
4946 proc vrel_change {name ix op} {
4947     global highlight_related
4948
4949     rhighlight_none
4950     if {$highlight_related ne [mc "None"]} {
4951         run drawvisible
4952     }
4953 }
4954
4955 # prepare for testing whether commits are descendents or ancestors of a
4956 proc rhighlight_sel {a} {
4957     global descendent desc_todo ancestor anc_todo
4958     global highlight_related
4959
4960     unset -nocomplain descendent
4961     set desc_todo [list $a]
4962     unset -nocomplain ancestor
4963     set anc_todo [list $a]
4964     if {$highlight_related ne [mc "None"]} {
4965         rhighlight_none
4966         run drawvisible
4967     }
4968 }
4969
4970 proc rhighlight_none {} {
4971     global rhighlights
4972
4973     unset -nocomplain rhighlights
4974     unbolden
4975 }
4976
4977 proc is_descendent {a} {
4978     global curview children descendent desc_todo
4979
4980     set v $curview
4981     set la [rowofcommit $a]
4982     set todo $desc_todo
4983     set leftover {}
4984     set done 0
4985     for {set i 0} {$i < [llength $todo]} {incr i} {
4986         set do [lindex $todo $i]
4987         if {[rowofcommit $do] < $la} {
4988             lappend leftover $do
4989             continue
4990         }
4991         foreach nk $children($v,$do) {
4992             if {![info exists descendent($nk)]} {
4993                 set descendent($nk) 1
4994                 lappend todo $nk
4995                 if {$nk eq $a} {
4996                     set done 1
4997                 }
4998             }
4999         }
5000         if {$done} {
5001             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5002             return
5003         }
5004     }
5005     set descendent($a) 0
5006     set desc_todo $leftover
5007 }
5008
5009 proc is_ancestor {a} {
5010     global curview parents ancestor anc_todo
5011
5012     set v $curview
5013     set la [rowofcommit $a]
5014     set todo $anc_todo
5015     set leftover {}
5016     set done 0
5017     for {set i 0} {$i < [llength $todo]} {incr i} {
5018         set do [lindex $todo $i]
5019         if {![commitinview $do $v] || [rowofcommit $do] > $la} {
5020             lappend leftover $do
5021             continue
5022         }
5023         foreach np $parents($v,$do) {
5024             if {![info exists ancestor($np)]} {
5025                 set ancestor($np) 1
5026                 lappend todo $np
5027                 if {$np eq $a} {
5028                     set done 1
5029                 }
5030             }
5031         }
5032         if {$done} {
5033             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5034             return
5035         }
5036     }
5037     set ancestor($a) 0
5038     set anc_todo $leftover
5039 }
5040
5041 proc askrelhighlight {row id} {
5042     global descendent highlight_related iddrawn rhighlights
5043     global selectedline ancestor
5044
5045     if {$selectedline eq {}} return
5046     set isbold 0
5047     if {$highlight_related eq [mc "Descendant"] ||
5048         $highlight_related eq [mc "Not descendant"]} {
5049         if {![info exists descendent($id)]} {
5050             is_descendent $id
5051         }
5052         if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
5053             set isbold 1
5054         }
5055     } elseif {$highlight_related eq [mc "Ancestor"] ||
5056               $highlight_related eq [mc "Not ancestor"]} {
5057         if {![info exists ancestor($id)]} {
5058             is_ancestor $id
5059         }
5060         if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
5061             set isbold 1
5062         }
5063     }
5064     if {[info exists iddrawn($id)]} {
5065         if {$isbold && ![ishighlighted $id]} {
5066             bolden $id mainfontbold
5067         }
5068     }
5069     set rhighlights($id) $isbold
5070 }
5071
5072 # Graph layout functions
5073
5074 proc shortids {ids} {
5075     set res {}
5076     foreach id $ids {
5077         if {[llength $id] > 1} {
5078             lappend res [shortids $id]
5079         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
5080             lappend res [string range $id 0 7]
5081         } else {
5082             lappend res $id
5083         }
5084     }
5085     return $res
5086 }
5087
5088 proc ntimes {n o} {
5089     set ret {}
5090     set o [list $o]
5091     for {set mask 1} {$mask <= $n} {incr mask $mask} {
5092         if {($n & $mask) != 0} {
5093             set ret [concat $ret $o]
5094         }
5095         set o [concat $o $o]
5096     }
5097     return $ret
5098 }
5099
5100 proc ordertoken {id} {
5101     global ordertok curview varcid varcstart varctok curview parents children
5102     global nullid nullid2
5103
5104     if {[info exists ordertok($id)]} {
5105         return $ordertok($id)
5106     }
5107     set origid $id
5108     set todo {}
5109     while {1} {
5110         if {[info exists varcid($curview,$id)]} {
5111             set a $varcid($curview,$id)
5112             set p [lindex $varcstart($curview) $a]
5113         } else {
5114             set p [lindex $children($curview,$id) 0]
5115         }
5116         if {[info exists ordertok($p)]} {
5117             set tok $ordertok($p)
5118             break
5119         }
5120         set id [first_real_child $curview,$p]
5121         if {$id eq {}} {
5122             # it's a root
5123             set tok [lindex $varctok($curview) $varcid($curview,$p)]
5124             break
5125         }
5126         if {[llength $parents($curview,$id)] == 1} {
5127             lappend todo [list $p {}]
5128         } else {
5129             set j [lsearch -exact $parents($curview,$id) $p]
5130             if {$j < 0} {
5131                 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5132             }
5133             lappend todo [list $p [strrep $j]]
5134         }
5135     }
5136     for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5137         set p [lindex $todo $i 0]
5138         append tok [lindex $todo $i 1]
5139         set ordertok($p) $tok
5140     }
5141     set ordertok($origid) $tok
5142     return $tok
5143 }
5144
5145 # Work out where id should go in idlist so that order-token
5146 # values increase from left to right
5147 proc idcol {idlist id {i 0}} {
5148     set t [ordertoken $id]
5149     if {$i < 0} {
5150         set i 0
5151     }
5152     if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
5153         if {$i > [llength $idlist]} {
5154             set i [llength $idlist]
5155         }
5156         while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5157         incr i
5158     } else {
5159         if {$t > [ordertoken [lindex $idlist $i]]} {
5160             while {[incr i] < [llength $idlist] &&
5161                    $t >= [ordertoken [lindex $idlist $i]]} {}
5162         }
5163     }
5164     return $i
5165 }
5166
5167 proc initlayout {} {
5168     global rowidlist rowisopt rowfinal displayorder parentlist
5169     global numcommits canvxmax canv
5170     global nextcolor
5171     global colormap rowtextx
5172
5173     set numcommits 0
5174     set displayorder {}
5175     set parentlist {}
5176     set nextcolor 0
5177     set rowidlist {}
5178     set rowisopt {}
5179     set rowfinal {}
5180     set canvxmax [$canv cget -width]
5181     unset -nocomplain colormap
5182     unset -nocomplain rowtextx
5183     setcanvscroll
5184 }
5185
5186 proc setcanvscroll {} {
5187     global canv canv2 canv3 numcommits linespc canvxmax canvy0
5188     global lastscrollset lastscrollrows
5189
5190     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5191     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5192     $canv2 conf -scrollregion [list 0 0 0 $ymax]
5193     $canv3 conf -scrollregion [list 0 0 0 $ymax]
5194     set lastscrollset [clock clicks -milliseconds]
5195     set lastscrollrows $numcommits
5196 }
5197
5198 proc visiblerows {} {
5199     global canv numcommits linespc
5200
5201     set ymax [lindex [$canv cget -scrollregion] 3]
5202     if {$ymax eq {} || $ymax == 0} return
5203     set f [$canv yview]
5204     set y0 [expr {int([lindex $f 0] * $ymax)}]
5205     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5206     if {$r0 < 0} {
5207         set r0 0
5208     }
5209     set y1 [expr {int([lindex $f 1] * $ymax)}]
5210     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5211     if {$r1 >= $numcommits} {
5212         set r1 [expr {$numcommits - 1}]
5213     }
5214     return [list $r0 $r1]
5215 }
5216
5217 proc layoutmore {} {
5218     global commitidx viewcomplete curview
5219     global numcommits pending_select curview
5220     global lastscrollset lastscrollrows
5221
5222     if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5223         [clock clicks -milliseconds] - $lastscrollset > 500} {
5224         setcanvscroll
5225     }
5226     if {[info exists pending_select] &&
5227         [commitinview $pending_select $curview]} {
5228         update
5229         selectline [rowofcommit $pending_select] 1
5230     }
5231     drawvisible
5232 }
5233
5234 # With path limiting, we mightn't get the actual HEAD commit,
5235 # so ask git rev-list what is the first ancestor of HEAD that
5236 # touches a file in the path limit.
5237 proc get_viewmainhead {view} {
5238     global viewmainheadid vfilelimit viewinstances mainheadid
5239
5240     catch {
5241         set rfd [open [concat | git rev-list -1 $mainheadid \
5242                            -- $vfilelimit($view)] r]
5243         set j [reg_instance $rfd]
5244         lappend viewinstances($view) $j
5245         fconfigure $rfd -blocking 0
5246         filerun $rfd [list getviewhead $rfd $j $view]
5247         set viewmainheadid($curview) {}
5248     }
5249 }
5250
5251 # git rev-list should give us just 1 line to use as viewmainheadid($view)
5252 proc getviewhead {fd inst view} {
5253     global viewmainheadid commfd curview viewinstances showlocalchanges
5254
5255     set id {}
5256     if {[gets $fd line] < 0} {
5257         if {![eof $fd]} {
5258             return 1
5259         }
5260     } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5261         set id $line
5262     }
5263     set viewmainheadid($view) $id
5264     close $fd
5265     unset commfd($inst)
5266     set i [lsearch -exact $viewinstances($view) $inst]
5267     if {$i >= 0} {
5268         set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5269     }
5270     if {$showlocalchanges && $id ne {} && $view == $curview} {
5271         doshowlocalchanges
5272     }
5273     return 0
5274 }
5275
5276 proc doshowlocalchanges {} {
5277     global curview viewmainheadid
5278
5279     if {$viewmainheadid($curview) eq {}} return
5280     if {[commitinview $viewmainheadid($curview) $curview]} {
5281         dodiffindex
5282     } else {
5283         interestedin $viewmainheadid($curview) dodiffindex
5284     }
5285 }
5286
5287 proc dohidelocalchanges {} {
5288     global nullid nullid2 lserial curview
5289
5290     if {[commitinview $nullid $curview]} {
5291         removefakerow $nullid
5292     }
5293     if {[commitinview $nullid2 $curview]} {
5294         removefakerow $nullid2
5295     }
5296     incr lserial
5297 }
5298
5299 # spawn off a process to do git diff-index --cached HEAD
5300 proc dodiffindex {} {
5301     global lserial showlocalchanges vfilelimit curview
5302     global hasworktree git_version
5303
5304     if {!$showlocalchanges || !$hasworktree} return
5305     incr lserial
5306     if {[package vcompare $git_version "1.7.2"] >= 0} {
5307         set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
5308     } else {
5309         set cmd "|git diff-index --cached HEAD"
5310     }
5311     if {$vfilelimit($curview) ne {}} {
5312         set cmd [concat $cmd -- $vfilelimit($curview)]
5313     }
5314     set fd [open $cmd r]
5315     fconfigure $fd -blocking 0
5316     set i [reg_instance $fd]
5317     filerun $fd [list readdiffindex $fd $lserial $i]
5318 }
5319
5320 proc readdiffindex {fd serial inst} {
5321     global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5322     global vfilelimit
5323
5324     set isdiff 1
5325     if {[gets $fd line] < 0} {
5326         if {![eof $fd]} {
5327             return 1
5328         }
5329         set isdiff 0
5330     }
5331     # we only need to see one line and we don't really care what it says...
5332     stop_instance $inst
5333
5334     if {$serial != $lserial} {
5335         return 0
5336     }
5337
5338     # now see if there are any local changes not checked in to the index
5339     set cmd "|git diff-files"
5340     if {$vfilelimit($curview) ne {}} {
5341         set cmd [concat $cmd -- $vfilelimit($curview)]
5342     }
5343     set fd [open $cmd r]
5344     fconfigure $fd -blocking 0
5345     set i [reg_instance $fd]
5346     filerun $fd [list readdifffiles $fd $serial $i]
5347
5348     if {$isdiff && ![commitinview $nullid2 $curview]} {
5349         # add the line for the changes in the index to the graph
5350         set hl [mc "Local changes checked in to index but not committed"]
5351         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5352         set commitdata($nullid2) "\n    $hl\n"
5353         if {[commitinview $nullid $curview]} {
5354             removefakerow $nullid
5355         }
5356         insertfakerow $nullid2 $viewmainheadid($curview)
5357     } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5358         if {[commitinview $nullid $curview]} {
5359             removefakerow $nullid
5360         }
5361         removefakerow $nullid2
5362     }
5363     return 0
5364 }
5365
5366 proc readdifffiles {fd serial inst} {
5367     global viewmainheadid nullid nullid2 curview
5368     global commitinfo commitdata lserial
5369
5370     set isdiff 1
5371     if {[gets $fd line] < 0} {
5372         if {![eof $fd]} {
5373             return 1
5374         }
5375         set isdiff 0
5376     }
5377     # we only need to see one line and we don't really care what it says...
5378     stop_instance $inst
5379
5380     if {$serial != $lserial} {
5381         return 0
5382     }
5383
5384     if {$isdiff && ![commitinview $nullid $curview]} {
5385         # add the line for the local diff to the graph
5386         set hl [mc "Local uncommitted changes, not checked in to index"]
5387         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5388         set commitdata($nullid) "\n    $hl\n"
5389         if {[commitinview $nullid2 $curview]} {
5390             set p $nullid2
5391         } else {
5392             set p $viewmainheadid($curview)
5393         }
5394         insertfakerow $nullid $p
5395     } elseif {!$isdiff && [commitinview $nullid $curview]} {
5396         removefakerow $nullid
5397     }
5398     return 0
5399 }
5400
5401 proc nextuse {id row} {
5402     global curview children
5403
5404     if {[info exists children($curview,$id)]} {
5405         foreach kid $children($curview,$id) {
5406             if {![commitinview $kid $curview]} {
5407                 return -1
5408             }
5409             if {[rowofcommit $kid] > $row} {
5410                 return [rowofcommit $kid]
5411             }
5412         }
5413     }
5414     if {[commitinview $id $curview]} {
5415         return [rowofcommit $id]
5416     }
5417     return -1
5418 }
5419
5420 proc prevuse {id row} {
5421     global curview children
5422
5423     set ret -1
5424     if {[info exists children($curview,$id)]} {
5425         foreach kid $children($curview,$id) {
5426             if {![commitinview $kid $curview]} break
5427             if {[rowofcommit $kid] < $row} {
5428                 set ret [rowofcommit $kid]
5429             }
5430         }
5431     }
5432     return $ret
5433 }
5434
5435 proc make_idlist {row} {
5436     global displayorder parentlist uparrowlen downarrowlen mingaplen
5437     global commitidx curview children
5438
5439     set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5440     if {$r < 0} {
5441         set r 0
5442     }
5443     set ra [expr {$row - $downarrowlen}]
5444     if {$ra < 0} {
5445         set ra 0
5446     }
5447     set rb [expr {$row + $uparrowlen}]
5448     if {$rb > $commitidx($curview)} {
5449         set rb $commitidx($curview)
5450     }
5451     make_disporder $r [expr {$rb + 1}]
5452     set ids {}
5453     for {} {$r < $ra} {incr r} {
5454         set nextid [lindex $displayorder [expr {$r + 1}]]
5455         foreach p [lindex $parentlist $r] {
5456             if {$p eq $nextid} continue
5457             set rn [nextuse $p $r]
5458             if {$rn >= $row &&
5459                 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5460                 lappend ids [list [ordertoken $p] $p]
5461             }
5462         }
5463     }
5464     for {} {$r < $row} {incr r} {
5465         set nextid [lindex $displayorder [expr {$r + 1}]]
5466         foreach p [lindex $parentlist $r] {
5467             if {$p eq $nextid} continue
5468             set rn [nextuse $p $r]
5469             if {$rn < 0 || $rn >= $row} {
5470                 lappend ids [list [ordertoken $p] $p]
5471             }
5472         }
5473     }
5474     set id [lindex $displayorder $row]
5475     lappend ids [list [ordertoken $id] $id]
5476     while {$r < $rb} {
5477         foreach p [lindex $parentlist $r] {
5478             set firstkid [lindex $children($curview,$p) 0]
5479             if {[rowofcommit $firstkid] < $row} {
5480                 lappend ids [list [ordertoken $p] $p]
5481             }
5482         }
5483         incr r
5484         set id [lindex $displayorder $r]
5485         if {$id ne {}} {
5486             set firstkid [lindex $children($curview,$id) 0]
5487             if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5488                 lappend ids [list [ordertoken $id] $id]
5489             }
5490         }
5491     }
5492     set idlist {}
5493     foreach idx [lsort -unique $ids] {
5494         lappend idlist [lindex $idx 1]
5495     }
5496     return $idlist
5497 }
5498
5499 proc rowsequal {a b} {
5500     while {[set i [lsearch -exact $a {}]] >= 0} {
5501         set a [lreplace $a $i $i]
5502     }
5503     while {[set i [lsearch -exact $b {}]] >= 0} {
5504         set b [lreplace $b $i $i]
5505     }
5506     return [expr {$a eq $b}]
5507 }
5508
5509 proc makeupline {id row rend col} {
5510     global rowidlist uparrowlen downarrowlen mingaplen
5511
5512     for {set r $rend} {1} {set r $rstart} {
5513         set rstart [prevuse $id $r]
5514         if {$rstart < 0} return
5515         if {$rstart < $row} break
5516     }
5517     if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5518         set rstart [expr {$rend - $uparrowlen - 1}]
5519     }
5520     for {set r $rstart} {[incr r] <= $row} {} {
5521         set idlist [lindex $rowidlist $r]
5522         if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5523             set col [idcol $idlist $id $col]
5524             lset rowidlist $r [linsert $idlist $col $id]
5525             changedrow $r
5526         }
5527     }
5528 }
5529
5530 proc layoutrows {row endrow} {
5531     global rowidlist rowisopt rowfinal displayorder
5532     global uparrowlen downarrowlen maxwidth mingaplen
5533     global children parentlist
5534     global commitidx viewcomplete curview
5535
5536     make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5537     set idlist {}
5538     if {$row > 0} {
5539         set rm1 [expr {$row - 1}]
5540         foreach id [lindex $rowidlist $rm1] {
5541             if {$id ne {}} {
5542                 lappend idlist $id
5543             }
5544         }
5545         set final [lindex $rowfinal $rm1]
5546     }
5547     for {} {$row < $endrow} {incr row} {
5548         set rm1 [expr {$row - 1}]
5549         if {$rm1 < 0 || $idlist eq {}} {
5550             set idlist [make_idlist $row]
5551             set final 1
5552         } else {
5553             set id [lindex $displayorder $rm1]
5554             set col [lsearch -exact $idlist $id]
5555             set idlist [lreplace $idlist $col $col]
5556             foreach p [lindex $parentlist $rm1] {
5557                 if {[lsearch -exact $idlist $p] < 0} {
5558                     set col [idcol $idlist $p $col]
5559                     set idlist [linsert $idlist $col $p]
5560                     # if not the first child, we have to insert a line going up
5561                     if {$id ne [lindex $children($curview,$p) 0]} {
5562                         makeupline $p $rm1 $row $col
5563                     }
5564                 }
5565             }
5566             set id [lindex $displayorder $row]
5567             if {$row > $downarrowlen} {
5568                 set termrow [expr {$row - $downarrowlen - 1}]
5569                 foreach p [lindex $parentlist $termrow] {
5570                     set i [lsearch -exact $idlist $p]
5571                     if {$i < 0} continue
5572                     set nr [nextuse $p $termrow]
5573                     if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5574                         set idlist [lreplace $idlist $i $i]
5575                     }
5576                 }
5577             }
5578             set col [lsearch -exact $idlist $id]
5579             if {$col < 0} {
5580                 set col [idcol $idlist $id]
5581                 set idlist [linsert $idlist $col $id]
5582                 if {$children($curview,$id) ne {}} {
5583                     makeupline $id $rm1 $row $col
5584                 }
5585             }
5586             set r [expr {$row + $uparrowlen - 1}]
5587             if {$r < $commitidx($curview)} {
5588                 set x $col
5589                 foreach p [lindex $parentlist $r] {
5590                     if {[lsearch -exact $idlist $p] >= 0} continue
5591                     set fk [lindex $children($curview,$p) 0]
5592                     if {[rowofcommit $fk] < $row} {
5593                         set x [idcol $idlist $p $x]
5594                         set idlist [linsert $idlist $x $p]
5595                     }
5596                 }
5597                 if {[incr r] < $commitidx($curview)} {
5598                     set p [lindex $displayorder $r]
5599                     if {[lsearch -exact $idlist $p] < 0} {
5600                         set fk [lindex $children($curview,$p) 0]
5601                         if {$fk ne {} && [rowofcommit $fk] < $row} {
5602                             set x [idcol $idlist $p $x]
5603                             set idlist [linsert $idlist $x $p]
5604                         }
5605                     }
5606                 }
5607             }
5608         }
5609         if {$final && !$viewcomplete($curview) &&
5610             $row + $uparrowlen + $mingaplen + $downarrowlen
5611                 >= $commitidx($curview)} {
5612             set final 0
5613         }
5614         set l [llength $rowidlist]
5615         if {$row == $l} {
5616             lappend rowidlist $idlist
5617             lappend rowisopt 0
5618             lappend rowfinal $final
5619         } elseif {$row < $l} {
5620             if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5621                 lset rowidlist $row $idlist
5622                 changedrow $row
5623             }
5624             lset rowfinal $row $final
5625         } else {
5626             set pad [ntimes [expr {$row - $l}] {}]
5627             set rowidlist [concat $rowidlist $pad]
5628             lappend rowidlist $idlist
5629             set rowfinal [concat $rowfinal $pad]
5630             lappend rowfinal $final
5631             set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5632         }
5633     }
5634     return $row
5635 }
5636
5637 proc changedrow {row} {
5638     global displayorder iddrawn rowisopt need_redisplay
5639
5640     set l [llength $rowisopt]
5641     if {$row < $l} {
5642         lset rowisopt $row 0
5643         if {$row + 1 < $l} {
5644             lset rowisopt [expr {$row + 1}] 0
5645             if {$row + 2 < $l} {
5646                 lset rowisopt [expr {$row + 2}] 0
5647             }
5648         }
5649     }
5650     set id [lindex $displayorder $row]
5651     if {[info exists iddrawn($id)]} {
5652         set need_redisplay 1
5653     }
5654 }
5655
5656 proc insert_pad {row col npad} {
5657     global rowidlist
5658
5659     set pad [ntimes $npad {}]
5660     set idlist [lindex $rowidlist $row]
5661     set bef [lrange $idlist 0 [expr {$col - 1}]]
5662     set aft [lrange $idlist $col end]
5663     set i [lsearch -exact $aft {}]
5664     if {$i > 0} {
5665         set aft [lreplace $aft $i $i]
5666     }
5667     lset rowidlist $row [concat $bef $pad $aft]
5668     changedrow $row
5669 }
5670
5671 proc optimize_rows {row col endrow} {
5672     global rowidlist rowisopt displayorder curview children
5673
5674     if {$row < 1} {
5675         set row 1
5676     }
5677     for {} {$row < $endrow} {incr row; set col 0} {
5678         if {[lindex $rowisopt $row]} continue
5679         set haspad 0
5680         set y0 [expr {$row - 1}]
5681         set ym [expr {$row - 2}]
5682         set idlist [lindex $rowidlist $row]
5683         set previdlist [lindex $rowidlist $y0]
5684         if {$idlist eq {} || $previdlist eq {}} continue
5685         if {$ym >= 0} {
5686             set pprevidlist [lindex $rowidlist $ym]
5687             if {$pprevidlist eq {}} continue
5688         } else {
5689             set pprevidlist {}
5690         }
5691         set x0 -1
5692         set xm -1
5693         for {} {$col < [llength $idlist]} {incr col} {
5694             set id [lindex $idlist $col]
5695             if {[lindex $previdlist $col] eq $id} continue
5696             if {$id eq {}} {
5697                 set haspad 1
5698                 continue
5699             }
5700             set x0 [lsearch -exact $previdlist $id]
5701             if {$x0 < 0} continue
5702             set z [expr {$x0 - $col}]
5703             set isarrow 0
5704             set z0 {}
5705             if {$ym >= 0} {
5706                 set xm [lsearch -exact $pprevidlist $id]
5707                 if {$xm >= 0} {
5708                     set z0 [expr {$xm - $x0}]
5709                 }
5710             }
5711             if {$z0 eq {}} {
5712                 # if row y0 is the first child of $id then it's not an arrow
5713                 if {[lindex $children($curview,$id) 0] ne
5714                     [lindex $displayorder $y0]} {
5715                     set isarrow 1
5716                 }
5717             }
5718             if {!$isarrow && $id ne [lindex $displayorder $row] &&
5719                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5720                 set isarrow 1
5721             }
5722             # Looking at lines from this row to the previous row,
5723             # make them go straight up if they end in an arrow on
5724             # the previous row; otherwise make them go straight up
5725             # or at 45 degrees.
5726             if {$z < -1 || ($z < 0 && $isarrow)} {
5727                 # Line currently goes left too much;
5728                 # insert pads in the previous row, then optimize it
5729                 set npad [expr {-1 - $z + $isarrow}]
5730                 insert_pad $y0 $x0 $npad
5731                 if {$y0 > 0} {
5732                     optimize_rows $y0 $x0 $row
5733                 }
5734                 set previdlist [lindex $rowidlist $y0]
5735                 set x0 [lsearch -exact $previdlist $id]
5736                 set z [expr {$x0 - $col}]
5737                 if {$z0 ne {}} {
5738                     set pprevidlist [lindex $rowidlist $ym]
5739                     set xm [lsearch -exact $pprevidlist $id]
5740                     set z0 [expr {$xm - $x0}]
5741                 }
5742             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5743                 # Line currently goes right too much;
5744                 # insert pads in this line
5745                 set npad [expr {$z - 1 + $isarrow}]
5746                 insert_pad $row $col $npad
5747                 set idlist [lindex $rowidlist $row]
5748                 incr col $npad
5749                 set z [expr {$x0 - $col}]
5750                 set haspad 1
5751             }
5752             if {$z0 eq {} && !$isarrow && $ym >= 0} {
5753                 # this line links to its first child on row $row-2
5754                 set id [lindex $displayorder $ym]
5755                 set xc [lsearch -exact $pprevidlist $id]
5756                 if {$xc >= 0} {
5757                     set z0 [expr {$xc - $x0}]
5758                 }
5759             }
5760             # avoid lines jigging left then immediately right
5761             if {$z0 ne {} && $z < 0 && $z0 > 0} {
5762                 insert_pad $y0 $x0 1
5763                 incr x0
5764                 optimize_rows $y0 $x0 $row
5765                 set previdlist [lindex $rowidlist $y0]
5766             }
5767         }
5768         if {!$haspad} {
5769             # Find the first column that doesn't have a line going right
5770             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5771                 set id [lindex $idlist $col]
5772                 if {$id eq {}} break
5773                 set x0 [lsearch -exact $previdlist $id]
5774                 if {$x0 < 0} {
5775                     # check if this is the link to the first child
5776                     set kid [lindex $displayorder $y0]
5777                     if {[lindex $children($curview,$id) 0] eq $kid} {
5778                         # it is, work out offset to child
5779                         set x0 [lsearch -exact $previdlist $kid]
5780                     }
5781                 }
5782                 if {$x0 <= $col} break
5783             }
5784             # Insert a pad at that column as long as it has a line and
5785             # isn't the last column
5786             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5787                 set idlist [linsert $idlist $col {}]
5788                 lset rowidlist $row $idlist
5789                 changedrow $row
5790             }
5791         }
5792     }
5793 }
5794
5795 proc xc {row col} {
5796     global canvx0 linespc
5797     return [expr {$canvx0 + $col * $linespc}]
5798 }
5799
5800 proc yc {row} {
5801     global canvy0 linespc
5802     return [expr {$canvy0 + $row * $linespc}]
5803 }
5804
5805 proc linewidth {id} {
5806     global thickerline lthickness
5807
5808     set wid $lthickness
5809     if {[info exists thickerline] && $id eq $thickerline} {
5810         set wid [expr {2 * $lthickness}]
5811     }
5812     return $wid
5813 }
5814
5815 proc rowranges {id} {
5816     global curview children uparrowlen downarrowlen
5817     global rowidlist
5818
5819     set kids $children($curview,$id)
5820     if {$kids eq {}} {
5821         return {}
5822     }
5823     set ret {}
5824     lappend kids $id
5825     foreach child $kids {
5826         if {![commitinview $child $curview]} break
5827         set row [rowofcommit $child]
5828         if {![info exists prev]} {
5829             lappend ret [expr {$row + 1}]
5830         } else {
5831             if {$row <= $prevrow} {
5832                 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5833             }
5834             # see if the line extends the whole way from prevrow to row
5835             if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5836                 [lsearch -exact [lindex $rowidlist \
5837                             [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5838                 # it doesn't, see where it ends
5839                 set r [expr {$prevrow + $downarrowlen}]
5840                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5841                     while {[incr r -1] > $prevrow &&
5842                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5843                 } else {
5844                     while {[incr r] <= $row &&
5845                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5846                     incr r -1
5847                 }
5848                 lappend ret $r
5849                 # see where it starts up again
5850                 set r [expr {$row - $uparrowlen}]
5851                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5852                     while {[incr r] < $row &&
5853                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5854                 } else {
5855                     while {[incr r -1] >= $prevrow &&
5856                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5857                     incr r
5858                 }
5859                 lappend ret $r
5860             }
5861         }
5862         if {$child eq $id} {
5863             lappend ret $row
5864         }
5865         set prev $child
5866         set prevrow $row
5867     }
5868     return $ret
5869 }
5870
5871 proc drawlineseg {id row endrow arrowlow} {
5872     global rowidlist displayorder iddrawn linesegs
5873     global canv colormap linespc curview maxlinelen parentlist
5874
5875     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5876     set le [expr {$row + 1}]
5877     set arrowhigh 1
5878     while {1} {
5879         set c [lsearch -exact [lindex $rowidlist $le] $id]
5880         if {$c < 0} {
5881             incr le -1
5882             break
5883         }
5884         lappend cols $c
5885         set x [lindex $displayorder $le]
5886         if {$x eq $id} {
5887             set arrowhigh 0
5888             break
5889         }
5890         if {[info exists iddrawn($x)] || $le == $endrow} {
5891             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5892             if {$c >= 0} {
5893                 lappend cols $c
5894                 set arrowhigh 0
5895             }
5896             break
5897         }
5898         incr le
5899     }
5900     if {$le <= $row} {
5901         return $row
5902     }
5903
5904     set lines {}
5905     set i 0
5906     set joinhigh 0
5907     if {[info exists linesegs($id)]} {
5908         set lines $linesegs($id)
5909         foreach li $lines {
5910             set r0 [lindex $li 0]
5911             if {$r0 > $row} {
5912                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5913                     set joinhigh 1
5914                 }
5915                 break
5916             }
5917             incr i
5918         }
5919     }
5920     set joinlow 0
5921     if {$i > 0} {
5922         set li [lindex $lines [expr {$i-1}]]
5923         set r1 [lindex $li 1]
5924         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5925             set joinlow 1
5926         }
5927     }
5928
5929     set x [lindex $cols [expr {$le - $row}]]
5930     set xp [lindex $cols [expr {$le - 1 - $row}]]
5931     set dir [expr {$xp - $x}]
5932     if {$joinhigh} {
5933         set ith [lindex $lines $i 2]
5934         set coords [$canv coords $ith]
5935         set ah [$canv itemcget $ith -arrow]
5936         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5937         set x2 [lindex $cols [expr {$le + 1 - $row}]]
5938         if {$x2 ne {} && $x - $x2 == $dir} {
5939             set coords [lrange $coords 0 end-2]
5940         }
5941     } else {
5942         set coords [list [xc $le $x] [yc $le]]
5943     }
5944     if {$joinlow} {
5945         set itl [lindex $lines [expr {$i-1}] 2]
5946         set al [$canv itemcget $itl -arrow]
5947         set arrowlow [expr {$al eq "last" || $al eq "both"}]
5948     } elseif {$arrowlow} {
5949         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5950             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5951             set arrowlow 0
5952         }
5953     }
5954     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5955     for {set y $le} {[incr y -1] > $row} {} {
5956         set x $xp
5957         set xp [lindex $cols [expr {$y - 1 - $row}]]
5958         set ndir [expr {$xp - $x}]
5959         if {$dir != $ndir || $xp < 0} {
5960             lappend coords [xc $y $x] [yc $y]
5961         }
5962         set dir $ndir
5963     }
5964     if {!$joinlow} {
5965         if {$xp < 0} {
5966             # join parent line to first child
5967             set ch [lindex $displayorder $row]
5968             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5969             if {$xc < 0} {
5970                 puts "oops: drawlineseg: child $ch not on row $row"
5971             } elseif {$xc != $x} {
5972                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5973                     set d [expr {int(0.5 * $linespc)}]
5974                     set x1 [xc $row $x]
5975                     if {$xc < $x} {
5976                         set x2 [expr {$x1 - $d}]
5977                     } else {
5978                         set x2 [expr {$x1 + $d}]
5979                     }
5980                     set y2 [yc $row]
5981                     set y1 [expr {$y2 + $d}]
5982                     lappend coords $x1 $y1 $x2 $y2
5983                 } elseif {$xc < $x - 1} {
5984                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
5985                 } elseif {$xc > $x + 1} {
5986                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
5987                 }
5988                 set x $xc
5989             }
5990             lappend coords [xc $row $x] [yc $row]
5991         } else {
5992             set xn [xc $row $xp]
5993             set yn [yc $row]
5994             lappend coords $xn $yn
5995         }
5996         if {!$joinhigh} {
5997             assigncolor $id
5998             set t [$canv create line $coords -width [linewidth $id] \
5999                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
6000             $canv lower $t
6001             bindline $t $id
6002             set lines [linsert $lines $i [list $row $le $t]]
6003         } else {
6004             $canv coords $ith $coords
6005             if {$arrow ne $ah} {
6006                 $canv itemconf $ith -arrow $arrow
6007             }
6008             lset lines $i 0 $row
6009         }
6010     } else {
6011         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
6012         set ndir [expr {$xo - $xp}]
6013         set clow [$canv coords $itl]
6014         if {$dir == $ndir} {
6015             set clow [lrange $clow 2 end]
6016         }
6017         set coords [concat $coords $clow]
6018         if {!$joinhigh} {
6019             lset lines [expr {$i-1}] 1 $le
6020         } else {
6021             # coalesce two pieces
6022             $canv delete $ith
6023             set b [lindex $lines [expr {$i-1}] 0]
6024             set e [lindex $lines $i 1]
6025             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
6026         }
6027         $canv coords $itl $coords
6028         if {$arrow ne $al} {
6029             $canv itemconf $itl -arrow $arrow
6030         }
6031     }
6032
6033     set linesegs($id) $lines
6034     return $le
6035 }
6036
6037 proc drawparentlinks {id row} {
6038     global rowidlist canv colormap curview parentlist
6039     global idpos linespc
6040
6041     set rowids [lindex $rowidlist $row]
6042     set col [lsearch -exact $rowids $id]
6043     if {$col < 0} return
6044     set olds [lindex $parentlist $row]
6045     set row2 [expr {$row + 1}]
6046     set x [xc $row $col]
6047     set y [yc $row]
6048     set y2 [yc $row2]
6049     set d [expr {int(0.5 * $linespc)}]
6050     set ymid [expr {$y + $d}]
6051     set ids [lindex $rowidlist $row2]
6052     # rmx = right-most X coord used
6053     set rmx 0
6054     foreach p $olds {
6055         set i [lsearch -exact $ids $p]
6056         if {$i < 0} {
6057             puts "oops, parent $p of $id not in list"
6058             continue
6059         }
6060         set x2 [xc $row2 $i]
6061         if {$x2 > $rmx} {
6062             set rmx $x2
6063         }
6064         set j [lsearch -exact $rowids $p]
6065         if {$j < 0} {
6066             # drawlineseg will do this one for us
6067             continue
6068         }
6069         assigncolor $p
6070         # should handle duplicated parents here...
6071         set coords [list $x $y]
6072         if {$i != $col} {
6073             # if attaching to a vertical segment, draw a smaller
6074             # slant for visual distinctness
6075             if {$i == $j} {
6076                 if {$i < $col} {
6077                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
6078                 } else {
6079                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
6080                 }
6081             } elseif {$i < $col && $i < $j} {
6082                 # segment slants towards us already
6083                 lappend coords [xc $row $j] $y
6084             } else {
6085                 if {$i < $col - 1} {
6086                     lappend coords [expr {$x2 + $linespc}] $y
6087                 } elseif {$i > $col + 1} {
6088                     lappend coords [expr {$x2 - $linespc}] $y
6089                 }
6090                 lappend coords $x2 $y2
6091             }
6092         } else {
6093             lappend coords $x2 $y2
6094         }
6095         set t [$canv create line $coords -width [linewidth $p] \
6096                    -fill $colormap($p) -tags lines.$p]
6097         $canv lower $t
6098         bindline $t $p
6099     }
6100     if {$rmx > [lindex $idpos($id) 1]} {
6101         lset idpos($id) 1 $rmx
6102         redrawtags $id
6103     }
6104 }
6105
6106 proc drawlines {id} {
6107     global canv
6108
6109     $canv itemconf lines.$id -width [linewidth $id]
6110 }
6111
6112 proc drawcmittext {id row col} {
6113     global linespc canv canv2 canv3 fgcolor curview
6114     global cmitlisted commitinfo rowidlist parentlist
6115     global rowtextx idpos idtags idheads idotherrefs
6116     global linehtag linentag linedtag selectedline
6117     global canvxmax boldids boldnameids fgcolor markedid
6118     global mainheadid nullid nullid2 circleitem circlecolors ctxbut
6119     global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
6120     global circleoutlinecolor
6121
6122     # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
6123     set listed $cmitlisted($curview,$id)
6124     if {$id eq $nullid} {
6125         set ofill $workingfilescirclecolor
6126     } elseif {$id eq $nullid2} {
6127         set ofill $indexcirclecolor
6128     } elseif {$id eq $mainheadid} {
6129         set ofill $mainheadcirclecolor
6130     } else {
6131         set ofill [lindex $circlecolors $listed]
6132     }
6133     set x [xc $row $col]
6134     set y [yc $row]
6135     set orad [expr {$linespc / 3}]
6136     if {$listed <= 2} {
6137         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6138                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6139                    -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6140     } elseif {$listed == 3} {
6141         # triangle pointing left for left-side commits
6142         set t [$canv create polygon \
6143                    [expr {$x - $orad}] $y \
6144                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6145                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6146                    -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6147     } else {
6148         # triangle pointing right for right-side commits
6149         set t [$canv create polygon \
6150                    [expr {$x + $orad - 1}] $y \
6151                    [expr {$x - $orad}] [expr {$y - $orad}] \
6152                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6153                    -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6154     }
6155     set circleitem($row) $t
6156     $canv raise $t
6157     $canv bind $t <1> {selcanvline {} %x %y}
6158     set rmx [llength [lindex $rowidlist $row]]
6159     set olds [lindex $parentlist $row]
6160     if {$olds ne {}} {
6161         set nextids [lindex $rowidlist [expr {$row + 1}]]
6162         foreach p $olds {
6163             set i [lsearch -exact $nextids $p]
6164             if {$i > $rmx} {
6165                 set rmx $i
6166             }
6167         }
6168     }
6169     set xt [xc $row $rmx]
6170     set rowtextx($row) $xt
6171     set idpos($id) [list $x $xt $y]
6172     if {[info exists idtags($id)] || [info exists idheads($id)]
6173         || [info exists idotherrefs($id)]} {
6174         set xt [drawtags $id $x $xt $y]
6175     }
6176     if {[lindex $commitinfo($id) 6] > 0} {
6177         set xt [drawnotesign $xt $y]
6178     }
6179     set headline [lindex $commitinfo($id) 0]
6180     set name [lindex $commitinfo($id) 1]
6181     set date [lindex $commitinfo($id) 2]
6182     set date [formatdate $date]
6183     set font mainfont
6184     set nfont mainfont
6185     set isbold [ishighlighted $id]
6186     if {$isbold > 0} {
6187         lappend boldids $id
6188         set font mainfontbold
6189         if {$isbold > 1} {
6190             lappend boldnameids $id
6191             set nfont mainfontbold
6192         }
6193     }
6194     set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6195                            -text $headline -font $font -tags text]
6196     $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6197     set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6198                            -text $name -font $nfont -tags text]
6199     set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6200                            -text $date -font mainfont -tags text]
6201     if {$selectedline == $row} {
6202         make_secsel $id
6203     }
6204     if {[info exists markedid] && $markedid eq $id} {
6205         make_idmark $id
6206     }
6207     set xr [expr {$xt + [font measure $font $headline]}]
6208     if {$xr > $canvxmax} {
6209         set canvxmax $xr
6210         setcanvscroll
6211     }
6212 }
6213
6214 proc drawcmitrow {row} {
6215     global displayorder rowidlist nrows_drawn
6216     global iddrawn markingmatches
6217     global commitinfo numcommits
6218     global filehighlight fhighlights findpattern nhighlights
6219     global hlview vhighlights
6220     global highlight_related rhighlights
6221
6222     if {$row >= $numcommits} return
6223
6224     set id [lindex $displayorder $row]
6225     if {[info exists hlview] && ![info exists vhighlights($id)]} {
6226         askvhighlight $row $id
6227     }
6228     if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
6229         askfilehighlight $row $id
6230     }
6231     if {$findpattern ne {} && ![info exists nhighlights($id)]} {
6232         askfindhighlight $row $id
6233     }
6234     if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
6235         askrelhighlight $row $id
6236     }
6237     if {![info exists iddrawn($id)]} {
6238         set col [lsearch -exact [lindex $rowidlist $row] $id]
6239         if {$col < 0} {
6240             puts "oops, row $row id $id not in list"
6241             return
6242         }
6243         if {![info exists commitinfo($id)]} {
6244             getcommit $id
6245         }
6246         assigncolor $id
6247         drawcmittext $id $row $col
6248         set iddrawn($id) 1
6249         incr nrows_drawn
6250     }
6251     if {$markingmatches} {
6252         markrowmatches $row $id
6253     }
6254 }
6255
6256 proc drawcommits {row {endrow {}}} {
6257     global numcommits iddrawn displayorder curview need_redisplay
6258     global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6259
6260     if {$row < 0} {
6261         set row 0
6262     }
6263     if {$endrow eq {}} {
6264         set endrow $row
6265     }
6266     if {$endrow >= $numcommits} {
6267         set endrow [expr {$numcommits - 1}]
6268     }
6269
6270     set rl1 [expr {$row - $downarrowlen - 3}]
6271     if {$rl1 < 0} {
6272         set rl1 0
6273     }
6274     set ro1 [expr {$row - 3}]
6275     if {$ro1 < 0} {
6276         set ro1 0
6277     }
6278     set r2 [expr {$endrow + $uparrowlen + 3}]
6279     if {$r2 > $numcommits} {
6280         set r2 $numcommits
6281     }
6282     for {set r $rl1} {$r < $r2} {incr r} {
6283         if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6284             if {$rl1 < $r} {
6285                 layoutrows $rl1 $r
6286             }
6287             set rl1 [expr {$r + 1}]
6288         }
6289     }
6290     if {$rl1 < $r} {
6291         layoutrows $rl1 $r
6292     }
6293     optimize_rows $ro1 0 $r2
6294     if {$need_redisplay || $nrows_drawn > 2000} {
6295         clear_display
6296     }
6297
6298     # make the lines join to already-drawn rows either side
6299     set r [expr {$row - 1}]
6300     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6301         set r $row
6302     }
6303     set er [expr {$endrow + 1}]
6304     if {$er >= $numcommits ||
6305         ![info exists iddrawn([lindex $displayorder $er])]} {
6306         set er $endrow
6307     }
6308     for {} {$r <= $er} {incr r} {
6309         set id [lindex $displayorder $r]
6310         set wasdrawn [info exists iddrawn($id)]
6311         drawcmitrow $r
6312         if {$r == $er} break
6313         set nextid [lindex $displayorder [expr {$r + 1}]]
6314         if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6315         drawparentlinks $id $r
6316
6317         set rowids [lindex $rowidlist $r]
6318         foreach lid $rowids {
6319             if {$lid eq {}} continue
6320             if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6321             if {$lid eq $id} {
6322                 # see if this is the first child of any of its parents
6323                 foreach p [lindex $parentlist $r] {
6324                     if {[lsearch -exact $rowids $p] < 0} {
6325                         # make this line extend up to the child
6326                         set lineend($p) [drawlineseg $p $r $er 0]
6327                     }
6328                 }
6329             } else {
6330                 set lineend($lid) [drawlineseg $lid $r $er 1]
6331             }
6332         }
6333     }
6334 }
6335
6336 proc undolayout {row} {
6337     global uparrowlen mingaplen downarrowlen
6338     global rowidlist rowisopt rowfinal need_redisplay
6339
6340     set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6341     if {$r < 0} {
6342         set r 0
6343     }
6344     if {[llength $rowidlist] > $r} {
6345         incr r -1
6346         set rowidlist [lrange $rowidlist 0 $r]
6347         set rowfinal [lrange $rowfinal 0 $r]
6348         set rowisopt [lrange $rowisopt 0 $r]
6349         set need_redisplay 1
6350         run drawvisible
6351     }
6352 }
6353
6354 proc drawvisible {} {
6355     global canv linespc curview vrowmod selectedline targetrow targetid
6356     global need_redisplay cscroll numcommits
6357
6358     set fs [$canv yview]
6359     set ymax [lindex [$canv cget -scrollregion] 3]
6360     if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6361     set f0 [lindex $fs 0]
6362     set f1 [lindex $fs 1]
6363     set y0 [expr {int($f0 * $ymax)}]
6364     set y1 [expr {int($f1 * $ymax)}]
6365
6366     if {[info exists targetid]} {
6367         if {[commitinview $targetid $curview]} {
6368             set r [rowofcommit $targetid]
6369             if {$r != $targetrow} {
6370                 # Fix up the scrollregion and change the scrolling position
6371                 # now that our target row has moved.
6372                 set diff [expr {($r - $targetrow) * $linespc}]
6373                 set targetrow $r
6374                 setcanvscroll
6375                 set ymax [lindex [$canv cget -scrollregion] 3]
6376                 incr y0 $diff
6377                 incr y1 $diff
6378                 set f0 [expr {$y0 / $ymax}]
6379                 set f1 [expr {$y1 / $ymax}]
6380                 allcanvs yview moveto $f0
6381                 $cscroll set $f0 $f1
6382                 set need_redisplay 1
6383             }
6384         } else {
6385             unset targetid
6386         }
6387     }
6388
6389     set row [expr {int(($y0 - 3) / $linespc) - 1}]
6390     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6391     if {$endrow >= $vrowmod($curview)} {
6392         update_arcrows $curview
6393     }
6394     if {$selectedline ne {} &&
6395         $row <= $selectedline && $selectedline <= $endrow} {
6396         set targetrow $selectedline
6397     } elseif {[info exists targetid]} {
6398         set targetrow [expr {int(($row + $endrow) / 2)}]
6399     }
6400     if {[info exists targetrow]} {
6401         if {$targetrow >= $numcommits} {
6402             set targetrow [expr {$numcommits - 1}]
6403         }
6404         set targetid [commitonrow $targetrow]
6405     }
6406     drawcommits $row $endrow
6407 }
6408
6409 proc clear_display {} {
6410     global iddrawn linesegs need_redisplay nrows_drawn
6411     global vhighlights fhighlights nhighlights rhighlights
6412     global linehtag linentag linedtag boldids boldnameids
6413
6414     allcanvs delete all
6415     unset -nocomplain iddrawn
6416     unset -nocomplain linesegs
6417     unset -nocomplain linehtag
6418     unset -nocomplain linentag
6419     unset -nocomplain linedtag
6420     set boldids {}
6421     set boldnameids {}
6422     unset -nocomplain vhighlights
6423     unset -nocomplain fhighlights
6424     unset -nocomplain nhighlights
6425     unset -nocomplain rhighlights
6426     set need_redisplay 0
6427     set nrows_drawn 0
6428 }
6429
6430 proc findcrossings {id} {
6431     global rowidlist parentlist numcommits displayorder
6432
6433     set cross {}
6434     set ccross {}
6435     foreach {s e} [rowranges $id] {
6436         if {$e >= $numcommits} {
6437             set e [expr {$numcommits - 1}]
6438         }
6439         if {$e <= $s} continue
6440         for {set row $e} {[incr row -1] >= $s} {} {
6441             set x [lsearch -exact [lindex $rowidlist $row] $id]
6442             if {$x < 0} break
6443             set olds [lindex $parentlist $row]
6444             set kid [lindex $displayorder $row]
6445             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6446             if {$kidx < 0} continue
6447             set nextrow [lindex $rowidlist [expr {$row + 1}]]
6448             foreach p $olds {
6449                 set px [lsearch -exact $nextrow $p]
6450                 if {$px < 0} continue
6451                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6452                     if {[lsearch -exact $ccross $p] >= 0} continue
6453                     if {$x == $px + ($kidx < $px? -1: 1)} {
6454                         lappend ccross $p
6455                     } elseif {[lsearch -exact $cross $p] < 0} {
6456                         lappend cross $p
6457                     }
6458                 }
6459             }
6460         }
6461     }
6462     return [concat $ccross {{}} $cross]
6463 }
6464
6465 proc assigncolor {id} {
6466     global colormap colors nextcolor
6467     global parents children children curview
6468
6469     if {[info exists colormap($id)]} return
6470     set ncolors [llength $colors]
6471     if {[info exists children($curview,$id)]} {
6472         set kids $children($curview,$id)
6473     } else {
6474         set kids {}
6475     }
6476     if {[llength $kids] == 1} {
6477         set child [lindex $kids 0]
6478         if {[info exists colormap($child)]
6479             && [llength $parents($curview,$child)] == 1} {
6480             set colormap($id) $colormap($child)
6481             return
6482         }
6483     }
6484     set badcolors {}
6485     set origbad {}
6486     foreach x [findcrossings $id] {
6487         if {$x eq {}} {
6488             # delimiter between corner crossings and other crossings
6489             if {[llength $badcolors] >= $ncolors - 1} break
6490             set origbad $badcolors
6491         }
6492         if {[info exists colormap($x)]
6493             && [lsearch -exact $badcolors $colormap($x)] < 0} {
6494             lappend badcolors $colormap($x)
6495         }
6496     }
6497     if {[llength $badcolors] >= $ncolors} {
6498         set badcolors $origbad
6499     }
6500     set origbad $badcolors
6501     if {[llength $badcolors] < $ncolors - 1} {
6502         foreach child $kids {
6503             if {[info exists colormap($child)]
6504                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6505                 lappend badcolors $colormap($child)
6506             }
6507             foreach p $parents($curview,$child) {
6508                 if {[info exists colormap($p)]
6509                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
6510                     lappend badcolors $colormap($p)
6511                 }
6512             }
6513         }
6514         if {[llength $badcolors] >= $ncolors} {
6515             set badcolors $origbad
6516         }
6517     }
6518     for {set i 0} {$i <= $ncolors} {incr i} {
6519         set c [lindex $colors $nextcolor]
6520         if {[incr nextcolor] >= $ncolors} {
6521             set nextcolor 0
6522         }
6523         if {[lsearch -exact $badcolors $c]} break
6524     }
6525     set colormap($id) $c
6526 }
6527
6528 proc bindline {t id} {
6529     global canv
6530
6531     $canv bind $t <Enter> "lineenter %x %y $id"
6532     $canv bind $t <Motion> "linemotion %x %y $id"
6533     $canv bind $t <Leave> "lineleave $id"
6534     $canv bind $t <Button-1> "lineclick %x %y $id 1"
6535 }
6536
6537 proc graph_pane_width {} {
6538     global use_ttk
6539
6540     if {$use_ttk} {
6541         set g [.tf.histframe.pwclist sashpos 0]
6542     } else {
6543         set g [.tf.histframe.pwclist sash coord 0]
6544     }
6545     return [lindex $g 0]
6546 }
6547
6548 proc totalwidth {l font extra} {
6549     set tot 0
6550     foreach str $l {
6551         set tot [expr {$tot + [font measure $font $str] + $extra}]
6552     }
6553     return $tot
6554 }
6555
6556 proc drawtags {id x xt y1} {
6557     global idtags idheads idotherrefs mainhead
6558     global linespc lthickness
6559     global canv rowtextx curview fgcolor bgcolor ctxbut
6560     global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6561     global tagbgcolor tagfgcolor tagoutlinecolor
6562     global reflinecolor
6563
6564     set marks {}
6565     set ntags 0
6566     set nheads 0
6567     set singletag 0
6568     set maxtags 3
6569     set maxtagpct 25
6570     set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6571     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6572     set extra [expr {$delta + $lthickness + $linespc}]
6573
6574     if {[info exists idtags($id)]} {
6575         set marks $idtags($id)
6576         set ntags [llength $marks]
6577         if {$ntags > $maxtags ||
6578             [totalwidth $marks mainfont $extra] > $maxwidth} {
6579             # show just a single "n tags..." tag
6580             set singletag 1
6581             if {$ntags == 1} {
6582                 set marks [list "tag..."]
6583             } else {
6584                 set marks [list [format "%d tags..." $ntags]]
6585             }
6586             set ntags 1
6587         }
6588     }
6589     if {[info exists idheads($id)]} {
6590         set marks [concat $marks $idheads($id)]
6591         set nheads [llength $idheads($id)]
6592     }
6593     if {[info exists idotherrefs($id)]} {
6594         set marks [concat $marks $idotherrefs($id)]
6595     }
6596     if {$marks eq {}} {
6597         return $xt
6598     }
6599
6600     set yt [expr {$y1 - 0.5 * $linespc}]
6601     set yb [expr {$yt + $linespc - 1}]
6602     set xvals {}
6603     set wvals {}
6604     set i -1
6605     foreach tag $marks {
6606         incr i
6607         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6608             set wid [font measure mainfontbold $tag]
6609         } else {
6610             set wid [font measure mainfont $tag]
6611         }
6612         lappend xvals $xt
6613         lappend wvals $wid
6614         set xt [expr {$xt + $wid + $extra}]
6615     }
6616     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6617                -width $lthickness -fill $reflinecolor -tags tag.$id]
6618     $canv lower $t
6619     foreach tag $marks x $xvals wid $wvals {
6620         set tag_quoted [string map {% %%} $tag]
6621         set xl [expr {$x + $delta}]
6622         set xr [expr {$x + $delta + $wid + $lthickness}]
6623         set font mainfont
6624         if {[incr ntags -1] >= 0} {
6625             # draw a tag
6626             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6627                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6628                        -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6629                        -tags tag.$id]
6630             if {$singletag} {
6631                 set tagclick [list showtags $id 1]
6632             } else {
6633                 set tagclick [list showtag $tag_quoted 1]
6634             }
6635             $canv bind $t <1> $tagclick
6636             set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6637         } else {
6638             # draw a head or other ref
6639             if {[incr nheads -1] >= 0} {
6640                 set col $headbgcolor
6641                 if {$tag eq $mainhead} {
6642                     set font mainfontbold
6643                 }
6644             } else {
6645                 set col "#ddddff"
6646             }
6647             set xl [expr {$xl - $delta/2}]
6648             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6649                 -width 1 -outline black -fill $col -tags tag.$id
6650             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6651                 set rwid [font measure mainfont $remoteprefix]
6652                 set xi [expr {$x + 1}]
6653                 set yti [expr {$yt + 1}]
6654                 set xri [expr {$x + $rwid}]
6655                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6656                         -width 0 -fill $remotebgcolor -tags tag.$id
6657             }
6658         }
6659         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6660                    -font $font -tags [list tag.$id text]]
6661         if {$ntags >= 0} {
6662             $canv bind $t <1> $tagclick
6663         } elseif {$nheads >= 0} {
6664             $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6665         }
6666     }
6667     return $xt
6668 }
6669
6670 proc drawnotesign {xt y} {
6671     global linespc canv fgcolor
6672
6673     set orad [expr {$linespc / 3}]
6674     set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6675                [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6676                -fill yellow -outline $fgcolor -width 1 -tags circle]
6677     set xt [expr {$xt + $orad * 3}]
6678     return $xt
6679 }
6680
6681 proc xcoord {i level ln} {
6682     global canvx0 xspc1 xspc2
6683
6684     set x [expr {$canvx0 + $i * $xspc1($ln)}]
6685     if {$i > 0 && $i == $level} {
6686         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6687     } elseif {$i > $level} {
6688         set x [expr {$x + $xspc2 - $xspc1($ln)}]
6689     }
6690     return $x
6691 }
6692
6693 proc show_status {msg} {
6694     global canv fgcolor
6695
6696     clear_display
6697     set_window_title
6698     $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6699         -tags text -fill $fgcolor
6700 }
6701
6702 # Don't change the text pane cursor if it is currently the hand cursor,
6703 # showing that we are over a sha1 ID link.
6704 proc settextcursor {c} {
6705     global ctext curtextcursor
6706
6707     if {[$ctext cget -cursor] == $curtextcursor} {
6708         $ctext config -cursor $c
6709     }
6710     set curtextcursor $c
6711 }
6712
6713 proc nowbusy {what {name {}}} {
6714     global isbusy busyname statusw
6715
6716     if {[array names isbusy] eq {}} {
6717         . config -cursor watch
6718         settextcursor watch
6719     }
6720     set isbusy($what) 1
6721     set busyname($what) $name
6722     if {$name ne {}} {
6723         $statusw conf -text $name
6724     }
6725 }
6726
6727 proc notbusy {what} {
6728     global isbusy maincursor textcursor busyname statusw
6729
6730     catch {
6731         unset isbusy($what)
6732         if {$busyname($what) ne {} &&
6733             [$statusw cget -text] eq $busyname($what)} {
6734             $statusw conf -text {}
6735         }
6736     }
6737     if {[array names isbusy] eq {}} {
6738         . config -cursor $maincursor
6739         settextcursor $textcursor
6740     }
6741 }
6742
6743 proc findmatches {f} {
6744     global findtype findstring
6745     if {$findtype == [mc "Regexp"]} {
6746         set matches [regexp -indices -all -inline $findstring $f]
6747     } else {
6748         set fs $findstring
6749         if {$findtype == [mc "IgnCase"]} {
6750             set f [string tolower $f]
6751             set fs [string tolower $fs]
6752         }
6753         set matches {}
6754         set i 0
6755         set l [string length $fs]
6756         while {[set j [string first $fs $f $i]] >= 0} {
6757             lappend matches [list $j [expr {$j+$l-1}]]
6758             set i [expr {$j + $l}]
6759         }
6760     }
6761     return $matches
6762 }
6763
6764 proc dofind {{dirn 1} {wrap 1}} {
6765     global findstring findstartline findcurline selectedline numcommits
6766     global gdttype filehighlight fh_serial find_dirn findallowwrap
6767
6768     if {[info exists find_dirn]} {
6769         if {$find_dirn == $dirn} return
6770         stopfinding
6771     }
6772     focus .
6773     if {$findstring eq {} || $numcommits == 0} return
6774     if {$selectedline eq {}} {
6775         set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6776     } else {
6777         set findstartline $selectedline
6778     }
6779     set findcurline $findstartline
6780     nowbusy finding [mc "Searching"]
6781     if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6782         after cancel do_file_hl $fh_serial
6783         do_file_hl $fh_serial
6784     }
6785     set find_dirn $dirn
6786     set findallowwrap $wrap
6787     run findmore
6788 }
6789
6790 proc stopfinding {} {
6791     global find_dirn findcurline fprogcoord
6792
6793     if {[info exists find_dirn]} {
6794         unset find_dirn
6795         unset findcurline
6796         notbusy finding
6797         set fprogcoord 0
6798         adjustprogress
6799     }
6800     stopblaming
6801 }
6802
6803 proc findmore {} {
6804     global commitdata commitinfo numcommits findpattern findloc
6805     global findstartline findcurline findallowwrap
6806     global find_dirn gdttype fhighlights fprogcoord
6807     global curview varcorder vrownum varccommits vrowmod
6808
6809     if {![info exists find_dirn]} {
6810         return 0
6811     }
6812     set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6813     set l $findcurline
6814     set moretodo 0
6815     if {$find_dirn > 0} {
6816         incr l
6817         if {$l >= $numcommits} {
6818             set l 0
6819         }
6820         if {$l <= $findstartline} {
6821             set lim [expr {$findstartline + 1}]
6822         } else {
6823             set lim $numcommits
6824             set moretodo $findallowwrap
6825         }
6826     } else {
6827         if {$l == 0} {
6828             set l $numcommits
6829         }
6830         incr l -1
6831         if {$l >= $findstartline} {
6832             set lim [expr {$findstartline - 1}]
6833         } else {
6834             set lim -1
6835             set moretodo $findallowwrap
6836         }
6837     }
6838     set n [expr {($lim - $l) * $find_dirn}]
6839     if {$n > 500} {
6840         set n 500
6841         set moretodo 1
6842     }
6843     if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6844         update_arcrows $curview
6845     }
6846     set found 0
6847     set domore 1
6848     set ai [bsearch $vrownum($curview) $l]
6849     set a [lindex $varcorder($curview) $ai]
6850     set arow [lindex $vrownum($curview) $ai]
6851     set ids [lindex $varccommits($curview,$a)]
6852     set arowend [expr {$arow + [llength $ids]}]
6853     if {$gdttype eq [mc "containing:"]} {
6854         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6855             if {$l < $arow || $l >= $arowend} {
6856                 incr ai $find_dirn
6857                 set a [lindex $varcorder($curview) $ai]
6858                 set arow [lindex $vrownum($curview) $ai]
6859                 set ids [lindex $varccommits($curview,$a)]
6860                 set arowend [expr {$arow + [llength $ids]}]
6861             }
6862             set id [lindex $ids [expr {$l - $arow}]]
6863             # shouldn't happen unless git log doesn't give all the commits...
6864             if {![info exists commitdata($id)] ||
6865                 ![doesmatch $commitdata($id)]} {
6866                 continue
6867             }
6868             if {![info exists commitinfo($id)]} {
6869                 getcommit $id
6870             }
6871             set info $commitinfo($id)
6872             foreach f $info ty $fldtypes {
6873                 if {$ty eq ""} continue
6874                 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6875                     [doesmatch $f]} {
6876                     set found 1
6877                     break
6878                 }
6879             }
6880             if {$found} break
6881         }
6882     } else {
6883         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6884             if {$l < $arow || $l >= $arowend} {
6885                 incr ai $find_dirn
6886                 set a [lindex $varcorder($curview) $ai]
6887                 set arow [lindex $vrownum($curview) $ai]
6888                 set ids [lindex $varccommits($curview,$a)]
6889                 set arowend [expr {$arow + [llength $ids]}]
6890             }
6891             set id [lindex $ids [expr {$l - $arow}]]
6892             if {![info exists fhighlights($id)]} {
6893                 # this sets fhighlights($id) to -1
6894                 askfilehighlight $l $id
6895             }
6896             if {$fhighlights($id) > 0} {
6897                 set found $domore
6898                 break
6899             }
6900             if {$fhighlights($id) < 0} {
6901                 if {$domore} {
6902                     set domore 0
6903                     set findcurline [expr {$l - $find_dirn}]
6904                 }
6905             }
6906         }
6907     }
6908     if {$found || ($domore && !$moretodo)} {
6909         unset findcurline
6910         unset find_dirn
6911         notbusy finding
6912         set fprogcoord 0
6913         adjustprogress
6914         if {$found} {
6915             findselectline $l
6916         } else {
6917             bell
6918         }
6919         return 0
6920     }
6921     if {!$domore} {
6922         flushhighlights
6923     } else {
6924         set findcurline [expr {$l - $find_dirn}]
6925     }
6926     set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6927     if {$n < 0} {
6928         incr n $numcommits
6929     }
6930     set fprogcoord [expr {$n * 1.0 / $numcommits}]
6931     adjustprogress
6932     return $domore
6933 }
6934
6935 proc findselectline {l} {
6936     global findloc commentend ctext findcurline markingmatches gdttype
6937
6938     set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6939     set findcurline $l
6940     selectline $l 1
6941     if {$markingmatches &&
6942         ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6943         # highlight the matches in the comments
6944         set f [$ctext get 1.0 $commentend]
6945         set matches [findmatches $f]
6946         foreach match $matches {
6947             set start [lindex $match 0]
6948             set end [expr {[lindex $match 1] + 1}]
6949             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6950         }
6951     }
6952     drawvisible
6953 }
6954
6955 # mark the bits of a headline or author that match a find string
6956 proc markmatches {canv l str tag matches font row} {
6957     global selectedline
6958
6959     set bbox [$canv bbox $tag]
6960     set x0 [lindex $bbox 0]
6961     set y0 [lindex $bbox 1]
6962     set y1 [lindex $bbox 3]
6963     foreach match $matches {
6964         set start [lindex $match 0]
6965         set end [lindex $match 1]
6966         if {$start > $end} continue
6967         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6968         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6969         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6970                    [expr {$x0+$xlen+2}] $y1 \
6971                    -outline {} -tags [list match$l matches] -fill yellow]
6972         $canv lower $t
6973         if {$row == $selectedline} {
6974             $canv raise $t secsel
6975         }
6976     }
6977 }
6978
6979 proc unmarkmatches {} {
6980     global markingmatches
6981
6982     allcanvs delete matches
6983     set markingmatches 0
6984     stopfinding
6985 }
6986
6987 proc selcanvline {w x y} {
6988     global canv canvy0 ctext linespc
6989     global rowtextx
6990     set ymax [lindex [$canv cget -scrollregion] 3]
6991     if {$ymax == {}} return
6992     set yfrac [lindex [$canv yview] 0]
6993     set y [expr {$y + $yfrac * $ymax}]
6994     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6995     if {$l < 0} {
6996         set l 0
6997     }
6998     if {$w eq $canv} {
6999         set xmax [lindex [$canv cget -scrollregion] 2]
7000         set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
7001         if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
7002     }
7003     unmarkmatches
7004     selectline $l 1
7005 }
7006
7007 proc commit_descriptor {p} {
7008     global commitinfo
7009     if {![info exists commitinfo($p)]} {
7010         getcommit $p
7011     }
7012     set l "..."
7013     if {[llength $commitinfo($p)] > 1} {
7014         set l [lindex $commitinfo($p) 0]
7015     }
7016     return "$p ($l)\n"
7017 }
7018
7019 # append some text to the ctext widget, and make any SHA1 ID
7020 # that we know about be a clickable link.
7021 # Also look for URLs of the form "http[s]://..." and make them web links.
7022 proc appendwithlinks {text tags} {
7023     global ctext linknum curview
7024
7025     set start [$ctext index "end - 1c"]
7026     $ctext insert end $text $tags
7027     set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
7028     foreach l $links {
7029         set s [lindex $l 0]
7030         set e [lindex $l 1]
7031         set linkid [string range $text $s $e]
7032         incr e
7033         $ctext tag delete link$linknum
7034         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
7035         setlink $linkid link$linknum
7036         incr linknum
7037     }
7038     set wlinks [regexp -indices -all -inline -line \
7039                     {https?://[^[:space:]]+} $text]
7040     foreach l $wlinks {
7041         set s2 [lindex $l 0]
7042         set e2 [lindex $l 1]
7043         set url [string range $text $s2 $e2]
7044         incr e2
7045         $ctext tag delete link$linknum
7046         $ctext tag add link$linknum "$start + $s2 c" "$start + $e2 c"
7047         setwlink $url link$linknum
7048         incr linknum
7049     }
7050 }
7051
7052 proc setlink {id lk} {
7053     global curview ctext pendinglinks
7054     global linkfgcolor
7055
7056     if {[string range $id 0 1] eq "-g"} {
7057       set id [string range $id 2 end]
7058     }
7059
7060     set known 0
7061     if {[string length $id] < 40} {
7062         set matches [longid $id]
7063         if {[llength $matches] > 0} {
7064             if {[llength $matches] > 1} return
7065             set known 1
7066             set id [lindex $matches 0]
7067         }
7068     } else {
7069         set known [commitinview $id $curview]
7070     }
7071     if {$known} {
7072         $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7073         $ctext tag bind $lk <1> [list selbyid $id]
7074         $ctext tag bind $lk <Enter> {linkcursor %W 1}
7075         $ctext tag bind $lk <Leave> {linkcursor %W -1}
7076     } else {
7077         lappend pendinglinks($id) $lk
7078         interestedin $id {makelink %P}
7079     }
7080 }
7081
7082 proc setwlink {url lk} {
7083     global ctext
7084     global linkfgcolor
7085     global web_browser
7086
7087     if {$web_browser eq {}} return
7088     $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7089     $ctext tag bind $lk <1> [list browseweb $url]
7090     $ctext tag bind $lk <Enter> {linkcursor %W 1}
7091     $ctext tag bind $lk <Leave> {linkcursor %W -1}
7092 }
7093
7094 proc appendshortlink {id {pre {}} {post {}}} {
7095     global ctext linknum
7096
7097     $ctext insert end $pre
7098     $ctext tag delete link$linknum
7099     $ctext insert end [string range $id 0 7] link$linknum
7100     $ctext insert end $post
7101     setlink $id link$linknum
7102     incr linknum
7103 }
7104
7105 proc makelink {id} {
7106     global pendinglinks
7107
7108     if {![info exists pendinglinks($id)]} return
7109     foreach lk $pendinglinks($id) {
7110         setlink $id $lk
7111     }
7112     unset pendinglinks($id)
7113 }
7114
7115 proc linkcursor {w inc} {
7116     global linkentercount curtextcursor
7117
7118     if {[incr linkentercount $inc] > 0} {
7119         $w configure -cursor hand2
7120     } else {
7121         $w configure -cursor $curtextcursor
7122         if {$linkentercount < 0} {
7123             set linkentercount 0
7124         }
7125     }
7126 }
7127
7128 proc browseweb {url} {
7129     global web_browser
7130
7131     if {$web_browser eq {}} return
7132     # Use eval here in case $web_browser is a command plus some arguments
7133     if {[catch {eval exec $web_browser [list $url] &} err]} {
7134         error_popup "[mc "Error starting web browser:"] $err"
7135     }
7136 }
7137
7138 proc viewnextline {dir} {
7139     global canv linespc
7140
7141     $canv delete hover
7142     set ymax [lindex [$canv cget -scrollregion] 3]
7143     set wnow [$canv yview]
7144     set wtop [expr {[lindex $wnow 0] * $ymax}]
7145     set newtop [expr {$wtop + $dir * $linespc}]
7146     if {$newtop < 0} {
7147         set newtop 0
7148     } elseif {$newtop > $ymax} {
7149         set newtop $ymax
7150     }
7151     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7152 }
7153
7154 # add a list of tag or branch names at position pos
7155 # returns the number of names inserted
7156 proc appendrefs {pos ids var} {
7157     global ctext linknum curview $var maxrefs visiblerefs mainheadid
7158
7159     if {[catch {$ctext index $pos}]} {
7160         return 0
7161     }
7162     $ctext conf -state normal
7163     $ctext delete $pos "$pos lineend"
7164     set tags {}
7165     foreach id $ids {
7166         foreach tag [set $var\($id\)] {
7167             lappend tags [list $tag $id]
7168         }
7169     }
7170
7171     set sep {}
7172     set tags [lsort -index 0 -decreasing $tags]
7173     set nutags 0
7174
7175     if {[llength $tags] > $maxrefs} {
7176         # If we are displaying heads, and there are too many,
7177         # see if there are some important heads to display.
7178         # Currently that are the current head and heads listed in $visiblerefs option
7179         set itags {}
7180         if {$var eq "idheads"} {
7181             set utags {}
7182             foreach ti $tags {
7183                 set hname [lindex $ti 0]
7184                 set id [lindex $ti 1]
7185                 if {([lsearch -exact $visiblerefs $hname] != -1 || $id eq $mainheadid) &&
7186                     [llength $itags] < $maxrefs} {
7187                     lappend itags $ti
7188                 } else {
7189                     lappend utags $ti
7190                 }
7191             }
7192             set tags $utags
7193         }
7194         if {$itags ne {}} {
7195             set str [mc "and many more"]
7196             set sep " "
7197         } else {
7198             set str [mc "many"]
7199         }
7200         $ctext insert $pos "$str ([llength $tags])"
7201         set nutags [llength $tags]
7202         set tags $itags
7203     }
7204
7205     foreach ti $tags {
7206         set id [lindex $ti 1]
7207         set lk link$linknum
7208         incr linknum
7209         $ctext tag delete $lk
7210         $ctext insert $pos $sep
7211         $ctext insert $pos [lindex $ti 0] $lk
7212         setlink $id $lk
7213         set sep ", "
7214     }
7215     $ctext tag add wwrap "$pos linestart" "$pos lineend"
7216     $ctext conf -state disabled
7217     return [expr {[llength $tags] + $nutags}]
7218 }
7219
7220 # called when we have finished computing the nearby tags
7221 proc dispneartags {delay} {
7222     global selectedline currentid showneartags tagphase
7223
7224     if {$selectedline eq {} || !$showneartags} return
7225     after cancel dispnexttag
7226     if {$delay} {
7227         after 200 dispnexttag
7228         set tagphase -1
7229     } else {
7230         after idle dispnexttag
7231         set tagphase 0
7232     }
7233 }
7234
7235 proc dispnexttag {} {
7236     global selectedline currentid showneartags tagphase ctext
7237
7238     if {$selectedline eq {} || !$showneartags} return
7239     switch -- $tagphase {
7240         0 {
7241             set dtags [desctags $currentid]
7242             if {$dtags ne {}} {
7243                 appendrefs precedes $dtags idtags
7244             }
7245         }
7246         1 {
7247             set atags [anctags $currentid]
7248             if {$atags ne {}} {
7249                 appendrefs follows $atags idtags
7250             }
7251         }
7252         2 {
7253             set dheads [descheads $currentid]
7254             if {$dheads ne {}} {
7255                 if {[appendrefs branch $dheads idheads] > 1
7256                     && [$ctext get "branch -3c"] eq "h"} {
7257                     # turn "Branch" into "Branches"
7258                     $ctext conf -state normal
7259                     $ctext insert "branch -2c" "es"
7260                     $ctext conf -state disabled
7261                 }
7262             }
7263         }
7264     }
7265     if {[incr tagphase] <= 2} {
7266         after idle dispnexttag
7267     }
7268 }
7269
7270 proc make_secsel {id} {
7271     global linehtag linentag linedtag canv canv2 canv3
7272
7273     if {![info exists linehtag($id)]} return
7274     $canv delete secsel
7275     set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7276                -tags secsel -fill [$canv cget -selectbackground]]
7277     $canv lower $t
7278     $canv2 delete secsel
7279     set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7280                -tags secsel -fill [$canv2 cget -selectbackground]]
7281     $canv2 lower $t
7282     $canv3 delete secsel
7283     set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7284                -tags secsel -fill [$canv3 cget -selectbackground]]
7285     $canv3 lower $t
7286 }
7287
7288 proc make_idmark {id} {
7289     global linehtag canv fgcolor
7290
7291     if {![info exists linehtag($id)]} return
7292     $canv delete markid
7293     set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7294                -tags markid -outline $fgcolor]
7295     $canv raise $t
7296 }
7297
7298 proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
7299     global canv ctext commitinfo selectedline
7300     global canvy0 linespc parents children curview
7301     global currentid sha1entry
7302     global commentend idtags linknum
7303     global mergemax numcommits pending_select
7304     global cmitmode showneartags allcommits
7305     global targetrow targetid lastscrollrows
7306     global autoselect autosellen jump_to_here
7307     global vinlinediff
7308
7309     unset -nocomplain pending_select
7310     $canv delete hover
7311     normalline
7312     unsel_reflist
7313     stopfinding
7314     if {$l < 0 || $l >= $numcommits} return
7315     set id [commitonrow $l]
7316     set targetid $id
7317     set targetrow $l
7318     set selectedline $l
7319     set currentid $id
7320     if {$lastscrollrows < $numcommits} {
7321         setcanvscroll
7322     }
7323
7324     if {$cmitmode ne "patch" && $switch_to_patch} {
7325         set cmitmode "patch"
7326     }
7327
7328     set y [expr {$canvy0 + $l * $linespc}]
7329     set ymax [lindex [$canv cget -scrollregion] 3]
7330     set ytop [expr {$y - $linespc - 1}]
7331     set ybot [expr {$y + $linespc + 1}]
7332     set wnow [$canv yview]
7333     set wtop [expr {[lindex $wnow 0] * $ymax}]
7334     set wbot [expr {[lindex $wnow 1] * $ymax}]
7335     set wh [expr {$wbot - $wtop}]
7336     set newtop $wtop
7337     if {$ytop < $wtop} {
7338         if {$ybot < $wtop} {
7339             set newtop [expr {$y - $wh / 2.0}]
7340         } else {
7341             set newtop $ytop
7342             if {$newtop > $wtop - $linespc} {
7343                 set newtop [expr {$wtop - $linespc}]
7344             }
7345         }
7346     } elseif {$ybot > $wbot} {
7347         if {$ytop > $wbot} {
7348             set newtop [expr {$y - $wh / 2.0}]
7349         } else {
7350             set newtop [expr {$ybot - $wh}]
7351             if {$newtop < $wtop + $linespc} {
7352                 set newtop [expr {$wtop + $linespc}]
7353             }
7354         }
7355     }
7356     if {$newtop != $wtop} {
7357         if {$newtop < 0} {
7358             set newtop 0
7359         }
7360         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7361         drawvisible
7362     }
7363
7364     make_secsel $id
7365
7366     if {$isnew} {
7367         addtohistory [list selbyid $id 0] savecmitpos
7368     }
7369
7370     $sha1entry delete 0 end
7371     $sha1entry insert 0 $id
7372     if {$autoselect} {
7373         $sha1entry selection range 0 $autosellen
7374     }
7375     rhighlight_sel $id
7376
7377     $ctext conf -state normal
7378     clear_ctext
7379     set linknum 0
7380     if {![info exists commitinfo($id)]} {
7381         getcommit $id
7382     }
7383     set info $commitinfo($id)
7384     set date [formatdate [lindex $info 2]]
7385     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7386     set date [formatdate [lindex $info 4]]
7387     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7388     if {[info exists idtags($id)]} {
7389         $ctext insert end [mc "Tags:"]
7390         foreach tag $idtags($id) {
7391             $ctext insert end " $tag"
7392         }
7393         $ctext insert end "\n"
7394     }
7395
7396     set headers {}
7397     set olds $parents($curview,$id)
7398     if {[llength $olds] > 1} {
7399         set np 0
7400         foreach p $olds {
7401             if {$np >= $mergemax} {
7402                 set tag mmax
7403             } else {
7404                 set tag m$np
7405             }
7406             $ctext insert end "[mc "Parent"]: " $tag
7407             appendwithlinks [commit_descriptor $p] {}
7408             incr np
7409         }
7410     } else {
7411         foreach p $olds {
7412             append headers "[mc "Parent"]: [commit_descriptor $p]"
7413         }
7414     }
7415
7416     foreach c $children($curview,$id) {
7417         append headers "[mc "Child"]:  [commit_descriptor $c]"
7418     }
7419
7420     # make anything that looks like a SHA1 ID be a clickable link
7421     appendwithlinks $headers {}
7422     if {$showneartags} {
7423         if {![info exists allcommits]} {
7424             getallcommits
7425         }
7426         $ctext insert end "[mc "Branch"]: "
7427         $ctext mark set branch "end -1c"
7428         $ctext mark gravity branch left
7429         $ctext insert end "\n[mc "Follows"]: "
7430         $ctext mark set follows "end -1c"
7431         $ctext mark gravity follows left
7432         $ctext insert end "\n[mc "Precedes"]: "
7433         $ctext mark set precedes "end -1c"
7434         $ctext mark gravity precedes left
7435         $ctext insert end "\n"
7436         dispneartags 1
7437     }
7438     $ctext insert end "\n"
7439     set comment [lindex $info 5]
7440     if {[string first "\r" $comment] >= 0} {
7441         set comment [string map {"\r" "\n    "} $comment]
7442     }
7443     appendwithlinks $comment {comment}
7444
7445     $ctext tag remove found 1.0 end
7446     $ctext conf -state disabled
7447     set commentend [$ctext index "end - 1c"]
7448
7449     set jump_to_here $desired_loc
7450     init_flist [mc "Comments"]
7451     if {$cmitmode eq "tree"} {
7452         gettree $id
7453     } elseif {$vinlinediff($curview) == 1} {
7454         showinlinediff $id
7455     } elseif {[llength $olds] <= 1} {
7456         startdiff $id
7457     } else {
7458         mergediff $id
7459     }
7460 }
7461
7462 proc selfirstline {} {
7463     unmarkmatches
7464     selectline 0 1
7465 }
7466
7467 proc sellastline {} {
7468     global numcommits
7469     unmarkmatches
7470     set l [expr {$numcommits - 1}]
7471     selectline $l 1
7472 }
7473
7474 proc selnextline {dir} {
7475     global selectedline
7476     focus .
7477     if {$selectedline eq {}} return
7478     set l [expr {$selectedline + $dir}]
7479     unmarkmatches
7480     selectline $l 1
7481 }
7482
7483 proc selnextpage {dir} {
7484     global canv linespc selectedline numcommits
7485
7486     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7487     if {$lpp < 1} {
7488         set lpp 1
7489     }
7490     allcanvs yview scroll [expr {$dir * $lpp}] units
7491     drawvisible
7492     if {$selectedline eq {}} return
7493     set l [expr {$selectedline + $dir * $lpp}]
7494     if {$l < 0} {
7495         set l 0
7496     } elseif {$l >= $numcommits} {
7497         set l [expr $numcommits - 1]
7498     }
7499     unmarkmatches
7500     selectline $l 1
7501 }
7502
7503 proc unselectline {} {
7504     global selectedline currentid
7505
7506     set selectedline {}
7507     unset -nocomplain currentid
7508     allcanvs delete secsel
7509     rhighlight_none
7510 }
7511
7512 proc reselectline {} {
7513     global selectedline
7514
7515     if {$selectedline ne {}} {
7516         selectline $selectedline 0
7517     }
7518 }
7519
7520 proc addtohistory {cmd {saveproc {}}} {
7521     global history historyindex curview
7522
7523     unset_posvars
7524     save_position
7525     set elt [list $curview $cmd $saveproc {}]
7526     if {$historyindex > 0
7527         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7528         return
7529     }
7530
7531     if {$historyindex < [llength $history]} {
7532         set history [lreplace $history $historyindex end $elt]
7533     } else {
7534         lappend history $elt
7535     }
7536     incr historyindex
7537     if {$historyindex > 1} {
7538         .tf.bar.leftbut conf -state normal
7539     } else {
7540         .tf.bar.leftbut conf -state disabled
7541     }
7542     .tf.bar.rightbut conf -state disabled
7543 }
7544
7545 # save the scrolling position of the diff display pane
7546 proc save_position {} {
7547     global historyindex history
7548
7549     if {$historyindex < 1} return
7550     set hi [expr {$historyindex - 1}]
7551     set fn [lindex $history $hi 2]
7552     if {$fn ne {}} {
7553         lset history $hi 3 [eval $fn]
7554     }
7555 }
7556
7557 proc unset_posvars {} {
7558     global last_posvars
7559
7560     if {[info exists last_posvars]} {
7561         foreach {var val} $last_posvars {
7562             global $var
7563             unset -nocomplain $var
7564         }
7565         unset last_posvars
7566     }
7567 }
7568
7569 proc godo {elt} {
7570     global curview last_posvars
7571
7572     set view [lindex $elt 0]
7573     set cmd [lindex $elt 1]
7574     set pv [lindex $elt 3]
7575     if {$curview != $view} {
7576         showview $view
7577     }
7578     unset_posvars
7579     foreach {var val} $pv {
7580         global $var
7581         set $var $val
7582     }
7583     set last_posvars $pv
7584     eval $cmd
7585 }
7586
7587 proc goback {} {
7588     global history historyindex
7589     focus .
7590
7591     if {$historyindex > 1} {
7592         save_position
7593         incr historyindex -1
7594         godo [lindex $history [expr {$historyindex - 1}]]
7595         .tf.bar.rightbut conf -state normal
7596     }
7597     if {$historyindex <= 1} {
7598         .tf.bar.leftbut conf -state disabled
7599     }
7600 }
7601
7602 proc goforw {} {
7603     global history historyindex
7604     focus .
7605
7606     if {$historyindex < [llength $history]} {
7607         save_position
7608         set cmd [lindex $history $historyindex]
7609         incr historyindex
7610         godo $cmd
7611         .tf.bar.leftbut conf -state normal
7612     }
7613     if {$historyindex >= [llength $history]} {
7614         .tf.bar.rightbut conf -state disabled
7615     }
7616 }
7617
7618 proc go_to_parent {i} {
7619     global parents curview targetid
7620     set ps $parents($curview,$targetid)
7621     if {[llength $ps] >= $i} {
7622         selbyid [lindex $ps [expr $i - 1]]
7623     }
7624 }
7625
7626 proc gettree {id} {
7627     global treefilelist treeidlist diffids diffmergeid treepending
7628     global nullid nullid2
7629
7630     set diffids $id
7631     unset -nocomplain diffmergeid
7632     if {![info exists treefilelist($id)]} {
7633         if {![info exists treepending]} {
7634             if {$id eq $nullid} {
7635                 set cmd [list | git ls-files]
7636             } elseif {$id eq $nullid2} {
7637                 set cmd [list | git ls-files --stage -t]
7638             } else {
7639                 set cmd [list | git ls-tree -r $id]
7640             }
7641             if {[catch {set gtf [open $cmd r]}]} {
7642                 return
7643             }
7644             set treepending $id
7645             set treefilelist($id) {}
7646             set treeidlist($id) {}
7647             fconfigure $gtf -blocking 0 -encoding binary
7648             filerun $gtf [list gettreeline $gtf $id]
7649         }
7650     } else {
7651         setfilelist $id
7652     }
7653 }
7654
7655 proc gettreeline {gtf id} {
7656     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7657
7658     set nl 0
7659     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7660         if {$diffids eq $nullid} {
7661             set fname $line
7662         } else {
7663             set i [string first "\t" $line]
7664             if {$i < 0} continue
7665             set fname [string range $line [expr {$i+1}] end]
7666             set line [string range $line 0 [expr {$i-1}]]
7667             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7668             set sha1 [lindex $line 2]
7669             lappend treeidlist($id) $sha1
7670         }
7671         if {[string index $fname 0] eq "\""} {
7672             set fname [lindex $fname 0]
7673         }
7674         set fname [encoding convertfrom $fname]
7675         lappend treefilelist($id) $fname
7676     }
7677     if {![eof $gtf]} {
7678         return [expr {$nl >= 1000? 2: 1}]
7679     }
7680     close $gtf
7681     unset treepending
7682     if {$cmitmode ne "tree"} {
7683         if {![info exists diffmergeid]} {
7684             gettreediffs $diffids
7685         }
7686     } elseif {$id ne $diffids} {
7687         gettree $diffids
7688     } else {
7689         setfilelist $id
7690     }
7691     return 0
7692 }
7693
7694 proc showfile {f} {
7695     global treefilelist treeidlist diffids nullid nullid2
7696     global ctext_file_names ctext_file_lines
7697     global ctext commentend
7698
7699     set i [lsearch -exact $treefilelist($diffids) $f]
7700     if {$i < 0} {
7701         puts "oops, $f not in list for id $diffids"
7702         return
7703     }
7704     if {$diffids eq $nullid} {
7705         if {[catch {set bf [open $f r]} err]} {
7706             puts "oops, can't read $f: $err"
7707             return
7708         }
7709     } else {
7710         set blob [lindex $treeidlist($diffids) $i]
7711         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7712             puts "oops, error reading blob $blob: $err"
7713             return
7714         }
7715     }
7716     fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7717     filerun $bf [list getblobline $bf $diffids]
7718     $ctext config -state normal
7719     clear_ctext $commentend
7720     lappend ctext_file_names $f
7721     lappend ctext_file_lines [lindex [split $commentend "."] 0]
7722     $ctext insert end "\n"
7723     $ctext insert end "$f\n" filesep
7724     $ctext config -state disabled
7725     $ctext yview $commentend
7726     settabs 0
7727 }
7728
7729 proc getblobline {bf id} {
7730     global diffids cmitmode ctext
7731
7732     if {$id ne $diffids || $cmitmode ne "tree"} {
7733         catch {close $bf}
7734         return 0
7735     }
7736     $ctext config -state normal
7737     set nl 0
7738     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7739         $ctext insert end "$line\n"
7740     }
7741     if {[eof $bf]} {
7742         global jump_to_here ctext_file_names commentend
7743
7744         # delete last newline
7745         $ctext delete "end - 2c" "end - 1c"
7746         close $bf
7747         if {$jump_to_here ne {} &&
7748             [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7749             set lnum [expr {[lindex $jump_to_here 1] +
7750                             [lindex [split $commentend .] 0]}]
7751             mark_ctext_line $lnum
7752         }
7753         $ctext config -state disabled
7754         return 0
7755     }
7756     $ctext config -state disabled
7757     return [expr {$nl >= 1000? 2: 1}]
7758 }
7759
7760 proc mark_ctext_line {lnum} {
7761     global ctext markbgcolor
7762
7763     $ctext tag delete omark
7764     $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7765     $ctext tag conf omark -background $markbgcolor
7766     $ctext see $lnum.0
7767 }
7768
7769 proc mergediff {id} {
7770     global diffmergeid
7771     global diffids treediffs
7772     global parents curview
7773
7774     set diffmergeid $id
7775     set diffids $id
7776     set treediffs($id) {}
7777     set np [llength $parents($curview,$id)]
7778     settabs $np
7779     getblobdiffs $id
7780 }
7781
7782 proc startdiff {ids} {
7783     global treediffs diffids treepending diffmergeid nullid nullid2
7784
7785     settabs 1
7786     set diffids $ids
7787     unset -nocomplain diffmergeid
7788     if {![info exists treediffs($ids)] ||
7789         [lsearch -exact $ids $nullid] >= 0 ||
7790         [lsearch -exact $ids $nullid2] >= 0} {
7791         if {![info exists treepending]} {
7792             gettreediffs $ids
7793         }
7794     } else {
7795         addtocflist $ids
7796     }
7797 }
7798
7799 proc showinlinediff {ids} {
7800     global commitinfo commitdata ctext
7801     global treediffs
7802
7803     set info $commitinfo($ids)
7804     set diff [lindex $info 7]
7805     set difflines [split $diff "\n"]
7806
7807     initblobdiffvars
7808     set treediff {}
7809
7810     set inhdr 0
7811     foreach line $difflines {
7812         if {![string compare -length 5 "diff " $line]} {
7813             set inhdr 1
7814         } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7815             # offset also accounts for the b/ prefix
7816             lappend treediff [string range $line 6 end]
7817             set inhdr 0
7818         }
7819     }
7820
7821     set treediffs($ids) $treediff
7822     add_flist $treediff
7823
7824     $ctext conf -state normal
7825     foreach line $difflines {
7826         parseblobdiffline $ids $line
7827     }
7828     maybe_scroll_ctext 1
7829     $ctext conf -state disabled
7830 }
7831
7832 # If the filename (name) is under any of the passed filter paths
7833 # then return true to include the file in the listing.
7834 proc path_filter {filter name} {
7835     set worktree [gitworktree]
7836     foreach p $filter {
7837         set fq_p [file normalize $p]
7838         set fq_n [file normalize [file join $worktree $name]]
7839         if {[string match [file normalize $fq_p]* $fq_n]} {
7840             return 1
7841         }
7842     }
7843     return 0
7844 }
7845
7846 proc addtocflist {ids} {
7847     global treediffs
7848
7849     add_flist $treediffs($ids)
7850     getblobdiffs $ids
7851 }
7852
7853 proc diffcmd {ids flags} {
7854     global log_showroot nullid nullid2 git_version
7855
7856     set i [lsearch -exact $ids $nullid]
7857     set j [lsearch -exact $ids $nullid2]
7858     if {$i >= 0} {
7859         if {[llength $ids] > 1 && $j < 0} {
7860             # comparing working directory with some specific revision
7861             set cmd [concat | git diff-index $flags]
7862             if {$i == 0} {
7863                 lappend cmd -R [lindex $ids 1]
7864             } else {
7865                 lappend cmd [lindex $ids 0]
7866             }
7867         } else {
7868             # comparing working directory with index
7869             set cmd [concat | git diff-files $flags]
7870             if {$j == 1} {
7871                 lappend cmd -R
7872             }
7873         }
7874     } elseif {$j >= 0} {
7875         if {[package vcompare $git_version "1.7.2"] >= 0} {
7876             set flags "$flags --ignore-submodules=dirty"
7877         }
7878         set cmd [concat | git diff-index --cached $flags]
7879         if {[llength $ids] > 1} {
7880             # comparing index with specific revision
7881             if {$j == 0} {
7882                 lappend cmd -R [lindex $ids 1]
7883             } else {
7884                 lappend cmd [lindex $ids 0]
7885             }
7886         } else {
7887             # comparing index with HEAD
7888             lappend cmd HEAD
7889         }
7890     } else {
7891         if {$log_showroot} {
7892             lappend flags --root
7893         }
7894         set cmd [concat | git diff-tree -r $flags $ids]
7895     }
7896     return $cmd
7897 }
7898
7899 proc gettreediffs {ids} {
7900     global treediff treepending limitdiffs vfilelimit curview
7901
7902     set cmd [diffcmd $ids {--no-commit-id}]
7903     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7904             set cmd [concat $cmd -- $vfilelimit($curview)]
7905     }
7906     if {[catch {set gdtf [open $cmd r]}]} return
7907
7908     set treepending $ids
7909     set treediff {}
7910     fconfigure $gdtf -blocking 0 -encoding binary
7911     filerun $gdtf [list gettreediffline $gdtf $ids]
7912 }
7913
7914 proc gettreediffline {gdtf ids} {
7915     global treediff treediffs treepending diffids diffmergeid
7916     global cmitmode vfilelimit curview limitdiffs perfile_attrs
7917
7918     set nr 0
7919     set sublist {}
7920     set max 1000
7921     if {$perfile_attrs} {
7922         # cache_gitattr is slow, and even slower on win32 where we
7923         # have to invoke it for only about 30 paths at a time
7924         set max 500
7925         if {[tk windowingsystem] == "win32"} {
7926             set max 120
7927         }
7928     }
7929     while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7930         set i [string first "\t" $line]
7931         if {$i >= 0} {
7932             set file [string range $line [expr {$i+1}] end]
7933             if {[string index $file 0] eq "\""} {
7934                 set file [lindex $file 0]
7935             }
7936             set file [encoding convertfrom $file]
7937             if {$file ne [lindex $treediff end]} {
7938                 lappend treediff $file
7939                 lappend sublist $file
7940             }
7941         }
7942     }
7943     if {$perfile_attrs} {
7944         cache_gitattr encoding $sublist
7945     }
7946     if {![eof $gdtf]} {
7947         return [expr {$nr >= $max? 2: 1}]
7948     }
7949     close $gdtf
7950     set treediffs($ids) $treediff
7951     unset treepending
7952     if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7953         gettree $diffids
7954     } elseif {$ids != $diffids} {
7955         if {![info exists diffmergeid]} {
7956             gettreediffs $diffids
7957         }
7958     } else {
7959         addtocflist $ids
7960     }
7961     return 0
7962 }
7963
7964 # empty string or positive integer
7965 proc diffcontextvalidate {v} {
7966     return [regexp {^(|[1-9][0-9]*)$} $v]
7967 }
7968
7969 proc diffcontextchange {n1 n2 op} {
7970     global diffcontextstring diffcontext
7971
7972     if {[string is integer -strict $diffcontextstring]} {
7973         if {$diffcontextstring >= 0} {
7974             set diffcontext $diffcontextstring
7975             reselectline
7976         }
7977     }
7978 }
7979
7980 proc changeignorespace {} {
7981     reselectline
7982 }
7983
7984 proc changeworddiff {name ix op} {
7985     reselectline
7986 }
7987
7988 proc initblobdiffvars {} {
7989     global diffencoding targetline diffnparents
7990     global diffinhdr currdiffsubmod diffseehere
7991     set targetline {}
7992     set diffnparents 0
7993     set diffinhdr 0
7994     set diffencoding [get_path_encoding {}]
7995     set currdiffsubmod ""
7996     set diffseehere -1
7997 }
7998
7999 proc getblobdiffs {ids} {
8000     global blobdifffd diffids env
8001     global treediffs
8002     global diffcontext
8003     global ignorespace
8004     global worddiff
8005     global limitdiffs vfilelimit curview
8006     global git_version
8007
8008     set textconv {}
8009     if {[package vcompare $git_version "1.6.1"] >= 0} {
8010         set textconv "--textconv"
8011     }
8012     set submodule {}
8013     if {[package vcompare $git_version "1.6.6"] >= 0} {
8014         set submodule "--submodule"
8015     }
8016     set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
8017     if {$ignorespace} {
8018         append cmd " -w"
8019     }
8020     if {$worddiff ne [mc "Line diff"]} {
8021         append cmd " --word-diff=porcelain"
8022     }
8023     if {$limitdiffs && $vfilelimit($curview) ne {}} {
8024         set cmd [concat $cmd -- $vfilelimit($curview)]
8025     }
8026     if {[catch {set bdf [open $cmd r]} err]} {
8027         error_popup [mc "Error getting diffs: %s" $err]
8028         return
8029     }
8030     fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
8031     set blobdifffd($ids) $bdf
8032     initblobdiffvars
8033     filerun $bdf [list getblobdiffline $bdf $diffids]
8034 }
8035
8036 proc savecmitpos {} {
8037     global ctext cmitmode
8038
8039     if {$cmitmode eq "tree"} {
8040         return {}
8041     }
8042     return [list target_scrollpos [$ctext index @0,0]]
8043 }
8044
8045 proc savectextpos {} {
8046     global ctext
8047
8048     return [list target_scrollpos [$ctext index @0,0]]
8049 }
8050
8051 proc maybe_scroll_ctext {ateof} {
8052     global ctext target_scrollpos
8053
8054     if {![info exists target_scrollpos]} return
8055     if {!$ateof} {
8056         set nlines [expr {[winfo height $ctext]
8057                           / [font metrics textfont -linespace]}]
8058         if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
8059     }
8060     $ctext yview $target_scrollpos
8061     unset target_scrollpos
8062 }
8063
8064 proc setinlist {var i val} {
8065     global $var
8066
8067     while {[llength [set $var]] < $i} {
8068         lappend $var {}
8069     }
8070     if {[llength [set $var]] == $i} {
8071         lappend $var $val
8072     } else {
8073         lset $var $i $val
8074     }
8075 }
8076
8077 proc makediffhdr {fname ids} {
8078     global ctext curdiffstart treediffs diffencoding
8079     global ctext_file_names jump_to_here targetline diffline
8080
8081     set fname [encoding convertfrom $fname]
8082     set diffencoding [get_path_encoding $fname]
8083     set i [lsearch -exact $treediffs($ids) $fname]
8084     if {$i >= 0} {
8085         setinlist difffilestart $i $curdiffstart
8086     }
8087     lset ctext_file_names end $fname
8088     set l [expr {(78 - [string length $fname]) / 2}]
8089     set pad [string range "----------------------------------------" 1 $l]
8090     $ctext insert $curdiffstart "$pad $fname $pad" filesep
8091     set targetline {}
8092     if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
8093         set targetline [lindex $jump_to_here 1]
8094     }
8095     set diffline 0
8096 }
8097
8098 proc blobdiffmaybeseehere {ateof} {
8099     global diffseehere
8100     if {$diffseehere >= 0} {
8101         mark_ctext_line [lindex [split $diffseehere .] 0]
8102     }
8103     maybe_scroll_ctext $ateof
8104 }
8105
8106 proc getblobdiffline {bdf ids} {
8107     global diffids blobdifffd
8108     global ctext
8109
8110     set nr 0
8111     $ctext conf -state normal
8112     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
8113         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
8114             # Older diff read. Abort it.
8115             catch {close $bdf}
8116             if {$ids != $diffids} {
8117                 array unset blobdifffd $ids
8118             }
8119             return 0
8120         }
8121         parseblobdiffline $ids $line
8122     }
8123     $ctext conf -state disabled
8124     blobdiffmaybeseehere [eof $bdf]
8125     if {[eof $bdf]} {
8126         catch {close $bdf}
8127         array unset blobdifffd $ids
8128         return 0
8129     }
8130     return [expr {$nr >= 1000? 2: 1}]
8131 }
8132
8133 proc parseblobdiffline {ids line} {
8134     global ctext curdiffstart
8135     global diffnexthead diffnextnote difffilestart
8136     global ctext_file_names ctext_file_lines
8137     global diffinhdr treediffs mergemax diffnparents
8138     global diffencoding jump_to_here targetline diffline currdiffsubmod
8139     global worddiff diffseehere
8140
8141     if {![string compare -length 5 "diff " $line]} {
8142         if {![regexp {^diff (--cc|--git) } $line m type]} {
8143             set line [encoding convertfrom $line]
8144             $ctext insert end "$line\n" hunksep
8145             continue
8146         }
8147         # start of a new file
8148         set diffinhdr 1
8149         $ctext insert end "\n"
8150         set curdiffstart [$ctext index "end - 1c"]
8151         lappend ctext_file_names ""
8152         lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8153         $ctext insert end "\n" filesep
8154
8155         if {$type eq "--cc"} {
8156             # start of a new file in a merge diff
8157             set fname [string range $line 10 end]
8158             if {[lsearch -exact $treediffs($ids) $fname] < 0} {
8159                 lappend treediffs($ids) $fname
8160                 add_flist [list $fname]
8161             }
8162
8163         } else {
8164             set line [string range $line 11 end]
8165             # If the name hasn't changed the length will be odd,
8166             # the middle char will be a space, and the two bits either
8167             # side will be a/name and b/name, or "a/name" and "b/name".
8168             # If the name has changed we'll get "rename from" and
8169             # "rename to" or "copy from" and "copy to" lines following
8170             # this, and we'll use them to get the filenames.
8171             # This complexity is necessary because spaces in the
8172             # filename(s) don't get escaped.
8173             set l [string length $line]
8174             set i [expr {$l / 2}]
8175             if {!(($l & 1) && [string index $line $i] eq " " &&
8176                   [string range $line 2 [expr {$i - 1}]] eq \
8177                       [string range $line [expr {$i + 3}] end])} {
8178                 return
8179             }
8180             # unescape if quoted and chop off the a/ from the front
8181             if {[string index $line 0] eq "\""} {
8182                 set fname [string range [lindex $line 0] 2 end]
8183             } else {
8184                 set fname [string range $line 2 [expr {$i - 1}]]
8185             }
8186         }
8187         makediffhdr $fname $ids
8188
8189     } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8190         set fname [encoding convertfrom [string range $line 16 end]]
8191         $ctext insert end "\n"
8192         set curdiffstart [$ctext index "end - 1c"]
8193         lappend ctext_file_names $fname
8194         lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8195         $ctext insert end "$line\n" filesep
8196         set i [lsearch -exact $treediffs($ids) $fname]
8197         if {$i >= 0} {
8198             setinlist difffilestart $i $curdiffstart
8199         }
8200
8201     } elseif {![string compare -length 2 "@@" $line]} {
8202         regexp {^@@+} $line ats
8203         set line [encoding convertfrom $diffencoding $line]
8204         $ctext insert end "$line\n" hunksep
8205         if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8206             set diffline $nl
8207         }
8208         set diffnparents [expr {[string length $ats] - 1}]
8209         set diffinhdr 0
8210
8211     } elseif {![string compare -length 10 "Submodule " $line]} {
8212         # start of a new submodule
8213         if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8214             set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8215         } else {
8216             set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8217         }
8218         if {$currdiffsubmod != $fname} {
8219             $ctext insert end "\n";     # Add newline after commit message
8220         }
8221         set curdiffstart [$ctext index "end - 1c"]
8222         lappend ctext_file_names ""
8223         if {$currdiffsubmod != $fname} {
8224             lappend ctext_file_lines $fname
8225             makediffhdr $fname $ids
8226             set currdiffsubmod $fname
8227             $ctext insert end "\n$line\n" filesep
8228         } else {
8229             $ctext insert end "$line\n" filesep
8230         }
8231     } elseif {$currdiffsubmod != "" && ![string compare -length 3 "  >" $line]} {
8232         set $currdiffsubmod ""
8233         set line [encoding convertfrom $diffencoding $line]
8234         $ctext insert end "$line\n" dresult
8235     } elseif {$currdiffsubmod != "" && ![string compare -length 3 "  <" $line]} {
8236         set $currdiffsubmod ""
8237         set line [encoding convertfrom $diffencoding $line]
8238         $ctext insert end "$line\n" d0
8239     } elseif {$diffinhdr} {
8240         if {![string compare -length 12 "rename from " $line]} {
8241             set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8242             if {[string index $fname 0] eq "\""} {
8243                 set fname [lindex $fname 0]
8244             }
8245             set fname [encoding convertfrom $fname]
8246             set i [lsearch -exact $treediffs($ids) $fname]
8247             if {$i >= 0} {
8248                 setinlist difffilestart $i $curdiffstart
8249             }
8250         } elseif {![string compare -length 10 $line "rename to "] ||
8251                   ![string compare -length 8 $line "copy to "]} {
8252             set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8253             if {[string index $fname 0] eq "\""} {
8254                 set fname [lindex $fname 0]
8255             }
8256             makediffhdr $fname $ids
8257         } elseif {[string compare -length 3 $line "---"] == 0} {
8258             # do nothing
8259             return
8260         } elseif {[string compare -length 3 $line "+++"] == 0} {
8261             set diffinhdr 0
8262             return
8263         }
8264         $ctext insert end "$line\n" filesep
8265
8266     } else {
8267         set line [string map {\x1A ^Z} \
8268                       [encoding convertfrom $diffencoding $line]]
8269         # parse the prefix - one ' ', '-' or '+' for each parent
8270         set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8271         set tag [expr {$diffnparents > 1? "m": "d"}]
8272         set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8273         set words_pre_markup ""
8274         set words_post_markup ""
8275         if {[string trim $prefix " -+"] eq {}} {
8276             # prefix only has " ", "-" and "+" in it: normal diff line
8277             set num [string first "-" $prefix]
8278             if {$dowords} {
8279                 set line [string range $line 1 end]
8280             }
8281             if {$num >= 0} {
8282                 # removed line, first parent with line is $num
8283                 if {$num >= $mergemax} {
8284                     set num "max"
8285                 }
8286                 if {$dowords && $worddiff eq [mc "Markup words"]} {
8287                     $ctext insert end "\[-$line-\]" $tag$num
8288                 } else {
8289                     $ctext insert end "$line" $tag$num
8290                 }
8291                 if {!$dowords} {
8292                     $ctext insert end "\n" $tag$num
8293                 }
8294             } else {
8295                 set tags {}
8296                 if {[string first "+" $prefix] >= 0} {
8297                     # added line
8298                     lappend tags ${tag}result
8299                     if {$diffnparents > 1} {
8300                         set num [string first " " $prefix]
8301                         if {$num >= 0} {
8302                             if {$num >= $mergemax} {
8303                                 set num "max"
8304                             }
8305                             lappend tags m$num
8306                         }
8307                     }
8308                     set words_pre_markup "{+"
8309                     set words_post_markup "+}"
8310                 }
8311                 if {$targetline ne {}} {
8312                     if {$diffline == $targetline} {
8313                         set diffseehere [$ctext index "end - 1 chars"]
8314                         set targetline {}
8315                     } else {
8316                         incr diffline
8317                     }
8318                 }
8319                 if {$dowords && $worddiff eq [mc "Markup words"]} {
8320                     $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8321                 } else {
8322                     $ctext insert end "$line" $tags
8323                 }
8324                 if {!$dowords} {
8325                     $ctext insert end "\n" $tags
8326                 }
8327             }
8328         } elseif {$dowords && $prefix eq "~"} {
8329             $ctext insert end "\n" {}
8330         } else {
8331             # "\ No newline at end of file",
8332             # or something else we don't recognize
8333             $ctext insert end "$line\n" hunksep
8334         }
8335     }
8336 }
8337
8338 proc changediffdisp {} {
8339     global ctext diffelide
8340
8341     $ctext tag conf d0 -elide [lindex $diffelide 0]
8342     $ctext tag conf dresult -elide [lindex $diffelide 1]
8343 }
8344
8345 proc highlightfile {cline} {
8346     global cflist cflist_top
8347
8348     if {![info exists cflist_top]} return
8349
8350     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8351     $cflist tag add highlight $cline.0 "$cline.0 lineend"
8352     $cflist see $cline.0
8353     set cflist_top $cline
8354 }
8355
8356 proc highlightfile_for_scrollpos {topidx} {
8357     global cmitmode difffilestart
8358
8359     if {$cmitmode eq "tree"} return
8360     if {![info exists difffilestart]} return
8361
8362     set top [lindex [split $topidx .] 0]
8363     if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8364         highlightfile 0
8365     } else {
8366         highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8367     }
8368 }
8369
8370 proc prevfile {} {
8371     global difffilestart ctext cmitmode
8372
8373     if {$cmitmode eq "tree"} return
8374     set prev 0.0
8375     set here [$ctext index @0,0]
8376     foreach loc $difffilestart {
8377         if {[$ctext compare $loc >= $here]} {
8378             $ctext yview $prev
8379             return
8380         }
8381         set prev $loc
8382     }
8383     $ctext yview $prev
8384 }
8385
8386 proc nextfile {} {
8387     global difffilestart ctext cmitmode
8388
8389     if {$cmitmode eq "tree"} return
8390     set here [$ctext index @0,0]
8391     foreach loc $difffilestart {
8392         if {[$ctext compare $loc > $here]} {
8393             $ctext yview $loc
8394             return
8395         }
8396     }
8397 }
8398
8399 proc clear_ctext {{first 1.0}} {
8400     global ctext smarktop smarkbot
8401     global ctext_file_names ctext_file_lines
8402     global pendinglinks
8403
8404     set l [lindex [split $first .] 0]
8405     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8406         set smarktop $l
8407     }
8408     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8409         set smarkbot $l
8410     }
8411     $ctext delete $first end
8412     if {$first eq "1.0"} {
8413         unset -nocomplain pendinglinks
8414     }
8415     set ctext_file_names {}
8416     set ctext_file_lines {}
8417 }
8418
8419 proc settabs {{firstab {}}} {
8420     global firsttabstop tabstop ctext have_tk85
8421
8422     if {$firstab ne {} && $have_tk85} {
8423         set firsttabstop $firstab
8424     }
8425     set w [font measure textfont "0"]
8426     if {$firsttabstop != 0} {
8427         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8428                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8429     } elseif {$have_tk85 || $tabstop != 8} {
8430         $ctext conf -tabs [expr {$tabstop * $w}]
8431     } else {
8432         $ctext conf -tabs {}
8433     }
8434 }
8435
8436 proc incrsearch {name ix op} {
8437     global ctext searchstring searchdirn
8438
8439     if {[catch {$ctext index anchor}]} {
8440         # no anchor set, use start of selection, or of visible area
8441         set sel [$ctext tag ranges sel]
8442         if {$sel ne {}} {
8443             $ctext mark set anchor [lindex $sel 0]
8444         } elseif {$searchdirn eq "-forwards"} {
8445             $ctext mark set anchor @0,0
8446         } else {
8447             $ctext mark set anchor @0,[winfo height $ctext]
8448         }
8449     }
8450     if {$searchstring ne {}} {
8451         set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8452         if {$here ne {}} {
8453             $ctext see $here
8454             set mend "$here + $mlen c"
8455             $ctext tag remove sel 1.0 end
8456             $ctext tag add sel $here $mend
8457             suppress_highlighting_file_for_current_scrollpos
8458             highlightfile_for_scrollpos $here
8459         }
8460     }
8461     rehighlight_search_results
8462 }
8463
8464 proc dosearch {} {
8465     global sstring ctext searchstring searchdirn
8466
8467     focus $sstring
8468     $sstring icursor end
8469     set searchdirn -forwards
8470     if {$searchstring ne {}} {
8471         set sel [$ctext tag ranges sel]
8472         if {$sel ne {}} {
8473             set start "[lindex $sel 0] + 1c"
8474         } elseif {[catch {set start [$ctext index anchor]}]} {
8475             set start "@0,0"
8476         }
8477         set match [$ctext search -count mlen -- $searchstring $start]
8478         $ctext tag remove sel 1.0 end
8479         if {$match eq {}} {
8480             bell
8481             return
8482         }
8483         $ctext see $match
8484         suppress_highlighting_file_for_current_scrollpos
8485         highlightfile_for_scrollpos $match
8486         set mend "$match + $mlen c"
8487         $ctext tag add sel $match $mend
8488         $ctext mark unset anchor
8489         rehighlight_search_results
8490     }
8491 }
8492
8493 proc dosearchback {} {
8494     global sstring ctext searchstring searchdirn
8495
8496     focus $sstring
8497     $sstring icursor end
8498     set searchdirn -backwards
8499     if {$searchstring ne {}} {
8500         set sel [$ctext tag ranges sel]
8501         if {$sel ne {}} {
8502             set start [lindex $sel 0]
8503         } elseif {[catch {set start [$ctext index anchor]}]} {
8504             set start @0,[winfo height $ctext]
8505         }
8506         set match [$ctext search -backwards -count ml -- $searchstring $start]
8507         $ctext tag remove sel 1.0 end
8508         if {$match eq {}} {
8509             bell
8510             return
8511         }
8512         $ctext see $match
8513         suppress_highlighting_file_for_current_scrollpos
8514         highlightfile_for_scrollpos $match
8515         set mend "$match + $ml c"
8516         $ctext tag add sel $match $mend
8517         $ctext mark unset anchor
8518         rehighlight_search_results
8519     }
8520 }
8521
8522 proc rehighlight_search_results {} {
8523     global ctext searchstring
8524
8525     $ctext tag remove found 1.0 end
8526     $ctext tag remove currentsearchhit 1.0 end
8527
8528     if {$searchstring ne {}} {
8529         searchmarkvisible 1
8530     }
8531 }
8532
8533 proc searchmark {first last} {
8534     global ctext searchstring
8535
8536     set sel [$ctext tag ranges sel]
8537
8538     set mend $first.0
8539     while {1} {
8540         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8541         if {$match eq {}} break
8542         set mend "$match + $mlen c"
8543         if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8544             $ctext tag add currentsearchhit $match $mend
8545         } else {
8546             $ctext tag add found $match $mend
8547         }
8548     }
8549 }
8550
8551 proc searchmarkvisible {doall} {
8552     global ctext smarktop smarkbot
8553
8554     set topline [lindex [split [$ctext index @0,0] .] 0]
8555     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8556     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8557         # no overlap with previous
8558         searchmark $topline $botline
8559         set smarktop $topline
8560         set smarkbot $botline
8561     } else {
8562         if {$topline < $smarktop} {
8563             searchmark $topline [expr {$smarktop-1}]
8564             set smarktop $topline
8565         }
8566         if {$botline > $smarkbot} {
8567             searchmark [expr {$smarkbot+1}] $botline
8568             set smarkbot $botline
8569         }
8570     }
8571 }
8572
8573 proc suppress_highlighting_file_for_current_scrollpos {} {
8574     global ctext suppress_highlighting_file_for_this_scrollpos
8575
8576     set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8577 }
8578
8579 proc scrolltext {f0 f1} {
8580     global searchstring cmitmode ctext
8581     global suppress_highlighting_file_for_this_scrollpos
8582
8583     set topidx [$ctext index @0,0]
8584     if {![info exists suppress_highlighting_file_for_this_scrollpos]
8585         || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8586         highlightfile_for_scrollpos $topidx
8587     }
8588
8589     unset -nocomplain suppress_highlighting_file_for_this_scrollpos
8590
8591     .bleft.bottom.sb set $f0 $f1
8592     if {$searchstring ne {}} {
8593         searchmarkvisible 0
8594     }
8595 }
8596
8597 proc setcoords {} {
8598     global linespc charspc canvx0 canvy0
8599     global xspc1 xspc2 lthickness
8600
8601     set linespc [font metrics mainfont -linespace]
8602     set charspc [font measure mainfont "m"]
8603     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8604     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8605     set lthickness [expr {int($linespc / 9) + 1}]
8606     set xspc1(0) $linespc
8607     set xspc2 $linespc
8608 }
8609
8610 proc redisplay {} {
8611     global canv
8612     global selectedline
8613
8614     set ymax [lindex [$canv cget -scrollregion] 3]
8615     if {$ymax eq {} || $ymax == 0} return
8616     set span [$canv yview]
8617     clear_display
8618     setcanvscroll
8619     allcanvs yview moveto [lindex $span 0]
8620     drawvisible
8621     if {$selectedline ne {}} {
8622         selectline $selectedline 0
8623         allcanvs yview moveto [lindex $span 0]
8624     }
8625 }
8626
8627 proc parsefont {f n} {
8628     global fontattr
8629
8630     set fontattr($f,family) [lindex $n 0]
8631     set s [lindex $n 1]
8632     if {$s eq {} || $s == 0} {
8633         set s 10
8634     } elseif {$s < 0} {
8635         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8636     }
8637     set fontattr($f,size) $s
8638     set fontattr($f,weight) normal
8639     set fontattr($f,slant) roman
8640     foreach style [lrange $n 2 end] {
8641         switch -- $style {
8642             "normal" -
8643             "bold"   {set fontattr($f,weight) $style}
8644             "roman" -
8645             "italic" {set fontattr($f,slant) $style}
8646         }
8647     }
8648 }
8649
8650 proc fontflags {f {isbold 0}} {
8651     global fontattr
8652
8653     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8654                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8655                 -slant $fontattr($f,slant)]
8656 }
8657
8658 proc fontname {f} {
8659     global fontattr
8660
8661     set n [list $fontattr($f,family) $fontattr($f,size)]
8662     if {$fontattr($f,weight) eq "bold"} {
8663         lappend n "bold"
8664     }
8665     if {$fontattr($f,slant) eq "italic"} {
8666         lappend n "italic"
8667     }
8668     return $n
8669 }
8670
8671 proc incrfont {inc} {
8672     global mainfont textfont ctext canv cflist showrefstop
8673     global stopped entries fontattr
8674
8675     unmarkmatches
8676     set s $fontattr(mainfont,size)
8677     incr s $inc
8678     if {$s < 1} {
8679         set s 1
8680     }
8681     set fontattr(mainfont,size) $s
8682     font config mainfont -size $s
8683     font config mainfontbold -size $s
8684     set mainfont [fontname mainfont]
8685     set s $fontattr(textfont,size)
8686     incr s $inc
8687     if {$s < 1} {
8688         set s 1
8689     }
8690     set fontattr(textfont,size) $s
8691     font config textfont -size $s
8692     font config textfontbold -size $s
8693     set textfont [fontname textfont]
8694     setcoords
8695     settabs
8696     redisplay
8697 }
8698
8699 proc clearsha1 {} {
8700     global sha1entry sha1string
8701     if {[string length $sha1string] == 40} {
8702         $sha1entry delete 0 end
8703     }
8704 }
8705
8706 proc sha1change {n1 n2 op} {
8707     global sha1string currentid sha1but
8708     if {$sha1string == {}
8709         || ([info exists currentid] && $sha1string == $currentid)} {
8710         set state disabled
8711     } else {
8712         set state normal
8713     }
8714     if {[$sha1but cget -state] == $state} return
8715     if {$state == "normal"} {
8716         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8717     } else {
8718         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8719     }
8720 }
8721
8722 proc gotocommit {} {
8723     global sha1string tagids headids curview varcid
8724
8725     if {$sha1string == {}
8726         || ([info exists currentid] && $sha1string == $currentid)} return
8727     if {[info exists tagids($sha1string)]} {
8728         set id $tagids($sha1string)
8729     } elseif {[info exists headids($sha1string)]} {
8730         set id $headids($sha1string)
8731     } else {
8732         set id [string tolower $sha1string]
8733         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8734             set matches [longid $id]
8735             if {$matches ne {}} {
8736                 if {[llength $matches] > 1} {
8737                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8738                     return
8739                 }
8740                 set id [lindex $matches 0]
8741             }
8742         } else {
8743             if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8744                 error_popup [mc "Revision %s is not known" $sha1string]
8745                 return
8746             }
8747         }
8748     }
8749     if {[commitinview $id $curview]} {
8750         selectline [rowofcommit $id] 1
8751         return
8752     }
8753     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8754         set msg [mc "SHA1 id %s is not known" $sha1string]
8755     } else {
8756         set msg [mc "Revision %s is not in the current view" $sha1string]
8757     }
8758     error_popup $msg
8759 }
8760
8761 proc lineenter {x y id} {
8762     global hoverx hovery hoverid hovertimer
8763     global commitinfo canv
8764
8765     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8766     set hoverx $x
8767     set hovery $y
8768     set hoverid $id
8769     if {[info exists hovertimer]} {
8770         after cancel $hovertimer
8771     }
8772     set hovertimer [after 500 linehover]
8773     $canv delete hover
8774 }
8775
8776 proc linemotion {x y id} {
8777     global hoverx hovery hoverid hovertimer
8778
8779     if {[info exists hoverid] && $id == $hoverid} {
8780         set hoverx $x
8781         set hovery $y
8782         if {[info exists hovertimer]} {
8783             after cancel $hovertimer
8784         }
8785         set hovertimer [after 500 linehover]
8786     }
8787 }
8788
8789 proc lineleave {id} {
8790     global hoverid hovertimer canv
8791
8792     if {[info exists hoverid] && $id == $hoverid} {
8793         $canv delete hover
8794         if {[info exists hovertimer]} {
8795             after cancel $hovertimer
8796             unset hovertimer
8797         }
8798         unset hoverid
8799     }
8800 }
8801
8802 proc linehover {} {
8803     global hoverx hovery hoverid hovertimer
8804     global canv linespc lthickness
8805     global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8806
8807     global commitinfo
8808
8809     set text [lindex $commitinfo($hoverid) 0]
8810     set ymax [lindex [$canv cget -scrollregion] 3]
8811     if {$ymax == {}} return
8812     set yfrac [lindex [$canv yview] 0]
8813     set x [expr {$hoverx + 2 * $linespc}]
8814     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8815     set x0 [expr {$x - 2 * $lthickness}]
8816     set y0 [expr {$y - 2 * $lthickness}]
8817     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8818     set y1 [expr {$y + $linespc + 2 * $lthickness}]
8819     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8820                -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8821                -width 1 -tags hover]
8822     $canv raise $t
8823     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8824                -font mainfont -fill $linehoverfgcolor]
8825     $canv raise $t
8826 }
8827
8828 proc clickisonarrow {id y} {
8829     global lthickness
8830
8831     set ranges [rowranges $id]
8832     set thresh [expr {2 * $lthickness + 6}]
8833     set n [expr {[llength $ranges] - 1}]
8834     for {set i 1} {$i < $n} {incr i} {
8835         set row [lindex $ranges $i]
8836         if {abs([yc $row] - $y) < $thresh} {
8837             return $i
8838         }
8839     }
8840     return {}
8841 }
8842
8843 proc arrowjump {id n y} {
8844     global canv
8845
8846     # 1 <-> 2, 3 <-> 4, etc...
8847     set n [expr {(($n - 1) ^ 1) + 1}]
8848     set row [lindex [rowranges $id] $n]
8849     set yt [yc $row]
8850     set ymax [lindex [$canv cget -scrollregion] 3]
8851     if {$ymax eq {} || $ymax <= 0} return
8852     set view [$canv yview]
8853     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8854     set yfrac [expr {$yt / $ymax - $yspan / 2}]
8855     if {$yfrac < 0} {
8856         set yfrac 0
8857     }
8858     allcanvs yview moveto $yfrac
8859 }
8860
8861 proc lineclick {x y id isnew} {
8862     global ctext commitinfo children canv thickerline curview
8863
8864     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8865     unmarkmatches
8866     unselectline
8867     normalline
8868     $canv delete hover
8869     # draw this line thicker than normal
8870     set thickerline $id
8871     drawlines $id
8872     if {$isnew} {
8873         set ymax [lindex [$canv cget -scrollregion] 3]
8874         if {$ymax eq {}} return
8875         set yfrac [lindex [$canv yview] 0]
8876         set y [expr {$y + $yfrac * $ymax}]
8877     }
8878     set dirn [clickisonarrow $id $y]
8879     if {$dirn ne {}} {
8880         arrowjump $id $dirn $y
8881         return
8882     }
8883
8884     if {$isnew} {
8885         addtohistory [list lineclick $x $y $id 0] savectextpos
8886     }
8887     # fill the details pane with info about this line
8888     $ctext conf -state normal
8889     clear_ctext
8890     settabs 0
8891     $ctext insert end "[mc "Parent"]:\t"
8892     $ctext insert end $id link0
8893     setlink $id link0
8894     set info $commitinfo($id)
8895     $ctext insert end "\n\t[lindex $info 0]\n"
8896     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8897     set date [formatdate [lindex $info 2]]
8898     $ctext insert end "\t[mc "Date"]:\t$date\n"
8899     set kids $children($curview,$id)
8900     if {$kids ne {}} {
8901         $ctext insert end "\n[mc "Children"]:"
8902         set i 0
8903         foreach child $kids {
8904             incr i
8905             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8906             set info $commitinfo($child)
8907             $ctext insert end "\n\t"
8908             $ctext insert end $child link$i
8909             setlink $child link$i
8910             $ctext insert end "\n\t[lindex $info 0]"
8911             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8912             set date [formatdate [lindex $info 2]]
8913             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8914         }
8915     }
8916     maybe_scroll_ctext 1
8917     $ctext conf -state disabled
8918     init_flist {}
8919 }
8920
8921 proc normalline {} {
8922     global thickerline
8923     if {[info exists thickerline]} {
8924         set id $thickerline
8925         unset thickerline
8926         drawlines $id
8927     }
8928 }
8929
8930 proc selbyid {id {isnew 1}} {
8931     global curview
8932     if {[commitinview $id $curview]} {
8933         selectline [rowofcommit $id] $isnew
8934     }
8935 }
8936
8937 proc mstime {} {
8938     global startmstime
8939     if {![info exists startmstime]} {
8940         set startmstime [clock clicks -milliseconds]
8941     }
8942     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8943 }
8944
8945 proc rowmenu {x y id} {
8946     global rowctxmenu selectedline rowmenuid curview
8947     global nullid nullid2 fakerowmenu mainhead markedid
8948
8949     stopfinding
8950     set rowmenuid $id
8951     if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8952         set state disabled
8953     } else {
8954         set state normal
8955     }
8956     if {[info exists markedid] && $markedid ne $id} {
8957         set mstate normal
8958     } else {
8959         set mstate disabled
8960     }
8961     if {$id ne $nullid && $id ne $nullid2} {
8962         set menu $rowctxmenu
8963         if {$mainhead ne {}} {
8964             $menu entryconfigure 8 -label [mc "Reset %s branch to here" $mainhead] -state normal
8965         } else {
8966             $menu entryconfigure 8 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8967         }
8968         $menu entryconfigure 10 -state $mstate
8969         $menu entryconfigure 11 -state $mstate
8970         $menu entryconfigure 12 -state $mstate
8971     } else {
8972         set menu $fakerowmenu
8973     }
8974     $menu entryconfigure [mca "Diff this -> selected"] -state $state
8975     $menu entryconfigure [mca "Diff selected -> this"] -state $state
8976     $menu entryconfigure [mca "Make patch"] -state $state
8977     $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8978     $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8979     tk_popup $menu $x $y
8980 }
8981
8982 proc markhere {} {
8983     global rowmenuid markedid canv
8984
8985     set markedid $rowmenuid
8986     make_idmark $markedid
8987 }
8988
8989 proc gotomark {} {
8990     global markedid
8991
8992     if {[info exists markedid]} {
8993         selbyid $markedid
8994     }
8995 }
8996
8997 proc replace_by_kids {l r} {
8998     global curview children
8999
9000     set id [commitonrow $r]
9001     set l [lreplace $l 0 0]
9002     foreach kid $children($curview,$id) {
9003         lappend l [rowofcommit $kid]
9004     }
9005     return [lsort -integer -decreasing -unique $l]
9006 }
9007
9008 proc find_common_desc {} {
9009     global markedid rowmenuid curview children
9010
9011     if {![info exists markedid]} return
9012     if {![commitinview $markedid $curview] ||
9013         ![commitinview $rowmenuid $curview]} return
9014     #set t1 [clock clicks -milliseconds]
9015     set l1 [list [rowofcommit $markedid]]
9016     set l2 [list [rowofcommit $rowmenuid]]
9017     while 1 {
9018         set r1 [lindex $l1 0]
9019         set r2 [lindex $l2 0]
9020         if {$r1 eq {} || $r2 eq {}} break
9021         if {$r1 == $r2} {
9022             selectline $r1 1
9023             break
9024         }
9025         if {$r1 > $r2} {
9026             set l1 [replace_by_kids $l1 $r1]
9027         } else {
9028             set l2 [replace_by_kids $l2 $r2]
9029         }
9030     }
9031     #set t2 [clock clicks -milliseconds]
9032     #puts "took [expr {$t2-$t1}]ms"
9033 }
9034
9035 proc compare_commits {} {
9036     global markedid rowmenuid curview children
9037
9038     if {![info exists markedid]} return
9039     if {![commitinview $markedid $curview]} return
9040     addtohistory [list do_cmp_commits $markedid $rowmenuid]
9041     do_cmp_commits $markedid $rowmenuid
9042 }
9043
9044 proc getpatchid {id} {
9045     global patchids
9046
9047     if {![info exists patchids($id)]} {
9048         set cmd [diffcmd [list $id] {-p --root}]
9049         # trim off the initial "|"
9050         set cmd [lrange $cmd 1 end]
9051         if {[catch {
9052             set x [eval exec $cmd | git patch-id]
9053             set patchids($id) [lindex $x 0]
9054         }]} {
9055             set patchids($id) "error"
9056         }
9057     }
9058     return $patchids($id)
9059 }
9060
9061 proc do_cmp_commits {a b} {
9062     global ctext curview parents children patchids commitinfo
9063
9064     $ctext conf -state normal
9065     clear_ctext
9066     init_flist {}
9067     for {set i 0} {$i < 100} {incr i} {
9068         set skipa 0
9069         set skipb 0
9070         if {[llength $parents($curview,$a)] > 1} {
9071             appendshortlink $a [mc "Skipping merge commit "] "\n"
9072             set skipa 1
9073         } else {
9074             set patcha [getpatchid $a]
9075         }
9076         if {[llength $parents($curview,$b)] > 1} {
9077             appendshortlink $b [mc "Skipping merge commit "] "\n"
9078             set skipb 1
9079         } else {
9080             set patchb [getpatchid $b]
9081         }
9082         if {!$skipa && !$skipb} {
9083             set heada [lindex $commitinfo($a) 0]
9084             set headb [lindex $commitinfo($b) 0]
9085             if {$patcha eq "error"} {
9086                 appendshortlink $a [mc "Error getting patch ID for "] \
9087                     [mc " - stopping\n"]
9088                 break
9089             }
9090             if {$patchb eq "error"} {
9091                 appendshortlink $b [mc "Error getting patch ID for "] \
9092                     [mc " - stopping\n"]
9093                 break
9094             }
9095             if {$patcha eq $patchb} {
9096                 if {$heada eq $headb} {
9097                     appendshortlink $a [mc "Commit "]
9098                     appendshortlink $b " == " "  $heada\n"
9099                 } else {
9100                     appendshortlink $a [mc "Commit "] "  $heada\n"
9101                     appendshortlink $b [mc " is the same patch as\n       "] \
9102                         "  $headb\n"
9103                 }
9104                 set skipa 1
9105                 set skipb 1
9106             } else {
9107                 $ctext insert end "\n"
9108                 appendshortlink $a [mc "Commit "] "  $heada\n"
9109                 appendshortlink $b [mc " differs from\n       "] \
9110                     "  $headb\n"
9111                 $ctext insert end [mc "Diff of commits:\n\n"]
9112                 $ctext conf -state disabled
9113                 update
9114                 diffcommits $a $b
9115                 return
9116             }
9117         }
9118         if {$skipa} {
9119             set kids [real_children $curview,$a]
9120             if {[llength $kids] != 1} {
9121                 $ctext insert end "\n"
9122                 appendshortlink $a [mc "Commit "] \
9123                     [mc " has %s children - stopping\n" [llength $kids]]
9124                 break
9125             }
9126             set a [lindex $kids 0]
9127         }
9128         if {$skipb} {
9129             set kids [real_children $curview,$b]
9130             if {[llength $kids] != 1} {
9131                 appendshortlink $b [mc "Commit "] \
9132                     [mc " has %s children - stopping\n" [llength $kids]]
9133                 break
9134             }
9135             set b [lindex $kids 0]
9136         }
9137     }
9138     $ctext conf -state disabled
9139 }
9140
9141 proc diffcommits {a b} {
9142     global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
9143
9144     set tmpdir [gitknewtmpdir]
9145     set fna [file join $tmpdir "commit-[string range $a 0 7]"]
9146     set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
9147     if {[catch {
9148         exec git diff-tree -p --pretty $a >$fna
9149         exec git diff-tree -p --pretty $b >$fnb
9150     } err]} {
9151         error_popup [mc "Error writing commit to file: %s" $err]
9152         return
9153     }
9154     if {[catch {
9155         set fd [open "| diff -U$diffcontext $fna $fnb" r]
9156     } err]} {
9157         error_popup [mc "Error diffing commits: %s" $err]
9158         return
9159     }
9160     set diffids [list commits $a $b]
9161     set blobdifffd($diffids) $fd
9162     set diffinhdr 0
9163     set currdiffsubmod ""
9164     filerun $fd [list getblobdiffline $fd $diffids]
9165 }
9166
9167 proc diffvssel {dirn} {
9168     global rowmenuid selectedline
9169
9170     if {$selectedline eq {}} return
9171     if {$dirn} {
9172         set oldid [commitonrow $selectedline]
9173         set newid $rowmenuid
9174     } else {
9175         set oldid $rowmenuid
9176         set newid [commitonrow $selectedline]
9177     }
9178     addtohistory [list doseldiff $oldid $newid] savectextpos
9179     doseldiff $oldid $newid
9180 }
9181
9182 proc diffvsmark {dirn} {
9183     global rowmenuid markedid
9184
9185     if {![info exists markedid]} return
9186     if {$dirn} {
9187         set oldid $markedid
9188         set newid $rowmenuid
9189     } else {
9190         set oldid $rowmenuid
9191         set newid $markedid
9192     }
9193     addtohistory [list doseldiff $oldid $newid] savectextpos
9194     doseldiff $oldid $newid
9195 }
9196
9197 proc doseldiff {oldid newid} {
9198     global ctext
9199     global commitinfo
9200
9201     $ctext conf -state normal
9202     clear_ctext
9203     init_flist [mc "Top"]
9204     $ctext insert end "[mc "From"] "
9205     $ctext insert end $oldid link0
9206     setlink $oldid link0
9207     $ctext insert end "\n     "
9208     $ctext insert end [lindex $commitinfo($oldid) 0]
9209     $ctext insert end "\n\n[mc "To"]   "
9210     $ctext insert end $newid link1
9211     setlink $newid link1
9212     $ctext insert end "\n     "
9213     $ctext insert end [lindex $commitinfo($newid) 0]
9214     $ctext insert end "\n"
9215     $ctext conf -state disabled
9216     $ctext tag remove found 1.0 end
9217     startdiff [list $oldid $newid]
9218 }
9219
9220 proc mkpatch {} {
9221     global rowmenuid currentid commitinfo patchtop patchnum NS
9222
9223     if {![info exists currentid]} return
9224     set oldid $currentid
9225     set oldhead [lindex $commitinfo($oldid) 0]
9226     set newid $rowmenuid
9227     set newhead [lindex $commitinfo($newid) 0]
9228     set top .patch
9229     set patchtop $top
9230     catch {destroy $top}
9231     ttk_toplevel $top
9232     make_transient $top .
9233     ${NS}::label $top.title -text [mc "Generate patch"]
9234     grid $top.title - -pady 10
9235     ${NS}::label $top.from -text [mc "From:"]
9236     ${NS}::entry $top.fromsha1 -width 40
9237     $top.fromsha1 insert 0 $oldid
9238     $top.fromsha1 conf -state readonly
9239     grid $top.from $top.fromsha1 -sticky w
9240     ${NS}::entry $top.fromhead -width 60
9241     $top.fromhead insert 0 $oldhead
9242     $top.fromhead conf -state readonly
9243     grid x $top.fromhead -sticky w
9244     ${NS}::label $top.to -text [mc "To:"]
9245     ${NS}::entry $top.tosha1 -width 40
9246     $top.tosha1 insert 0 $newid
9247     $top.tosha1 conf -state readonly
9248     grid $top.to $top.tosha1 -sticky w
9249     ${NS}::entry $top.tohead -width 60
9250     $top.tohead insert 0 $newhead
9251     $top.tohead conf -state readonly
9252     grid x $top.tohead -sticky w
9253     ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9254     grid $top.rev x -pady 10 -padx 5
9255     ${NS}::label $top.flab -text [mc "Output file:"]
9256     ${NS}::entry $top.fname -width 60
9257     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9258     incr patchnum
9259     grid $top.flab $top.fname -sticky w
9260     ${NS}::frame $top.buts
9261     ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9262     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9263     bind $top <Key-Return> mkpatchgo
9264     bind $top <Key-Escape> mkpatchcan
9265     grid $top.buts.gen $top.buts.can
9266     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9267     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9268     grid $top.buts - -pady 10 -sticky ew
9269     focus $top.fname
9270 }
9271
9272 proc mkpatchrev {} {
9273     global patchtop
9274
9275     set oldid [$patchtop.fromsha1 get]
9276     set oldhead [$patchtop.fromhead get]
9277     set newid [$patchtop.tosha1 get]
9278     set newhead [$patchtop.tohead get]
9279     foreach e [list fromsha1 fromhead tosha1 tohead] \
9280             v [list $newid $newhead $oldid $oldhead] {
9281         $patchtop.$e conf -state normal
9282         $patchtop.$e delete 0 end
9283         $patchtop.$e insert 0 $v
9284         $patchtop.$e conf -state readonly
9285     }
9286 }
9287
9288 proc mkpatchgo {} {
9289     global patchtop nullid nullid2
9290
9291     set oldid [$patchtop.fromsha1 get]
9292     set newid [$patchtop.tosha1 get]
9293     set fname [$patchtop.fname get]
9294     set cmd [diffcmd [list $oldid $newid] -p]
9295     # trim off the initial "|"
9296     set cmd [lrange $cmd 1 end]
9297     lappend cmd >$fname &
9298     if {[catch {eval exec $cmd} err]} {
9299         error_popup "[mc "Error creating patch:"] $err" $patchtop
9300     }
9301     catch {destroy $patchtop}
9302     unset patchtop
9303 }
9304
9305 proc mkpatchcan {} {
9306     global patchtop
9307
9308     catch {destroy $patchtop}
9309     unset patchtop
9310 }
9311
9312 proc mktag {} {
9313     global rowmenuid mktagtop commitinfo NS
9314
9315     set top .maketag
9316     set mktagtop $top
9317     catch {destroy $top}
9318     ttk_toplevel $top
9319     make_transient $top .
9320     ${NS}::label $top.title -text [mc "Create tag"]
9321     grid $top.title - -pady 10
9322     ${NS}::label $top.id -text [mc "ID:"]
9323     ${NS}::entry $top.sha1 -width 40
9324     $top.sha1 insert 0 $rowmenuid
9325     $top.sha1 conf -state readonly
9326     grid $top.id $top.sha1 -sticky w
9327     ${NS}::entry $top.head -width 60
9328     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9329     $top.head conf -state readonly
9330     grid x $top.head -sticky w
9331     ${NS}::label $top.tlab -text [mc "Tag name:"]
9332     ${NS}::entry $top.tag -width 60
9333     grid $top.tlab $top.tag -sticky w
9334     ${NS}::label $top.op -text [mc "Tag message is optional"]
9335     grid $top.op -columnspan 2 -sticky we
9336     ${NS}::label $top.mlab -text [mc "Tag message:"]
9337     ${NS}::entry $top.msg -width 60
9338     grid $top.mlab $top.msg -sticky w
9339     ${NS}::frame $top.buts
9340     ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9341     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9342     bind $top <Key-Return> mktaggo
9343     bind $top <Key-Escape> mktagcan
9344     grid $top.buts.gen $top.buts.can
9345     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9346     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9347     grid $top.buts - -pady 10 -sticky ew
9348     focus $top.tag
9349 }
9350
9351 proc domktag {} {
9352     global mktagtop env tagids idtags
9353
9354     set id [$mktagtop.sha1 get]
9355     set tag [$mktagtop.tag get]
9356     set msg [$mktagtop.msg get]
9357     if {$tag == {}} {
9358         error_popup [mc "No tag name specified"] $mktagtop
9359         return 0
9360     }
9361     if {[info exists tagids($tag)]} {
9362         error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9363         return 0
9364     }
9365     if {[catch {
9366         if {$msg != {}} {
9367             exec git tag -a -m $msg $tag $id
9368         } else {
9369             exec git tag $tag $id
9370         }
9371     } err]} {
9372         error_popup "[mc "Error creating tag:"] $err" $mktagtop
9373         return 0
9374     }
9375
9376     set tagids($tag) $id
9377     lappend idtags($id) $tag
9378     redrawtags $id
9379     addedtag $id
9380     dispneartags 0
9381     run refill_reflist
9382     return 1
9383 }
9384
9385 proc redrawtags {id} {
9386     global canv linehtag idpos currentid curview cmitlisted markedid
9387     global canvxmax iddrawn circleitem mainheadid circlecolors
9388     global mainheadcirclecolor
9389
9390     if {![commitinview $id $curview]} return
9391     if {![info exists iddrawn($id)]} return
9392     set row [rowofcommit $id]
9393     if {$id eq $mainheadid} {
9394         set ofill $mainheadcirclecolor
9395     } else {
9396         set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9397     }
9398     $canv itemconf $circleitem($row) -fill $ofill
9399     $canv delete tag.$id
9400     set xt [eval drawtags $id $idpos($id)]
9401     $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9402     set text [$canv itemcget $linehtag($id) -text]
9403     set font [$canv itemcget $linehtag($id) -font]
9404     set xr [expr {$xt + [font measure $font $text]}]
9405     if {$xr > $canvxmax} {
9406         set canvxmax $xr
9407         setcanvscroll
9408     }
9409     if {[info exists currentid] && $currentid == $id} {
9410         make_secsel $id
9411     }
9412     if {[info exists markedid] && $markedid eq $id} {
9413         make_idmark $id
9414     }
9415 }
9416
9417 proc mktagcan {} {
9418     global mktagtop
9419
9420     catch {destroy $mktagtop}
9421     unset mktagtop
9422 }
9423
9424 proc mktaggo {} {
9425     if {![domktag]} return
9426     mktagcan
9427 }
9428
9429 proc copysummary {} {
9430     global rowmenuid autosellen
9431
9432     set format "%h (\"%s\", %ad)"
9433     set cmd [list git show -s --pretty=format:$format --date=short]
9434     if {$autosellen < 40} {
9435         lappend cmd --abbrev=$autosellen
9436     }
9437     set summary [eval exec $cmd $rowmenuid]
9438
9439     clipboard clear
9440     clipboard append $summary
9441 }
9442
9443 proc writecommit {} {
9444     global rowmenuid wrcomtop commitinfo wrcomcmd NS
9445
9446     set top .writecommit
9447     set wrcomtop $top
9448     catch {destroy $top}
9449     ttk_toplevel $top
9450     make_transient $top .
9451     ${NS}::label $top.title -text [mc "Write commit to file"]
9452     grid $top.title - -pady 10
9453     ${NS}::label $top.id -text [mc "ID:"]
9454     ${NS}::entry $top.sha1 -width 40
9455     $top.sha1 insert 0 $rowmenuid
9456     $top.sha1 conf -state readonly
9457     grid $top.id $top.sha1 -sticky w
9458     ${NS}::entry $top.head -width 60
9459     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9460     $top.head conf -state readonly
9461     grid x $top.head -sticky w
9462     ${NS}::label $top.clab -text [mc "Command:"]
9463     ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9464     grid $top.clab $top.cmd -sticky w -pady 10
9465     ${NS}::label $top.flab -text [mc "Output file:"]
9466     ${NS}::entry $top.fname -width 60
9467     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9468     grid $top.flab $top.fname -sticky w
9469     ${NS}::frame $top.buts
9470     ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9471     ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9472     bind $top <Key-Return> wrcomgo
9473     bind $top <Key-Escape> wrcomcan
9474     grid $top.buts.gen $top.buts.can
9475     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9476     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9477     grid $top.buts - -pady 10 -sticky ew
9478     focus $top.fname
9479 }
9480
9481 proc wrcomgo {} {
9482     global wrcomtop
9483
9484     set id [$wrcomtop.sha1 get]
9485     set cmd "echo $id | [$wrcomtop.cmd get]"
9486     set fname [$wrcomtop.fname get]
9487     if {[catch {exec sh -c $cmd >$fname &} err]} {
9488         error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9489     }
9490     catch {destroy $wrcomtop}
9491     unset wrcomtop
9492 }
9493
9494 proc wrcomcan {} {
9495     global wrcomtop
9496
9497     catch {destroy $wrcomtop}
9498     unset wrcomtop
9499 }
9500
9501 proc mkbranch {} {
9502     global NS rowmenuid
9503
9504     set top .branchdialog
9505
9506     set val(name) ""
9507     set val(id) $rowmenuid
9508     set val(command) [list mkbrgo $top]
9509
9510     set ui(title) [mc "Create branch"]
9511     set ui(accept) [mc "Create"]
9512
9513     branchdia $top val ui
9514 }
9515
9516 proc mvbranch {} {
9517     global NS
9518     global headmenuid headmenuhead
9519
9520     set top .branchdialog
9521
9522     set val(name) $headmenuhead
9523     set val(id) $headmenuid
9524     set val(command) [list mvbrgo $top $headmenuhead]
9525
9526     set ui(title) [mc "Rename branch %s" $headmenuhead]
9527     set ui(accept) [mc "Rename"]
9528
9529     branchdia $top val ui
9530 }
9531
9532 proc branchdia {top valvar uivar} {
9533     global NS commitinfo
9534     upvar $valvar val $uivar ui
9535
9536     catch {destroy $top}
9537     ttk_toplevel $top
9538     make_transient $top .
9539     ${NS}::label $top.title -text $ui(title)
9540     grid $top.title - -pady 10
9541     ${NS}::label $top.id -text [mc "ID:"]
9542     ${NS}::entry $top.sha1 -width 40
9543     $top.sha1 insert 0 $val(id)
9544     $top.sha1 conf -state readonly
9545     grid $top.id $top.sha1 -sticky w
9546     ${NS}::entry $top.head -width 60
9547     $top.head insert 0 [lindex $commitinfo($val(id)) 0]
9548     $top.head conf -state readonly
9549     grid x $top.head -sticky ew
9550     grid columnconfigure $top 1 -weight 1
9551     ${NS}::label $top.nlab -text [mc "Name:"]
9552     ${NS}::entry $top.name -width 40
9553     $top.name insert 0 $val(name)
9554     grid $top.nlab $top.name -sticky w
9555     ${NS}::frame $top.buts
9556     ${NS}::button $top.buts.go -text $ui(accept) -command $val(command)
9557     ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9558     bind $top <Key-Return> $val(command)
9559     bind $top <Key-Escape> "catch {destroy $top}"
9560     grid $top.buts.go $top.buts.can
9561     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9562     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9563     grid $top.buts - -pady 10 -sticky ew
9564     focus $top.name
9565 }
9566
9567 proc mkbrgo {top} {
9568     global headids idheads
9569
9570     set name [$top.name get]
9571     set id [$top.sha1 get]
9572     set cmdargs {}
9573     set old_id {}
9574     if {$name eq {}} {
9575         error_popup [mc "Please specify a name for the new branch"] $top
9576         return
9577     }
9578     if {[info exists headids($name)]} {
9579         if {![confirm_popup [mc \
9580                 "Branch '%s' already exists. Overwrite?" $name] $top]} {
9581             return
9582         }
9583         set old_id $headids($name)
9584         lappend cmdargs -f
9585     }
9586     catch {destroy $top}
9587     lappend cmdargs $name $id
9588     nowbusy newbranch
9589     update
9590     if {[catch {
9591         eval exec git branch $cmdargs
9592     } err]} {
9593         notbusy newbranch
9594         error_popup $err
9595     } else {
9596         notbusy newbranch
9597         if {$old_id ne {}} {
9598             movehead $id $name
9599             movedhead $id $name
9600             redrawtags $old_id
9601             redrawtags $id
9602         } else {
9603             set headids($name) $id
9604             lappend idheads($id) $name
9605             addedhead $id $name
9606             redrawtags $id
9607         }
9608         dispneartags 0
9609         run refill_reflist
9610     }
9611 }
9612
9613 proc mvbrgo {top prevname} {
9614     global headids idheads mainhead mainheadid
9615
9616     set name [$top.name get]
9617     set id [$top.sha1 get]
9618     set cmdargs {}
9619     if {$name eq $prevname} {
9620         catch {destroy $top}
9621         return
9622     }
9623     if {$name eq {}} {
9624         error_popup [mc "Please specify a new name for the branch"] $top
9625         return
9626     }
9627     catch {destroy $top}
9628     lappend cmdargs -m $prevname $name
9629     nowbusy renamebranch
9630     update
9631     if {[catch {
9632         eval exec git branch $cmdargs
9633     } err]} {
9634         notbusy renamebranch
9635         error_popup $err
9636     } else {
9637         notbusy renamebranch
9638         removehead $id $prevname
9639         removedhead $id $prevname
9640         set headids($name) $id
9641         lappend idheads($id) $name
9642         addedhead $id $name
9643         if {$prevname eq $mainhead} {
9644             set mainhead $name
9645             set mainheadid $id
9646         }
9647         redrawtags $id
9648         dispneartags 0
9649         run refill_reflist
9650     }
9651 }
9652
9653 proc exec_citool {tool_args {baseid {}}} {
9654     global commitinfo env
9655
9656     set save_env [array get env GIT_AUTHOR_*]
9657
9658     if {$baseid ne {}} {
9659         if {![info exists commitinfo($baseid)]} {
9660             getcommit $baseid
9661         }
9662         set author [lindex $commitinfo($baseid) 1]
9663         set date [lindex $commitinfo($baseid) 2]
9664         if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9665                     $author author name email]
9666             && $date ne {}} {
9667             set env(GIT_AUTHOR_NAME) $name
9668             set env(GIT_AUTHOR_EMAIL) $email
9669             set env(GIT_AUTHOR_DATE) $date
9670         }
9671     }
9672
9673     eval exec git citool $tool_args &
9674
9675     array unset env GIT_AUTHOR_*
9676     array set env $save_env
9677 }
9678
9679 proc cherrypick {} {
9680     global rowmenuid curview
9681     global mainhead mainheadid
9682     global gitdir
9683
9684     set oldhead [exec git rev-parse HEAD]
9685     set dheads [descheads $rowmenuid]
9686     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9687         set ok [confirm_popup [mc "Commit %s is already\
9688                 included in branch %s -- really re-apply it?" \
9689                                    [string range $rowmenuid 0 7] $mainhead]]
9690         if {!$ok} return
9691     }
9692     nowbusy cherrypick [mc "Cherry-picking"]
9693     update
9694     # Unfortunately git-cherry-pick writes stuff to stderr even when
9695     # no error occurs, and exec takes that as an indication of error...
9696     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9697         notbusy cherrypick
9698         if {[regexp -line \
9699                  {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9700                  $err msg fname]} {
9701             error_popup [mc "Cherry-pick failed because of local changes\
9702                         to file '%s'.\nPlease commit, reset or stash\
9703                         your changes and try again." $fname]
9704         } elseif {[regexp -line \
9705                        {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9706                        $err]} {
9707             if {[confirm_popup [mc "Cherry-pick failed because of merge\
9708                         conflict.\nDo you wish to run git citool to\
9709                         resolve it?"]]} {
9710                 # Force citool to read MERGE_MSG
9711                 file delete [file join $gitdir "GITGUI_MSG"]
9712                 exec_citool {} $rowmenuid
9713             }
9714         } else {
9715             error_popup $err
9716         }
9717         run updatecommits
9718         return
9719     }
9720     set newhead [exec git rev-parse HEAD]
9721     if {$newhead eq $oldhead} {
9722         notbusy cherrypick
9723         error_popup [mc "No changes committed"]
9724         return
9725     }
9726     addnewchild $newhead $oldhead
9727     if {[commitinview $oldhead $curview]} {
9728         # XXX this isn't right if we have a path limit...
9729         insertrow $newhead $oldhead $curview
9730         if {$mainhead ne {}} {
9731             movehead $newhead $mainhead
9732             movedhead $newhead $mainhead
9733         }
9734         set mainheadid $newhead
9735         redrawtags $oldhead
9736         redrawtags $newhead
9737         selbyid $newhead
9738     }
9739     notbusy cherrypick
9740 }
9741
9742 proc revert {} {
9743     global rowmenuid curview
9744     global mainhead mainheadid
9745     global gitdir
9746
9747     set oldhead [exec git rev-parse HEAD]
9748     set dheads [descheads $rowmenuid]
9749     if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9750        set ok [confirm_popup [mc "Commit %s is not\
9751            included in branch %s -- really revert it?" \
9752                       [string range $rowmenuid 0 7] $mainhead]]
9753        if {!$ok} return
9754     }
9755     nowbusy revert [mc "Reverting"]
9756     update
9757
9758     if [catch {exec git revert --no-edit $rowmenuid} err] {
9759         notbusy revert
9760         if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9761                 $err match files] {
9762             regsub {\n( |\t)+} $files "\n" files
9763             error_popup [mc "Revert failed because of local changes to\
9764                 the following files:%s Please commit, reset or stash \
9765                 your changes and try again." $files]
9766         } elseif [regexp {error: could not revert} $err] {
9767             if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9768                 Do you wish to run git citool to resolve it?"]] {
9769                 # Force citool to read MERGE_MSG
9770                 file delete [file join $gitdir "GITGUI_MSG"]
9771                 exec_citool {} $rowmenuid
9772             }
9773         } else { error_popup $err }
9774         run updatecommits
9775         return
9776     }
9777
9778     set newhead [exec git rev-parse HEAD]
9779     if { $newhead eq $oldhead } {
9780         notbusy revert
9781         error_popup [mc "No changes committed"]
9782         return
9783     }
9784
9785     addnewchild $newhead $oldhead
9786
9787     if [commitinview $oldhead $curview] {
9788         # XXX this isn't right if we have a path limit...
9789         insertrow $newhead $oldhead $curview
9790         if {$mainhead ne {}} {
9791             movehead $newhead $mainhead
9792             movedhead $newhead $mainhead
9793         }
9794         set mainheadid $newhead
9795         redrawtags $oldhead
9796         redrawtags $newhead
9797         selbyid $newhead
9798     }
9799
9800     notbusy revert
9801 }
9802
9803 proc resethead {} {
9804     global mainhead rowmenuid confirm_ok resettype NS
9805
9806     set confirm_ok 0
9807     set w ".confirmreset"
9808     ttk_toplevel $w
9809     make_transient $w .
9810     wm title $w [mc "Confirm reset"]
9811     ${NS}::label $w.m -text \
9812         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9813     pack $w.m -side top -fill x -padx 20 -pady 20
9814     ${NS}::labelframe $w.f -text [mc "Reset type:"]
9815     set resettype mixed
9816     ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9817         -text [mc "Soft: Leave working tree and index untouched"]
9818     grid $w.f.soft -sticky w
9819     ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9820         -text [mc "Mixed: Leave working tree untouched, reset index"]
9821     grid $w.f.mixed -sticky w
9822     ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9823         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9824     grid $w.f.hard -sticky w
9825     pack $w.f -side top -fill x -padx 4
9826     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9827     pack $w.ok -side left -fill x -padx 20 -pady 20
9828     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9829     bind $w <Key-Escape> [list destroy $w]
9830     pack $w.cancel -side right -fill x -padx 20 -pady 20
9831     bind $w <Visibility> "grab $w; focus $w"
9832     tkwait window $w
9833     if {!$confirm_ok} return
9834     if {[catch {set fd [open \
9835             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9836         error_popup $err
9837     } else {
9838         dohidelocalchanges
9839         filerun $fd [list readresetstat $fd]
9840         nowbusy reset [mc "Resetting"]
9841         selbyid $rowmenuid
9842     }
9843 }
9844
9845 proc readresetstat {fd} {
9846     global mainhead mainheadid showlocalchanges rprogcoord
9847
9848     if {[gets $fd line] >= 0} {
9849         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9850             set rprogcoord [expr {1.0 * $m / $n}]
9851             adjustprogress
9852         }
9853         return 1
9854     }
9855     set rprogcoord 0
9856     adjustprogress
9857     notbusy reset
9858     if {[catch {close $fd} err]} {
9859         error_popup $err
9860     }
9861     set oldhead $mainheadid
9862     set newhead [exec git rev-parse HEAD]
9863     if {$newhead ne $oldhead} {
9864         movehead $newhead $mainhead
9865         movedhead $newhead $mainhead
9866         set mainheadid $newhead
9867         redrawtags $oldhead
9868         redrawtags $newhead
9869     }
9870     if {$showlocalchanges} {
9871         doshowlocalchanges
9872     }
9873     return 0
9874 }
9875
9876 # context menu for a head
9877 proc headmenu {x y id head} {
9878     global headmenuid headmenuhead headctxmenu mainhead headids
9879
9880     stopfinding
9881     set headmenuid $id
9882     set headmenuhead $head
9883     array set state {0 normal 1 normal 2 normal}
9884     if {[string match "remotes/*" $head]} {
9885         set localhead [string range $head [expr [string last / $head] + 1] end]
9886         if {[info exists headids($localhead)]} {
9887             set state(0) disabled
9888         }
9889         array set state {1 disabled 2 disabled}
9890     }
9891     if {$head eq $mainhead} {
9892         array set state {0 disabled 2 disabled}
9893     }
9894     foreach i {0 1 2} {
9895         $headctxmenu entryconfigure $i -state $state($i)
9896     }
9897     tk_popup $headctxmenu $x $y
9898 }
9899
9900 proc cobranch {} {
9901     global headmenuid headmenuhead headids
9902     global showlocalchanges
9903
9904     # check the tree is clean first??
9905     set newhead $headmenuhead
9906     set command [list | git checkout]
9907     if {[string match "remotes/*" $newhead]} {
9908         set remote $newhead
9909         set newhead [string range $newhead [expr [string last / $newhead] + 1] end]
9910         # The following check is redundant - the menu option should
9911         # be disabled to begin with...
9912         if {[info exists headids($newhead)]} {
9913             error_popup [mc "A local branch named %s exists already" $newhead]
9914             return
9915         }
9916         lappend command -b $newhead --track $remote
9917     } else {
9918         lappend command $newhead
9919     }
9920     lappend command 2>@1
9921     nowbusy checkout [mc "Checking out"]
9922     update
9923     dohidelocalchanges
9924     if {[catch {
9925         set fd [open $command r]
9926     } err]} {
9927         notbusy checkout
9928         error_popup $err
9929         if {$showlocalchanges} {
9930             dodiffindex
9931         }
9932     } else {
9933         filerun $fd [list readcheckoutstat $fd $newhead $headmenuid]
9934     }
9935 }
9936
9937 proc readcheckoutstat {fd newhead newheadid} {
9938     global mainhead mainheadid headids idheads showlocalchanges progresscoords
9939     global viewmainheadid curview
9940
9941     if {[gets $fd line] >= 0} {
9942         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9943             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9944             adjustprogress
9945         }
9946         return 1
9947     }
9948     set progresscoords {0 0}
9949     adjustprogress
9950     notbusy checkout
9951     if {[catch {close $fd} err]} {
9952         error_popup $err
9953         return
9954     }
9955     set oldmainid $mainheadid
9956     if {! [info exists headids($newhead)]} {
9957         set headids($newhead) $newheadid
9958         lappend idheads($newheadid) $newhead
9959         addedhead $newheadid $newhead
9960     }
9961     set mainhead $newhead
9962     set mainheadid $newheadid
9963     set viewmainheadid($curview) $newheadid
9964     redrawtags $oldmainid
9965     redrawtags $newheadid
9966     selbyid $newheadid
9967     if {$showlocalchanges} {
9968         dodiffindex
9969     }
9970 }
9971
9972 proc rmbranch {} {
9973     global headmenuid headmenuhead mainhead
9974     global idheads
9975
9976     set head $headmenuhead
9977     set id $headmenuid
9978     # this check shouldn't be needed any more...
9979     if {$head eq $mainhead} {
9980         error_popup [mc "Cannot delete the currently checked-out branch"]
9981         return
9982     }
9983     set dheads [descheads $id]
9984     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9985         # the stuff on this branch isn't on any other branch
9986         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9987                         branch.\nReally delete branch %s?" $head $head]]} return
9988     }
9989     nowbusy rmbranch
9990     update
9991     if {[catch {exec git branch -D $head} err]} {
9992         notbusy rmbranch
9993         error_popup $err
9994         return
9995     }
9996     removehead $id $head
9997     removedhead $id $head
9998     redrawtags $id
9999     notbusy rmbranch
10000     dispneartags 0
10001     run refill_reflist
10002 }
10003
10004 # Display a list of tags and heads
10005 proc showrefs {} {
10006     global showrefstop bgcolor fgcolor selectbgcolor NS
10007     global bglist fglist reflistfilter reflist maincursor
10008
10009     set top .showrefs
10010     set showrefstop $top
10011     if {[winfo exists $top]} {
10012         raise $top
10013         refill_reflist
10014         return
10015     }
10016     ttk_toplevel $top
10017     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
10018     make_transient $top .
10019     text $top.list -background $bgcolor -foreground $fgcolor \
10020         -selectbackground $selectbgcolor -font mainfont \
10021         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
10022         -width 30 -height 20 -cursor $maincursor \
10023         -spacing1 1 -spacing3 1 -state disabled
10024     $top.list tag configure highlight -background $selectbgcolor
10025     if {![lsearch -exact $bglist $top.list]} {
10026         lappend bglist $top.list
10027         lappend fglist $top.list
10028     }
10029     ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
10030     ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
10031     grid $top.list $top.ysb -sticky nsew
10032     grid $top.xsb x -sticky ew
10033     ${NS}::frame $top.f
10034     ${NS}::label $top.f.l -text "[mc "Filter"]: "
10035     ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
10036     set reflistfilter "*"
10037     trace add variable reflistfilter write reflistfilter_change
10038     pack $top.f.e -side right -fill x -expand 1
10039     pack $top.f.l -side left
10040     grid $top.f - -sticky ew -pady 2
10041     ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
10042     bind $top <Key-Escape> [list destroy $top]
10043     grid $top.close -
10044     grid columnconfigure $top 0 -weight 1
10045     grid rowconfigure $top 0 -weight 1
10046     bind $top.list <1> {break}
10047     bind $top.list <B1-Motion> {break}
10048     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
10049     set reflist {}
10050     refill_reflist
10051 }
10052
10053 proc sel_reflist {w x y} {
10054     global showrefstop reflist headids tagids otherrefids
10055
10056     if {![winfo exists $showrefstop]} return
10057     set l [lindex [split [$w index "@$x,$y"] "."] 0]
10058     set ref [lindex $reflist [expr {$l-1}]]
10059     set n [lindex $ref 0]
10060     switch -- [lindex $ref 1] {
10061         "H" {selbyid $headids($n)}
10062         "R" {selbyid $headids($n)}
10063         "T" {selbyid $tagids($n)}
10064         "o" {selbyid $otherrefids($n)}
10065     }
10066     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
10067 }
10068
10069 proc unsel_reflist {} {
10070     global showrefstop
10071
10072     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10073     $showrefstop.list tag remove highlight 0.0 end
10074 }
10075
10076 proc reflistfilter_change {n1 n2 op} {
10077     global reflistfilter
10078
10079     after cancel refill_reflist
10080     after 200 refill_reflist
10081 }
10082
10083 proc refill_reflist {} {
10084     global reflist reflistfilter showrefstop headids tagids otherrefids
10085     global curview
10086
10087     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10088     set refs {}
10089     foreach n [array names headids] {
10090         if {[string match $reflistfilter $n]} {
10091             if {[commitinview $headids($n) $curview]} {
10092                 if {[string match "remotes/*" $n]} {
10093                     lappend refs [list $n R]
10094                 } else {
10095                     lappend refs [list $n H]
10096                 }
10097             } else {
10098                 interestedin $headids($n) {run refill_reflist}
10099             }
10100         }
10101     }
10102     foreach n [array names tagids] {
10103         if {[string match $reflistfilter $n]} {
10104             if {[commitinview $tagids($n) $curview]} {
10105                 lappend refs [list $n T]
10106             } else {
10107                 interestedin $tagids($n) {run refill_reflist}
10108             }
10109         }
10110     }
10111     foreach n [array names otherrefids] {
10112         if {[string match $reflistfilter $n]} {
10113             if {[commitinview $otherrefids($n) $curview]} {
10114                 lappend refs [list $n o]
10115             } else {
10116                 interestedin $otherrefids($n) {run refill_reflist}
10117             }
10118         }
10119     }
10120     set refs [lsort -index 0 $refs]
10121     if {$refs eq $reflist} return
10122
10123     # Update the contents of $showrefstop.list according to the
10124     # differences between $reflist (old) and $refs (new)
10125     $showrefstop.list conf -state normal
10126     $showrefstop.list insert end "\n"
10127     set i 0
10128     set j 0
10129     while {$i < [llength $reflist] || $j < [llength $refs]} {
10130         if {$i < [llength $reflist]} {
10131             if {$j < [llength $refs]} {
10132                 set cmp [string compare [lindex $reflist $i 0] \
10133                              [lindex $refs $j 0]]
10134                 if {$cmp == 0} {
10135                     set cmp [string compare [lindex $reflist $i 1] \
10136                                  [lindex $refs $j 1]]
10137                 }
10138             } else {
10139                 set cmp -1
10140             }
10141         } else {
10142             set cmp 1
10143         }
10144         switch -- $cmp {
10145             -1 {
10146                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
10147                 incr i
10148             }
10149             0 {
10150                 incr i
10151                 incr j
10152             }
10153             1 {
10154                 set l [expr {$j + 1}]
10155                 $showrefstop.list image create $l.0 -align baseline \
10156                     -image reficon-[lindex $refs $j 1] -padx 2
10157                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
10158                 incr j
10159             }
10160         }
10161     }
10162     set reflist $refs
10163     # delete last newline
10164     $showrefstop.list delete end-2c end-1c
10165     $showrefstop.list conf -state disabled
10166 }
10167
10168 # Stuff for finding nearby tags
10169 proc getallcommits {} {
10170     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
10171     global idheads idtags idotherrefs allparents tagobjid
10172     global gitdir
10173
10174     if {![info exists allcommits]} {
10175         set nextarc 0
10176         set allcommits 0
10177         set seeds {}
10178         set allcwait 0
10179         set cachedarcs 0
10180         set allccache [file join $gitdir "gitk.cache"]
10181         if {![catch {
10182             set f [open $allccache r]
10183             set allcwait 1
10184             getcache $f
10185         }]} return
10186     }
10187
10188     if {$allcwait} {
10189         return
10190     }
10191     set cmd [list | git rev-list --parents]
10192     set allcupdate [expr {$seeds ne {}}]
10193     if {!$allcupdate} {
10194         set ids "--all"
10195     } else {
10196         set refs [concat [array names idheads] [array names idtags] \
10197                       [array names idotherrefs]]
10198         set ids {}
10199         set tagobjs {}
10200         foreach name [array names tagobjid] {
10201             lappend tagobjs $tagobjid($name)
10202         }
10203         foreach id [lsort -unique $refs] {
10204             if {![info exists allparents($id)] &&
10205                 [lsearch -exact $tagobjs $id] < 0} {
10206                 lappend ids $id
10207             }
10208         }
10209         if {$ids ne {}} {
10210             foreach id $seeds {
10211                 lappend ids "^$id"
10212             }
10213         }
10214     }
10215     if {$ids ne {}} {
10216         set fd [open [concat $cmd $ids] r]
10217         fconfigure $fd -blocking 0
10218         incr allcommits
10219         nowbusy allcommits
10220         filerun $fd [list getallclines $fd]
10221     } else {
10222         dispneartags 0
10223     }
10224 }
10225
10226 # Since most commits have 1 parent and 1 child, we group strings of
10227 # such commits into "arcs" joining branch/merge points (BMPs), which
10228 # are commits that either don't have 1 parent or don't have 1 child.
10229 #
10230 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
10231 # arcout(id) - outgoing arcs for BMP
10232 # arcids(a) - list of IDs on arc including end but not start
10233 # arcstart(a) - BMP ID at start of arc
10234 # arcend(a) - BMP ID at end of arc
10235 # growing(a) - arc a is still growing
10236 # arctags(a) - IDs out of arcids (excluding end) that have tags
10237 # archeads(a) - IDs out of arcids (excluding end) that have heads
10238 # The start of an arc is at the descendent end, so "incoming" means
10239 # coming from descendents, and "outgoing" means going towards ancestors.
10240
10241 proc getallclines {fd} {
10242     global allparents allchildren idtags idheads nextarc
10243     global arcnos arcids arctags arcout arcend arcstart archeads growing
10244     global seeds allcommits cachedarcs allcupdate
10245
10246     set nid 0
10247     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
10248         set id [lindex $line 0]
10249         if {[info exists allparents($id)]} {
10250             # seen it already
10251             continue
10252         }
10253         set cachedarcs 0
10254         set olds [lrange $line 1 end]
10255         set allparents($id) $olds
10256         if {![info exists allchildren($id)]} {
10257             set allchildren($id) {}
10258             set arcnos($id) {}
10259             lappend seeds $id
10260         } else {
10261             set a $arcnos($id)
10262             if {[llength $olds] == 1 && [llength $a] == 1} {
10263                 lappend arcids($a) $id
10264                 if {[info exists idtags($id)]} {
10265                     lappend arctags($a) $id
10266                 }
10267                 if {[info exists idheads($id)]} {
10268                     lappend archeads($a) $id
10269                 }
10270                 if {[info exists allparents($olds)]} {
10271                     # seen parent already
10272                     if {![info exists arcout($olds)]} {
10273                         splitarc $olds
10274                     }
10275                     lappend arcids($a) $olds
10276                     set arcend($a) $olds
10277                     unset growing($a)
10278                 }
10279                 lappend allchildren($olds) $id
10280                 lappend arcnos($olds) $a
10281                 continue
10282             }
10283         }
10284         foreach a $arcnos($id) {
10285             lappend arcids($a) $id
10286             set arcend($a) $id
10287             unset growing($a)
10288         }
10289
10290         set ao {}
10291         foreach p $olds {
10292             lappend allchildren($p) $id
10293             set a [incr nextarc]
10294             set arcstart($a) $id
10295             set archeads($a) {}
10296             set arctags($a) {}
10297             set archeads($a) {}
10298             set arcids($a) {}
10299             lappend ao $a
10300             set growing($a) 1
10301             if {[info exists allparents($p)]} {
10302                 # seen it already, may need to make a new branch
10303                 if {![info exists arcout($p)]} {
10304                     splitarc $p
10305                 }
10306                 lappend arcids($a) $p
10307                 set arcend($a) $p
10308                 unset growing($a)
10309             }
10310             lappend arcnos($p) $a
10311         }
10312         set arcout($id) $ao
10313     }
10314     if {$nid > 0} {
10315         global cached_dheads cached_dtags cached_atags
10316         unset -nocomplain cached_dheads
10317         unset -nocomplain cached_dtags
10318         unset -nocomplain cached_atags
10319     }
10320     if {![eof $fd]} {
10321         return [expr {$nid >= 1000? 2: 1}]
10322     }
10323     set cacheok 1
10324     if {[catch {
10325         fconfigure $fd -blocking 1
10326         close $fd
10327     } err]} {
10328         # got an error reading the list of commits
10329         # if we were updating, try rereading the whole thing again
10330         if {$allcupdate} {
10331             incr allcommits -1
10332             dropcache $err
10333             return
10334         }
10335         error_popup "[mc "Error reading commit topology information;\
10336                 branch and preceding/following tag information\
10337                 will be incomplete."]\n($err)"
10338         set cacheok 0
10339     }
10340     if {[incr allcommits -1] == 0} {
10341         notbusy allcommits
10342         if {$cacheok} {
10343             run savecache
10344         }
10345     }
10346     dispneartags 0
10347     return 0
10348 }
10349
10350 proc recalcarc {a} {
10351     global arctags archeads arcids idtags idheads
10352
10353     set at {}
10354     set ah {}
10355     foreach id [lrange $arcids($a) 0 end-1] {
10356         if {[info exists idtags($id)]} {
10357             lappend at $id
10358         }
10359         if {[info exists idheads($id)]} {
10360             lappend ah $id
10361         }
10362     }
10363     set arctags($a) $at
10364     set archeads($a) $ah
10365 }
10366
10367 proc splitarc {p} {
10368     global arcnos arcids nextarc arctags archeads idtags idheads
10369     global arcstart arcend arcout allparents growing
10370
10371     set a $arcnos($p)
10372     if {[llength $a] != 1} {
10373         puts "oops splitarc called but [llength $a] arcs already"
10374         return
10375     }
10376     set a [lindex $a 0]
10377     set i [lsearch -exact $arcids($a) $p]
10378     if {$i < 0} {
10379         puts "oops splitarc $p not in arc $a"
10380         return
10381     }
10382     set na [incr nextarc]
10383     if {[info exists arcend($a)]} {
10384         set arcend($na) $arcend($a)
10385     } else {
10386         set l [lindex $allparents([lindex $arcids($a) end]) 0]
10387         set j [lsearch -exact $arcnos($l) $a]
10388         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10389     }
10390     set tail [lrange $arcids($a) [expr {$i+1}] end]
10391     set arcids($a) [lrange $arcids($a) 0 $i]
10392     set arcend($a) $p
10393     set arcstart($na) $p
10394     set arcout($p) $na
10395     set arcids($na) $tail
10396     if {[info exists growing($a)]} {
10397         set growing($na) 1
10398         unset growing($a)
10399     }
10400
10401     foreach id $tail {
10402         if {[llength $arcnos($id)] == 1} {
10403             set arcnos($id) $na
10404         } else {
10405             set j [lsearch -exact $arcnos($id) $a]
10406             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10407         }
10408     }
10409
10410     # reconstruct tags and heads lists
10411     if {$arctags($a) ne {} || $archeads($a) ne {}} {
10412         recalcarc $a
10413         recalcarc $na
10414     } else {
10415         set arctags($na) {}
10416         set archeads($na) {}
10417     }
10418 }
10419
10420 # Update things for a new commit added that is a child of one
10421 # existing commit.  Used when cherry-picking.
10422 proc addnewchild {id p} {
10423     global allparents allchildren idtags nextarc
10424     global arcnos arcids arctags arcout arcend arcstart archeads growing
10425     global seeds allcommits
10426
10427     if {![info exists allcommits] || ![info exists arcnos($p)]} return
10428     set allparents($id) [list $p]
10429     set allchildren($id) {}
10430     set arcnos($id) {}
10431     lappend seeds $id
10432     lappend allchildren($p) $id
10433     set a [incr nextarc]
10434     set arcstart($a) $id
10435     set archeads($a) {}
10436     set arctags($a) {}
10437     set arcids($a) [list $p]
10438     set arcend($a) $p
10439     if {![info exists arcout($p)]} {
10440         splitarc $p
10441     }
10442     lappend arcnos($p) $a
10443     set arcout($id) [list $a]
10444 }
10445
10446 # This implements a cache for the topology information.
10447 # The cache saves, for each arc, the start and end of the arc,
10448 # the ids on the arc, and the outgoing arcs from the end.
10449 proc readcache {f} {
10450     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10451     global idtags idheads allparents cachedarcs possible_seeds seeds growing
10452     global allcwait
10453
10454     set a $nextarc
10455     set lim $cachedarcs
10456     if {$lim - $a > 500} {
10457         set lim [expr {$a + 500}]
10458     }
10459     if {[catch {
10460         if {$a == $lim} {
10461             # finish reading the cache and setting up arctags, etc.
10462             set line [gets $f]
10463             if {$line ne "1"} {error "bad final version"}
10464             close $f
10465             foreach id [array names idtags] {
10466                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10467                     [llength $allparents($id)] == 1} {
10468                     set a [lindex $arcnos($id) 0]
10469                     if {$arctags($a) eq {}} {
10470                         recalcarc $a
10471                     }
10472                 }
10473             }
10474             foreach id [array names idheads] {
10475                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10476                     [llength $allparents($id)] == 1} {
10477                     set a [lindex $arcnos($id) 0]
10478                     if {$archeads($a) eq {}} {
10479                         recalcarc $a
10480                     }
10481                 }
10482             }
10483             foreach id [lsort -unique $possible_seeds] {
10484                 if {$arcnos($id) eq {}} {
10485                     lappend seeds $id
10486                 }
10487             }
10488             set allcwait 0
10489         } else {
10490             while {[incr a] <= $lim} {
10491                 set line [gets $f]
10492                 if {[llength $line] != 3} {error "bad line"}
10493                 set s [lindex $line 0]
10494                 set arcstart($a) $s
10495                 lappend arcout($s) $a
10496                 if {![info exists arcnos($s)]} {
10497                     lappend possible_seeds $s
10498                     set arcnos($s) {}
10499                 }
10500                 set e [lindex $line 1]
10501                 if {$e eq {}} {
10502                     set growing($a) 1
10503                 } else {
10504                     set arcend($a) $e
10505                     if {![info exists arcout($e)]} {
10506                         set arcout($e) {}
10507                     }
10508                 }
10509                 set arcids($a) [lindex $line 2]
10510                 foreach id $arcids($a) {
10511                     lappend allparents($s) $id
10512                     set s $id
10513                     lappend arcnos($id) $a
10514                 }
10515                 if {![info exists allparents($s)]} {
10516                     set allparents($s) {}
10517                 }
10518                 set arctags($a) {}
10519                 set archeads($a) {}
10520             }
10521             set nextarc [expr {$a - 1}]
10522         }
10523     } err]} {
10524         dropcache $err
10525         return 0
10526     }
10527     if {!$allcwait} {
10528         getallcommits
10529     }
10530     return $allcwait
10531 }
10532
10533 proc getcache {f} {
10534     global nextarc cachedarcs possible_seeds
10535
10536     if {[catch {
10537         set line [gets $f]
10538         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10539         # make sure it's an integer
10540         set cachedarcs [expr {int([lindex $line 1])}]
10541         if {$cachedarcs < 0} {error "bad number of arcs"}
10542         set nextarc 0
10543         set possible_seeds {}
10544         run readcache $f
10545     } err]} {
10546         dropcache $err
10547     }
10548     return 0
10549 }
10550
10551 proc dropcache {err} {
10552     global allcwait nextarc cachedarcs seeds
10553
10554     #puts "dropping cache ($err)"
10555     foreach v {arcnos arcout arcids arcstart arcend growing \
10556                    arctags archeads allparents allchildren} {
10557         global $v
10558         unset -nocomplain $v
10559     }
10560     set allcwait 0
10561     set nextarc 0
10562     set cachedarcs 0
10563     set seeds {}
10564     getallcommits
10565 }
10566
10567 proc writecache {f} {
10568     global cachearc cachedarcs allccache
10569     global arcstart arcend arcnos arcids arcout
10570
10571     set a $cachearc
10572     set lim $cachedarcs
10573     if {$lim - $a > 1000} {
10574         set lim [expr {$a + 1000}]
10575     }
10576     if {[catch {
10577         while {[incr a] <= $lim} {
10578             if {[info exists arcend($a)]} {
10579                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10580             } else {
10581                 puts $f [list $arcstart($a) {} $arcids($a)]
10582             }
10583         }
10584     } err]} {
10585         catch {close $f}
10586         catch {file delete $allccache}
10587         #puts "writing cache failed ($err)"
10588         return 0
10589     }
10590     set cachearc [expr {$a - 1}]
10591     if {$a > $cachedarcs} {
10592         puts $f "1"
10593         close $f
10594         return 0
10595     }
10596     return 1
10597 }
10598
10599 proc savecache {} {
10600     global nextarc cachedarcs cachearc allccache
10601
10602     if {$nextarc == $cachedarcs} return
10603     set cachearc 0
10604     set cachedarcs $nextarc
10605     catch {
10606         set f [open $allccache w]
10607         puts $f [list 1 $cachedarcs]
10608         run writecache $f
10609     }
10610 }
10611
10612 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10613 # or 0 if neither is true.
10614 proc anc_or_desc {a b} {
10615     global arcout arcstart arcend arcnos cached_isanc
10616
10617     if {$arcnos($a) eq $arcnos($b)} {
10618         # Both are on the same arc(s); either both are the same BMP,
10619         # or if one is not a BMP, the other is also not a BMP or is
10620         # the BMP at end of the arc (and it only has 1 incoming arc).
10621         # Or both can be BMPs with no incoming arcs.
10622         if {$a eq $b || $arcnos($a) eq {}} {
10623             return 0
10624         }
10625         # assert {[llength $arcnos($a)] == 1}
10626         set arc [lindex $arcnos($a) 0]
10627         set i [lsearch -exact $arcids($arc) $a]
10628         set j [lsearch -exact $arcids($arc) $b]
10629         if {$i < 0 || $i > $j} {
10630             return 1
10631         } else {
10632             return -1
10633         }
10634     }
10635
10636     if {![info exists arcout($a)]} {
10637         set arc [lindex $arcnos($a) 0]
10638         if {[info exists arcend($arc)]} {
10639             set aend $arcend($arc)
10640         } else {
10641             set aend {}
10642         }
10643         set a $arcstart($arc)
10644     } else {
10645         set aend $a
10646     }
10647     if {![info exists arcout($b)]} {
10648         set arc [lindex $arcnos($b) 0]
10649         if {[info exists arcend($arc)]} {
10650             set bend $arcend($arc)
10651         } else {
10652             set bend {}
10653         }
10654         set b $arcstart($arc)
10655     } else {
10656         set bend $b
10657     }
10658     if {$a eq $bend} {
10659         return 1
10660     }
10661     if {$b eq $aend} {
10662         return -1
10663     }
10664     if {[info exists cached_isanc($a,$bend)]} {
10665         if {$cached_isanc($a,$bend)} {
10666             return 1
10667         }
10668     }
10669     if {[info exists cached_isanc($b,$aend)]} {
10670         if {$cached_isanc($b,$aend)} {
10671             return -1
10672         }
10673         if {[info exists cached_isanc($a,$bend)]} {
10674             return 0
10675         }
10676     }
10677
10678     set todo [list $a $b]
10679     set anc($a) a
10680     set anc($b) b
10681     for {set i 0} {$i < [llength $todo]} {incr i} {
10682         set x [lindex $todo $i]
10683         if {$anc($x) eq {}} {
10684             continue
10685         }
10686         foreach arc $arcnos($x) {
10687             set xd $arcstart($arc)
10688             if {$xd eq $bend} {
10689                 set cached_isanc($a,$bend) 1
10690                 set cached_isanc($b,$aend) 0
10691                 return 1
10692             } elseif {$xd eq $aend} {
10693                 set cached_isanc($b,$aend) 1
10694                 set cached_isanc($a,$bend) 0
10695                 return -1
10696             }
10697             if {![info exists anc($xd)]} {
10698                 set anc($xd) $anc($x)
10699                 lappend todo $xd
10700             } elseif {$anc($xd) ne $anc($x)} {
10701                 set anc($xd) {}
10702             }
10703         }
10704     }
10705     set cached_isanc($a,$bend) 0
10706     set cached_isanc($b,$aend) 0
10707     return 0
10708 }
10709
10710 # This identifies whether $desc has an ancestor that is
10711 # a growing tip of the graph and which is not an ancestor of $anc
10712 # and returns 0 if so and 1 if not.
10713 # If we subsequently discover a tag on such a growing tip, and that
10714 # turns out to be a descendent of $anc (which it could, since we
10715 # don't necessarily see children before parents), then $desc
10716 # isn't a good choice to display as a descendent tag of
10717 # $anc (since it is the descendent of another tag which is
10718 # a descendent of $anc).  Similarly, $anc isn't a good choice to
10719 # display as a ancestor tag of $desc.
10720 #
10721 proc is_certain {desc anc} {
10722     global arcnos arcout arcstart arcend growing problems
10723
10724     set certain {}
10725     if {[llength $arcnos($anc)] == 1} {
10726         # tags on the same arc are certain
10727         if {$arcnos($desc) eq $arcnos($anc)} {
10728             return 1
10729         }
10730         if {![info exists arcout($anc)]} {
10731             # if $anc is partway along an arc, use the start of the arc instead
10732             set a [lindex $arcnos($anc) 0]
10733             set anc $arcstart($a)
10734         }
10735     }
10736     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10737         set x $desc
10738     } else {
10739         set a [lindex $arcnos($desc) 0]
10740         set x $arcend($a)
10741     }
10742     if {$x == $anc} {
10743         return 1
10744     }
10745     set anclist [list $x]
10746     set dl($x) 1
10747     set nnh 1
10748     set ngrowanc 0
10749     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10750         set x [lindex $anclist $i]
10751         if {$dl($x)} {
10752             incr nnh -1
10753         }
10754         set done($x) 1
10755         foreach a $arcout($x) {
10756             if {[info exists growing($a)]} {
10757                 if {![info exists growanc($x)] && $dl($x)} {
10758                     set growanc($x) 1
10759                     incr ngrowanc
10760                 }
10761             } else {
10762                 set y $arcend($a)
10763                 if {[info exists dl($y)]} {
10764                     if {$dl($y)} {
10765                         if {!$dl($x)} {
10766                             set dl($y) 0
10767                             if {![info exists done($y)]} {
10768                                 incr nnh -1
10769                             }
10770                             if {[info exists growanc($x)]} {
10771                                 incr ngrowanc -1
10772                             }
10773                             set xl [list $y]
10774                             for {set k 0} {$k < [llength $xl]} {incr k} {
10775                                 set z [lindex $xl $k]
10776                                 foreach c $arcout($z) {
10777                                     if {[info exists arcend($c)]} {
10778                                         set v $arcend($c)
10779                                         if {[info exists dl($v)] && $dl($v)} {
10780                                             set dl($v) 0
10781                                             if {![info exists done($v)]} {
10782                                                 incr nnh -1
10783                                             }
10784                                             if {[info exists growanc($v)]} {
10785                                                 incr ngrowanc -1
10786                                             }
10787                                             lappend xl $v
10788                                         }
10789                                     }
10790                                 }
10791                             }
10792                         }
10793                     }
10794                 } elseif {$y eq $anc || !$dl($x)} {
10795                     set dl($y) 0
10796                     lappend anclist $y
10797                 } else {
10798                     set dl($y) 1
10799                     lappend anclist $y
10800                     incr nnh
10801                 }
10802             }
10803         }
10804     }
10805     foreach x [array names growanc] {
10806         if {$dl($x)} {
10807             return 0
10808         }
10809         return 0
10810     }
10811     return 1
10812 }
10813
10814 proc validate_arctags {a} {
10815     global arctags idtags
10816
10817     set i -1
10818     set na $arctags($a)
10819     foreach id $arctags($a) {
10820         incr i
10821         if {![info exists idtags($id)]} {
10822             set na [lreplace $na $i $i]
10823             incr i -1
10824         }
10825     }
10826     set arctags($a) $na
10827 }
10828
10829 proc validate_archeads {a} {
10830     global archeads idheads
10831
10832     set i -1
10833     set na $archeads($a)
10834     foreach id $archeads($a) {
10835         incr i
10836         if {![info exists idheads($id)]} {
10837             set na [lreplace $na $i $i]
10838             incr i -1
10839         }
10840     }
10841     set archeads($a) $na
10842 }
10843
10844 # Return the list of IDs that have tags that are descendents of id,
10845 # ignoring IDs that are descendents of IDs already reported.
10846 proc desctags {id} {
10847     global arcnos arcstart arcids arctags idtags allparents
10848     global growing cached_dtags
10849
10850     if {![info exists allparents($id)]} {
10851         return {}
10852     }
10853     set t1 [clock clicks -milliseconds]
10854     set argid $id
10855     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10856         # part-way along an arc; check that arc first
10857         set a [lindex $arcnos($id) 0]
10858         if {$arctags($a) ne {}} {
10859             validate_arctags $a
10860             set i [lsearch -exact $arcids($a) $id]
10861             set tid {}
10862             foreach t $arctags($a) {
10863                 set j [lsearch -exact $arcids($a) $t]
10864                 if {$j >= $i} break
10865                 set tid $t
10866             }
10867             if {$tid ne {}} {
10868                 return $tid
10869             }
10870         }
10871         set id $arcstart($a)
10872         if {[info exists idtags($id)]} {
10873             return $id
10874         }
10875     }
10876     if {[info exists cached_dtags($id)]} {
10877         return $cached_dtags($id)
10878     }
10879
10880     set origid $id
10881     set todo [list $id]
10882     set queued($id) 1
10883     set nc 1
10884     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10885         set id [lindex $todo $i]
10886         set done($id) 1
10887         set ta [info exists hastaggedancestor($id)]
10888         if {!$ta} {
10889             incr nc -1
10890         }
10891         # ignore tags on starting node
10892         if {!$ta && $i > 0} {
10893             if {[info exists idtags($id)]} {
10894                 set tagloc($id) $id
10895                 set ta 1
10896             } elseif {[info exists cached_dtags($id)]} {
10897                 set tagloc($id) $cached_dtags($id)
10898                 set ta 1
10899             }
10900         }
10901         foreach a $arcnos($id) {
10902             set d $arcstart($a)
10903             if {!$ta && $arctags($a) ne {}} {
10904                 validate_arctags $a
10905                 if {$arctags($a) ne {}} {
10906                     lappend tagloc($id) [lindex $arctags($a) end]
10907                 }
10908             }
10909             if {$ta || $arctags($a) ne {}} {
10910                 set tomark [list $d]
10911                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10912                     set dd [lindex $tomark $j]
10913                     if {![info exists hastaggedancestor($dd)]} {
10914                         if {[info exists done($dd)]} {
10915                             foreach b $arcnos($dd) {
10916                                 lappend tomark $arcstart($b)
10917                             }
10918                             if {[info exists tagloc($dd)]} {
10919                                 unset tagloc($dd)
10920                             }
10921                         } elseif {[info exists queued($dd)]} {
10922                             incr nc -1
10923                         }
10924                         set hastaggedancestor($dd) 1
10925                     }
10926                 }
10927             }
10928             if {![info exists queued($d)]} {
10929                 lappend todo $d
10930                 set queued($d) 1
10931                 if {![info exists hastaggedancestor($d)]} {
10932                     incr nc
10933                 }
10934             }
10935         }
10936     }
10937     set tags {}
10938     foreach id [array names tagloc] {
10939         if {![info exists hastaggedancestor($id)]} {
10940             foreach t $tagloc($id) {
10941                 if {[lsearch -exact $tags $t] < 0} {
10942                     lappend tags $t
10943                 }
10944             }
10945         }
10946     }
10947     set t2 [clock clicks -milliseconds]
10948     set loopix $i
10949
10950     # remove tags that are descendents of other tags
10951     for {set i 0} {$i < [llength $tags]} {incr i} {
10952         set a [lindex $tags $i]
10953         for {set j 0} {$j < $i} {incr j} {
10954             set b [lindex $tags $j]
10955             set r [anc_or_desc $a $b]
10956             if {$r == 1} {
10957                 set tags [lreplace $tags $j $j]
10958                 incr j -1
10959                 incr i -1
10960             } elseif {$r == -1} {
10961                 set tags [lreplace $tags $i $i]
10962                 incr i -1
10963                 break
10964             }
10965         }
10966     }
10967
10968     if {[array names growing] ne {}} {
10969         # graph isn't finished, need to check if any tag could get
10970         # eclipsed by another tag coming later.  Simply ignore any
10971         # tags that could later get eclipsed.
10972         set ctags {}
10973         foreach t $tags {
10974             if {[is_certain $t $origid]} {
10975                 lappend ctags $t
10976             }
10977         }
10978         if {$tags eq $ctags} {
10979             set cached_dtags($origid) $tags
10980         } else {
10981             set tags $ctags
10982         }
10983     } else {
10984         set cached_dtags($origid) $tags
10985     }
10986     set t3 [clock clicks -milliseconds]
10987     if {0 && $t3 - $t1 >= 100} {
10988         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10989             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10990     }
10991     return $tags
10992 }
10993
10994 proc anctags {id} {
10995     global arcnos arcids arcout arcend arctags idtags allparents
10996     global growing cached_atags
10997
10998     if {![info exists allparents($id)]} {
10999         return {}
11000     }
11001     set t1 [clock clicks -milliseconds]
11002     set argid $id
11003     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
11004         # part-way along an arc; check that arc first
11005         set a [lindex $arcnos($id) 0]
11006         if {$arctags($a) ne {}} {
11007             validate_arctags $a
11008             set i [lsearch -exact $arcids($a) $id]
11009             foreach t $arctags($a) {
11010                 set j [lsearch -exact $arcids($a) $t]
11011                 if {$j > $i} {
11012                     return $t
11013                 }
11014             }
11015         }
11016         if {![info exists arcend($a)]} {
11017             return {}
11018         }
11019         set id $arcend($a)
11020         if {[info exists idtags($id)]} {
11021             return $id
11022         }
11023     }
11024     if {[info exists cached_atags($id)]} {
11025         return $cached_atags($id)
11026     }
11027
11028     set origid $id
11029     set todo [list $id]
11030     set queued($id) 1
11031     set taglist {}
11032     set nc 1
11033     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
11034         set id [lindex $todo $i]
11035         set done($id) 1
11036         set td [info exists hastaggeddescendent($id)]
11037         if {!$td} {
11038             incr nc -1
11039         }
11040         # ignore tags on starting node
11041         if {!$td && $i > 0} {
11042             if {[info exists idtags($id)]} {
11043                 set tagloc($id) $id
11044                 set td 1
11045             } elseif {[info exists cached_atags($id)]} {
11046                 set tagloc($id) $cached_atags($id)
11047                 set td 1
11048             }
11049         }
11050         foreach a $arcout($id) {
11051             if {!$td && $arctags($a) ne {}} {
11052                 validate_arctags $a
11053                 if {$arctags($a) ne {}} {
11054                     lappend tagloc($id) [lindex $arctags($a) 0]
11055                 }
11056             }
11057             if {![info exists arcend($a)]} continue
11058             set d $arcend($a)
11059             if {$td || $arctags($a) ne {}} {
11060                 set tomark [list $d]
11061                 for {set j 0} {$j < [llength $tomark]} {incr j} {
11062                     set dd [lindex $tomark $j]
11063                     if {![info exists hastaggeddescendent($dd)]} {
11064                         if {[info exists done($dd)]} {
11065                             foreach b $arcout($dd) {
11066                                 if {[info exists arcend($b)]} {
11067                                     lappend tomark $arcend($b)
11068                                 }
11069                             }
11070                             if {[info exists tagloc($dd)]} {
11071                                 unset tagloc($dd)
11072                             }
11073                         } elseif {[info exists queued($dd)]} {
11074                             incr nc -1
11075                         }
11076                         set hastaggeddescendent($dd) 1
11077                     }
11078                 }
11079             }
11080             if {![info exists queued($d)]} {
11081                 lappend todo $d
11082                 set queued($d) 1
11083                 if {![info exists hastaggeddescendent($d)]} {
11084                     incr nc
11085                 }
11086             }
11087         }
11088     }
11089     set t2 [clock clicks -milliseconds]
11090     set loopix $i
11091     set tags {}
11092     foreach id [array names tagloc] {
11093         if {![info exists hastaggeddescendent($id)]} {
11094             foreach t $tagloc($id) {
11095                 if {[lsearch -exact $tags $t] < 0} {
11096                     lappend tags $t
11097                 }
11098             }
11099         }
11100     }
11101
11102     # remove tags that are ancestors of other tags
11103     for {set i 0} {$i < [llength $tags]} {incr i} {
11104         set a [lindex $tags $i]
11105         for {set j 0} {$j < $i} {incr j} {
11106             set b [lindex $tags $j]
11107             set r [anc_or_desc $a $b]
11108             if {$r == -1} {
11109                 set tags [lreplace $tags $j $j]
11110                 incr j -1
11111                 incr i -1
11112             } elseif {$r == 1} {
11113                 set tags [lreplace $tags $i $i]
11114                 incr i -1
11115                 break
11116             }
11117         }
11118     }
11119
11120     if {[array names growing] ne {}} {
11121         # graph isn't finished, need to check if any tag could get
11122         # eclipsed by another tag coming later.  Simply ignore any
11123         # tags that could later get eclipsed.
11124         set ctags {}
11125         foreach t $tags {
11126             if {[is_certain $origid $t]} {
11127                 lappend ctags $t
11128             }
11129         }
11130         if {$tags eq $ctags} {
11131             set cached_atags($origid) $tags
11132         } else {
11133             set tags $ctags
11134         }
11135     } else {
11136         set cached_atags($origid) $tags
11137     }
11138     set t3 [clock clicks -milliseconds]
11139     if {0 && $t3 - $t1 >= 100} {
11140         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
11141             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
11142     }
11143     return $tags
11144 }
11145
11146 # Return the list of IDs that have heads that are descendents of id,
11147 # including id itself if it has a head.
11148 proc descheads {id} {
11149     global arcnos arcstart arcids archeads idheads cached_dheads
11150     global allparents arcout
11151
11152     if {![info exists allparents($id)]} {
11153         return {}
11154     }
11155     set aret {}
11156     if {![info exists arcout($id)]} {
11157         # part-way along an arc; check it first
11158         set a [lindex $arcnos($id) 0]
11159         if {$archeads($a) ne {}} {
11160             validate_archeads $a
11161             set i [lsearch -exact $arcids($a) $id]
11162             foreach t $archeads($a) {
11163                 set j [lsearch -exact $arcids($a) $t]
11164                 if {$j > $i} break
11165                 lappend aret $t
11166             }
11167         }
11168         set id $arcstart($a)
11169     }
11170     set origid $id
11171     set todo [list $id]
11172     set seen($id) 1
11173     set ret {}
11174     for {set i 0} {$i < [llength $todo]} {incr i} {
11175         set id [lindex $todo $i]
11176         if {[info exists cached_dheads($id)]} {
11177             set ret [concat $ret $cached_dheads($id)]
11178         } else {
11179             if {[info exists idheads($id)]} {
11180                 lappend ret $id
11181             }
11182             foreach a $arcnos($id) {
11183                 if {$archeads($a) ne {}} {
11184                     validate_archeads $a
11185                     if {$archeads($a) ne {}} {
11186                         set ret [concat $ret $archeads($a)]
11187                     }
11188                 }
11189                 set d $arcstart($a)
11190                 if {![info exists seen($d)]} {
11191                     lappend todo $d
11192                     set seen($d) 1
11193                 }
11194             }
11195         }
11196     }
11197     set ret [lsort -unique $ret]
11198     set cached_dheads($origid) $ret
11199     return [concat $ret $aret]
11200 }
11201
11202 proc addedtag {id} {
11203     global arcnos arcout cached_dtags cached_atags
11204
11205     if {![info exists arcnos($id)]} return
11206     if {![info exists arcout($id)]} {
11207         recalcarc [lindex $arcnos($id) 0]
11208     }
11209     unset -nocomplain cached_dtags
11210     unset -nocomplain cached_atags
11211 }
11212
11213 proc addedhead {hid head} {
11214     global arcnos arcout cached_dheads
11215
11216     if {![info exists arcnos($hid)]} return
11217     if {![info exists arcout($hid)]} {
11218         recalcarc [lindex $arcnos($hid) 0]
11219     }
11220     unset -nocomplain cached_dheads
11221 }
11222
11223 proc removedhead {hid head} {
11224     global cached_dheads
11225
11226     unset -nocomplain cached_dheads
11227 }
11228
11229 proc movedhead {hid head} {
11230     global arcnos arcout cached_dheads
11231
11232     if {![info exists arcnos($hid)]} return
11233     if {![info exists arcout($hid)]} {
11234         recalcarc [lindex $arcnos($hid) 0]
11235     }
11236     unset -nocomplain cached_dheads
11237 }
11238
11239 proc changedrefs {} {
11240     global cached_dheads cached_dtags cached_atags cached_tagcontent
11241     global arctags archeads arcnos arcout idheads idtags
11242
11243     foreach id [concat [array names idheads] [array names idtags]] {
11244         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
11245             set a [lindex $arcnos($id) 0]
11246             if {![info exists donearc($a)]} {
11247                 recalcarc $a
11248                 set donearc($a) 1
11249             }
11250         }
11251     }
11252     unset -nocomplain cached_tagcontent
11253     unset -nocomplain cached_dtags
11254     unset -nocomplain cached_atags
11255     unset -nocomplain cached_dheads
11256 }
11257
11258 proc rereadrefs {} {
11259     global idtags idheads idotherrefs mainheadid
11260
11261     set refids [concat [array names idtags] \
11262                     [array names idheads] [array names idotherrefs]]
11263     foreach id $refids {
11264         if {![info exists ref($id)]} {
11265             set ref($id) [listrefs $id]
11266         }
11267     }
11268     set oldmainhead $mainheadid
11269     readrefs
11270     changedrefs
11271     set refids [lsort -unique [concat $refids [array names idtags] \
11272                         [array names idheads] [array names idotherrefs]]]
11273     foreach id $refids {
11274         set v [listrefs $id]
11275         if {![info exists ref($id)] || $ref($id) != $v} {
11276             redrawtags $id
11277         }
11278     }
11279     if {$oldmainhead ne $mainheadid} {
11280         redrawtags $oldmainhead
11281         redrawtags $mainheadid
11282     }
11283     run refill_reflist
11284 }
11285
11286 proc listrefs {id} {
11287     global idtags idheads idotherrefs
11288
11289     set x {}
11290     if {[info exists idtags($id)]} {
11291         set x $idtags($id)
11292     }
11293     set y {}
11294     if {[info exists idheads($id)]} {
11295         set y $idheads($id)
11296     }
11297     set z {}
11298     if {[info exists idotherrefs($id)]} {
11299         set z $idotherrefs($id)
11300     }
11301     return [list $x $y $z]
11302 }
11303
11304 proc add_tag_ctext {tag} {
11305     global ctext cached_tagcontent tagids
11306
11307     if {![info exists cached_tagcontent($tag)]} {
11308         catch {
11309             set cached_tagcontent($tag) [exec git cat-file -p $tag]
11310         }
11311     }
11312     $ctext insert end "[mc "Tag"]: $tag\n" bold
11313     if {[info exists cached_tagcontent($tag)]} {
11314         set text $cached_tagcontent($tag)
11315     } else {
11316         set text "[mc "Id"]:  $tagids($tag)"
11317     }
11318     appendwithlinks $text {}
11319 }
11320
11321 proc showtag {tag isnew} {
11322     global ctext cached_tagcontent tagids linknum tagobjid
11323
11324     if {$isnew} {
11325         addtohistory [list showtag $tag 0] savectextpos
11326     }
11327     $ctext conf -state normal
11328     clear_ctext
11329     settabs 0
11330     set linknum 0
11331     add_tag_ctext $tag
11332     maybe_scroll_ctext 1
11333     $ctext conf -state disabled
11334     init_flist {}
11335 }
11336
11337 proc showtags {id isnew} {
11338     global idtags ctext linknum
11339
11340     if {$isnew} {
11341         addtohistory [list showtags $id 0] savectextpos
11342     }
11343     $ctext conf -state normal
11344     clear_ctext
11345     settabs 0
11346     set linknum 0
11347     set sep {}
11348     foreach tag $idtags($id) {
11349         $ctext insert end $sep
11350         add_tag_ctext $tag
11351         set sep "\n\n"
11352     }
11353     maybe_scroll_ctext 1
11354     $ctext conf -state disabled
11355     init_flist {}
11356 }
11357
11358 proc doquit {} {
11359     global stopped
11360     global gitktmpdir
11361
11362     set stopped 100
11363     savestuff .
11364     destroy .
11365
11366     if {[info exists gitktmpdir]} {
11367         catch {file delete -force $gitktmpdir}
11368     }
11369 }
11370
11371 proc mkfontdisp {font top which} {
11372     global fontattr fontpref $font NS use_ttk
11373
11374     set fontpref($font) [set $font]
11375     ${NS}::button $top.${font}but -text $which \
11376         -command [list choosefont $font $which]
11377     ${NS}::label $top.$font -relief flat -font $font \
11378         -text $fontattr($font,family) -justify left
11379     grid x $top.${font}but $top.$font -sticky w
11380 }
11381
11382 proc choosefont {font which} {
11383     global fontparam fontlist fonttop fontattr
11384     global prefstop NS
11385
11386     set fontparam(which) $which
11387     set fontparam(font) $font
11388     set fontparam(family) [font actual $font -family]
11389     set fontparam(size) $fontattr($font,size)
11390     set fontparam(weight) $fontattr($font,weight)
11391     set fontparam(slant) $fontattr($font,slant)
11392     set top .gitkfont
11393     set fonttop $top
11394     if {![winfo exists $top]} {
11395         font create sample
11396         eval font config sample [font actual $font]
11397         ttk_toplevel $top
11398         make_transient $top $prefstop
11399         wm title $top [mc "Gitk font chooser"]
11400         ${NS}::label $top.l -textvariable fontparam(which)
11401         pack $top.l -side top
11402         set fontlist [lsort [font families]]
11403         ${NS}::frame $top.f
11404         listbox $top.f.fam -listvariable fontlist \
11405             -yscrollcommand [list $top.f.sb set]
11406         bind $top.f.fam <<ListboxSelect>> selfontfam
11407         ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11408         pack $top.f.sb -side right -fill y
11409         pack $top.f.fam -side left -fill both -expand 1
11410         pack $top.f -side top -fill both -expand 1
11411         ${NS}::frame $top.g
11412         spinbox $top.g.size -from 4 -to 40 -width 4 \
11413             -textvariable fontparam(size) \
11414             -validatecommand {string is integer -strict %s}
11415         checkbutton $top.g.bold -padx 5 \
11416             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11417             -variable fontparam(weight) -onvalue bold -offvalue normal
11418         checkbutton $top.g.ital -padx 5 \
11419             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
11420             -variable fontparam(slant) -onvalue italic -offvalue roman
11421         pack $top.g.size $top.g.bold $top.g.ital -side left
11422         pack $top.g -side top
11423         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11424             -background white
11425         $top.c create text 100 25 -anchor center -text $which -font sample \
11426             -fill black -tags text
11427         bind $top.c <Configure> [list centertext $top.c]
11428         pack $top.c -side top -fill x
11429         ${NS}::frame $top.buts
11430         ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11431         ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11432         bind $top <Key-Return> fontok
11433         bind $top <Key-Escape> fontcan
11434         grid $top.buts.ok $top.buts.can
11435         grid columnconfigure $top.buts 0 -weight 1 -uniform a
11436         grid columnconfigure $top.buts 1 -weight 1 -uniform a
11437         pack $top.buts -side bottom -fill x
11438         trace add variable fontparam write chg_fontparam
11439     } else {
11440         raise $top
11441         $top.c itemconf text -text $which
11442     }
11443     set i [lsearch -exact $fontlist $fontparam(family)]
11444     if {$i >= 0} {
11445         $top.f.fam selection set $i
11446         $top.f.fam see $i
11447     }
11448 }
11449
11450 proc centertext {w} {
11451     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11452 }
11453
11454 proc fontok {} {
11455     global fontparam fontpref prefstop
11456
11457     set f $fontparam(font)
11458     set fontpref($f) [list $fontparam(family) $fontparam(size)]
11459     if {$fontparam(weight) eq "bold"} {
11460         lappend fontpref($f) "bold"
11461     }
11462     if {$fontparam(slant) eq "italic"} {
11463         lappend fontpref($f) "italic"
11464     }
11465     set w $prefstop.notebook.fonts.$f
11466     $w conf -text $fontparam(family) -font $fontpref($f)
11467
11468     fontcan
11469 }
11470
11471 proc fontcan {} {
11472     global fonttop fontparam
11473
11474     if {[info exists fonttop]} {
11475         catch {destroy $fonttop}
11476         catch {font delete sample}
11477         unset fonttop
11478         unset fontparam
11479     }
11480 }
11481
11482 if {[package vsatisfies [package provide Tk] 8.6]} {
11483     # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11484     # function to make use of it.
11485     proc choosefont {font which} {
11486         tk fontchooser configure -title $which -font $font \
11487             -command [list on_choosefont $font $which]
11488         tk fontchooser show
11489     }
11490     proc on_choosefont {font which newfont} {
11491         global fontparam
11492         puts stderr "$font $newfont"
11493         array set f [font actual $newfont]
11494         set fontparam(which) $which
11495         set fontparam(font) $font
11496         set fontparam(family) $f(-family)
11497         set fontparam(size) $f(-size)
11498         set fontparam(weight) $f(-weight)
11499         set fontparam(slant) $f(-slant)
11500         fontok
11501     }
11502 }
11503
11504 proc selfontfam {} {
11505     global fonttop fontparam
11506
11507     set i [$fonttop.f.fam curselection]
11508     if {$i ne {}} {
11509         set fontparam(family) [$fonttop.f.fam get $i]
11510     }
11511 }
11512
11513 proc chg_fontparam {v sub op} {
11514     global fontparam
11515
11516     font config sample -$sub $fontparam($sub)
11517 }
11518
11519 # Create a property sheet tab page
11520 proc create_prefs_page {w} {
11521     global NS
11522     set parent [join [lrange [split $w .] 0 end-1] .]
11523     if {[winfo class $parent] eq "TNotebook"} {
11524         ${NS}::frame $w
11525     } else {
11526         ${NS}::labelframe $w
11527     }
11528 }
11529
11530 proc prefspage_general {notebook} {
11531     global NS maxwidth maxgraphpct showneartags showlocalchanges
11532     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11533     global hideremotes want_ttk have_ttk maxrefs web_browser
11534
11535     set page [create_prefs_page $notebook.general]
11536
11537     ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11538     grid $page.ldisp - -sticky w -pady 10
11539     ${NS}::label $page.spacer -text " "
11540     ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11541     spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11542     grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11543                                          #xgettext:no-tcl-format
11544     ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11545     spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11546     grid x $page.maxpctl $page.maxpct -sticky w
11547     ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11548         -variable showlocalchanges
11549     grid x $page.showlocal -sticky w
11550     ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11551         -variable autoselect
11552     spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11553     grid x $page.autoselect $page.autosellen -sticky w
11554     ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11555         -variable hideremotes
11556     grid x $page.hideremotes -sticky w
11557
11558     ${NS}::label $page.ddisp -text [mc "Diff display options"]
11559     grid $page.ddisp - -sticky w -pady 10
11560     ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11561     spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11562     grid x $page.tabstopl $page.tabstop -sticky w
11563     ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11564         -variable showneartags
11565     grid x $page.ntag -sticky w
11566     ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11567     spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11568     grid x $page.maxrefsl $page.maxrefs -sticky w
11569     ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11570         -variable limitdiffs
11571     grid x $page.ldiff -sticky w
11572     ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11573         -variable perfile_attrs
11574     grid x $page.lattr -sticky w
11575
11576     ${NS}::entry $page.extdifft -textvariable extdifftool
11577     ${NS}::frame $page.extdifff
11578     ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11579     ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11580     pack $page.extdifff.l $page.extdifff.b -side left
11581     pack configure $page.extdifff.l -padx 10
11582     grid x $page.extdifff $page.extdifft -sticky ew
11583
11584     ${NS}::entry $page.webbrowser -textvariable web_browser
11585     ${NS}::frame $page.webbrowserf
11586     ${NS}::label $page.webbrowserf.l -text [mc "Web browser" ]
11587     pack $page.webbrowserf.l -side left
11588     pack configure $page.webbrowserf.l -padx 10
11589     grid x $page.webbrowserf $page.webbrowser -sticky ew
11590
11591     ${NS}::label $page.lgen -text [mc "General options"]
11592     grid $page.lgen - -sticky w -pady 10
11593     ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11594         -text [mc "Use themed widgets"]
11595     if {$have_ttk} {
11596         ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11597     } else {
11598         ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11599     }
11600     grid x $page.want_ttk $page.ttk_note -sticky w
11601     return $page
11602 }
11603
11604 proc prefspage_colors {notebook} {
11605     global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11606
11607     set page [create_prefs_page $notebook.colors]
11608
11609     ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11610     grid $page.cdisp - -sticky w -pady 10
11611     label $page.ui -padx 40 -relief sunk -background $uicolor
11612     ${NS}::button $page.uibut -text [mc "Interface"] \
11613        -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11614     grid x $page.uibut $page.ui -sticky w
11615     label $page.bg -padx 40 -relief sunk -background $bgcolor
11616     ${NS}::button $page.bgbut -text [mc "Background"] \
11617         -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11618     grid x $page.bgbut $page.bg -sticky w
11619     label $page.fg -padx 40 -relief sunk -background $fgcolor
11620     ${NS}::button $page.fgbut -text [mc "Foreground"] \
11621         -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11622     grid x $page.fgbut $page.fg -sticky w
11623     label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11624     ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11625         -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11626                       [list $ctext tag conf d0 -foreground]]
11627     grid x $page.diffoldbut $page.diffold -sticky w
11628     label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11629     ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11630         -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11631                       [list $ctext tag conf dresult -foreground]]
11632     grid x $page.diffnewbut $page.diffnew -sticky w
11633     label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11634     ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11635         -command [list choosecolor diffcolors 2 $page.hunksep \
11636                       [mc "diff hunk header"] \
11637                       [list $ctext tag conf hunksep -foreground]]
11638     grid x $page.hunksepbut $page.hunksep -sticky w
11639     label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11640     ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11641         -command [list choosecolor markbgcolor {} $page.markbgsep \
11642                       [mc "marked line background"] \
11643                       [list $ctext tag conf omark -background]]
11644     grid x $page.markbgbut $page.markbgsep -sticky w
11645     label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11646     ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11647         -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11648     grid x $page.selbgbut $page.selbgsep -sticky w
11649     return $page
11650 }
11651
11652 proc prefspage_fonts {notebook} {
11653     global NS
11654     set page [create_prefs_page $notebook.fonts]
11655     ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11656     grid $page.cfont - -sticky w -pady 10
11657     mkfontdisp mainfont $page [mc "Main font"]
11658     mkfontdisp textfont $page [mc "Diff display font"]
11659     mkfontdisp uifont $page [mc "User interface font"]
11660     return $page
11661 }
11662
11663 proc doprefs {} {
11664     global maxwidth maxgraphpct use_ttk NS
11665     global oldprefs prefstop showneartags showlocalchanges
11666     global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11667     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11668     global hideremotes want_ttk have_ttk
11669
11670     set top .gitkprefs
11671     set prefstop $top
11672     if {[winfo exists $top]} {
11673         raise $top
11674         return
11675     }
11676     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11677                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11678         set oldprefs($v) [set $v]
11679     }
11680     ttk_toplevel $top
11681     wm title $top [mc "Gitk preferences"]
11682     make_transient $top .
11683
11684     if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11685         set notebook [ttk::notebook $top.notebook]
11686     } else {
11687         set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11688     }
11689
11690     lappend pages [prefspage_general $notebook] [mc "General"]
11691     lappend pages [prefspage_colors $notebook] [mc "Colors"]
11692     lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11693     set col 0
11694     foreach {page title} $pages {
11695         if {$use_notebook} {
11696             $notebook add $page -text $title
11697         } else {
11698             set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11699                          -text $title -command [list raise $page]]
11700             $page configure -text $title
11701             grid $btn -row 0 -column [incr col] -sticky w
11702             grid $page -row 1 -column 0 -sticky news -columnspan 100
11703         }
11704     }
11705
11706     if {!$use_notebook} {
11707         grid columnconfigure $notebook 0 -weight 1
11708         grid rowconfigure $notebook 1 -weight 1
11709         raise [lindex $pages 0]
11710     }
11711
11712     grid $notebook -sticky news -padx 2 -pady 2
11713     grid rowconfigure $top 0 -weight 1
11714     grid columnconfigure $top 0 -weight 1
11715
11716     ${NS}::frame $top.buts
11717     ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11718     ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11719     bind $top <Key-Return> prefsok
11720     bind $top <Key-Escape> prefscan
11721     grid $top.buts.ok $top.buts.can
11722     grid columnconfigure $top.buts 0 -weight 1 -uniform a
11723     grid columnconfigure $top.buts 1 -weight 1 -uniform a
11724     grid $top.buts - - -pady 10 -sticky ew
11725     grid columnconfigure $top 2 -weight 1
11726     bind $top <Visibility> [list focus $top.buts.ok]
11727 }
11728
11729 proc choose_extdiff {} {
11730     global extdifftool
11731
11732     set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11733     if {$prog ne {}} {
11734         set extdifftool $prog
11735     }
11736 }
11737
11738 proc choosecolor {v vi w x cmd} {
11739     global $v
11740
11741     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11742                -title [mc "Gitk: choose color for %s" $x]]
11743     if {$c eq {}} return
11744     $w conf -background $c
11745     lset $v $vi $c
11746     eval $cmd $c
11747 }
11748
11749 proc setselbg {c} {
11750     global bglist cflist
11751     foreach w $bglist {
11752         if {[winfo exists $w]} {
11753             $w configure -selectbackground $c
11754         }
11755     }
11756     $cflist tag configure highlight \
11757         -background [$cflist cget -selectbackground]
11758     allcanvs itemconf secsel -fill $c
11759 }
11760
11761 # This sets the background color and the color scheme for the whole UI.
11762 # For some reason, tk_setPalette chooses a nasty dark red for selectColor
11763 # if we don't specify one ourselves, which makes the checkbuttons and
11764 # radiobuttons look bad.  This chooses white for selectColor if the
11765 # background color is light, or black if it is dark.
11766 proc setui {c} {
11767     if {[tk windowingsystem] eq "win32"} { return }
11768     set bg [winfo rgb . $c]
11769     set selc black
11770     if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11771         set selc white
11772     }
11773     tk_setPalette background $c selectColor $selc
11774 }
11775
11776 proc setbg {c} {
11777     global bglist
11778
11779     foreach w $bglist {
11780         if {[winfo exists $w]} {
11781             $w conf -background $c
11782         }
11783     }
11784 }
11785
11786 proc setfg {c} {
11787     global fglist canv
11788
11789     foreach w $fglist {
11790         if {[winfo exists $w]} {
11791             $w conf -foreground $c
11792         }
11793     }
11794     allcanvs itemconf text -fill $c
11795     $canv itemconf circle -outline $c
11796     $canv itemconf markid -outline $c
11797 }
11798
11799 proc prefscan {} {
11800     global oldprefs prefstop
11801
11802     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11803                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11804         global $v
11805         set $v $oldprefs($v)
11806     }
11807     catch {destroy $prefstop}
11808     unset prefstop
11809     fontcan
11810 }
11811
11812 proc prefsok {} {
11813     global maxwidth maxgraphpct
11814     global oldprefs prefstop showneartags showlocalchanges
11815     global fontpref mainfont textfont uifont
11816     global limitdiffs treediffs perfile_attrs
11817     global hideremotes
11818
11819     catch {destroy $prefstop}
11820     unset prefstop
11821     fontcan
11822     set fontchanged 0
11823     if {$mainfont ne $fontpref(mainfont)} {
11824         set mainfont $fontpref(mainfont)
11825         parsefont mainfont $mainfont
11826         eval font configure mainfont [fontflags mainfont]
11827         eval font configure mainfontbold [fontflags mainfont 1]
11828         setcoords
11829         set fontchanged 1
11830     }
11831     if {$textfont ne $fontpref(textfont)} {
11832         set textfont $fontpref(textfont)
11833         parsefont textfont $textfont
11834         eval font configure textfont [fontflags textfont]
11835         eval font configure textfontbold [fontflags textfont 1]
11836     }
11837     if {$uifont ne $fontpref(uifont)} {
11838         set uifont $fontpref(uifont)
11839         parsefont uifont $uifont
11840         eval font configure uifont [fontflags uifont]
11841     }
11842     settabs
11843     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11844         if {$showlocalchanges} {
11845             doshowlocalchanges
11846         } else {
11847             dohidelocalchanges
11848         }
11849     }
11850     if {$limitdiffs != $oldprefs(limitdiffs) ||
11851         ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11852         # treediffs elements are limited by path;
11853         # won't have encodings cached if perfile_attrs was just turned on
11854         unset -nocomplain treediffs
11855     }
11856     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11857         || $maxgraphpct != $oldprefs(maxgraphpct)} {
11858         redisplay
11859     } elseif {$showneartags != $oldprefs(showneartags) ||
11860           $limitdiffs != $oldprefs(limitdiffs)} {
11861         reselectline
11862     }
11863     if {$hideremotes != $oldprefs(hideremotes)} {
11864         rereadrefs
11865     }
11866 }
11867
11868 proc formatdate {d} {
11869     global datetimeformat
11870     if {$d ne {}} {
11871         # If $datetimeformat includes a timezone, display in the
11872         # timezone of the argument.  Otherwise, display in local time.
11873         if {[string match {*%[zZ]*} $datetimeformat]} {
11874             if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11875                 # Tcl < 8.5 does not support -timezone.  Emulate it by
11876                 # setting TZ (e.g. TZ=<-0430>+04:30).
11877                 global env
11878                 if {[info exists env(TZ)]} {
11879                     set savedTZ $env(TZ)
11880                 }
11881                 set zone [lindex $d 1]
11882                 set sign [string map {+ - - +} [string index $zone 0]]
11883                 set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11884                 set d [clock format [lindex $d 0] -format $datetimeformat]
11885                 if {[info exists savedTZ]} {
11886                     set env(TZ) $savedTZ
11887                 } else {
11888                     unset env(TZ)
11889                 }
11890             }
11891         } else {
11892             set d [clock format [lindex $d 0] -format $datetimeformat]
11893         }
11894     }
11895     return $d
11896 }
11897
11898 # This list of encoding names and aliases is distilled from
11899 # http://www.iana.org/assignments/character-sets.
11900 # Not all of them are supported by Tcl.
11901 set encoding_aliases {
11902     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11903       ISO646-US US-ASCII us IBM367 cp367 csASCII }
11904     { ISO-10646-UTF-1 csISO10646UTF1 }
11905     { ISO_646.basic:1983 ref csISO646basic1983 }
11906     { INVARIANT csINVARIANT }
11907     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11908     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11909     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11910     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11911     { NATS-DANO iso-ir-9-1 csNATSDANO }
11912     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11913     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11914     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11915     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11916     { ISO-2022-KR csISO2022KR }
11917     { EUC-KR csEUCKR }
11918     { ISO-2022-JP csISO2022JP }
11919     { ISO-2022-JP-2 csISO2022JP2 }
11920     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11921       csISO13JISC6220jp }
11922     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11923     { IT iso-ir-15 ISO646-IT csISO15Italian }
11924     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11925     { ES iso-ir-17 ISO646-ES csISO17Spanish }
11926     { greek7-old iso-ir-18 csISO18Greek7Old }
11927     { latin-greek iso-ir-19 csISO19LatinGreek }
11928     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11929     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11930     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11931     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11932     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11933     { BS_viewdata iso-ir-47 csISO47BSViewdata }
11934     { INIS iso-ir-49 csISO49INIS }
11935     { INIS-8 iso-ir-50 csISO50INIS8 }
11936     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11937     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11938     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11939     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11940     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11941     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11942       csISO60Norwegian1 }
11943     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11944     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11945     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11946     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11947     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11948     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11949     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11950     { greek7 iso-ir-88 csISO88Greek7 }
11951     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11952     { iso-ir-90 csISO90 }
11953     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11954     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11955       csISO92JISC62991984b }
11956     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11957     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11958     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11959       csISO95JIS62291984handadd }
11960     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11961     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11962     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11963     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11964       CP819 csISOLatin1 }
11965     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11966     { T.61-7bit iso-ir-102 csISO102T617bit }
11967     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11968     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11969     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11970     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11971     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11972     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11973     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11974     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11975       arabic csISOLatinArabic }
11976     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11977     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11978     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11979       greek greek8 csISOLatinGreek }
11980     { T.101-G2 iso-ir-128 csISO128T101G2 }
11981     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11982       csISOLatinHebrew }
11983     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11984     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11985     { CSN_369103 iso-ir-139 csISO139CSN369103 }
11986     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11987     { ISO_6937-2-add iso-ir-142 csISOTextComm }
11988     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11989     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11990       csISOLatinCyrillic }
11991     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11992     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11993     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11994     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11995     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11996     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11997     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11998     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11999     { ISO_10367-box iso-ir-155 csISO10367Box }
12000     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
12001     { latin-lap lap iso-ir-158 csISO158Lap }
12002     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
12003     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
12004     { us-dk csUSDK }
12005     { dk-us csDKUS }
12006     { JIS_X0201 X0201 csHalfWidthKatakana }
12007     { KSC5636 ISO646-KR csKSC5636 }
12008     { ISO-10646-UCS-2 csUnicode }
12009     { ISO-10646-UCS-4 csUCS4 }
12010     { DEC-MCS dec csDECMCS }
12011     { hp-roman8 roman8 r8 csHPRoman8 }
12012     { macintosh mac csMacintosh }
12013     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
12014       csIBM037 }
12015     { IBM038 EBCDIC-INT cp038 csIBM038 }
12016     { IBM273 CP273 csIBM273 }
12017     { IBM274 EBCDIC-BE CP274 csIBM274 }
12018     { IBM275 EBCDIC-BR cp275 csIBM275 }
12019     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
12020     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
12021     { IBM280 CP280 ebcdic-cp-it csIBM280 }
12022     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
12023     { IBM284 CP284 ebcdic-cp-es csIBM284 }
12024     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
12025     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
12026     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
12027     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
12028     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
12029     { IBM424 cp424 ebcdic-cp-he csIBM424 }
12030     { IBM437 cp437 437 csPC8CodePage437 }
12031     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
12032     { IBM775 cp775 csPC775Baltic }
12033     { IBM850 cp850 850 csPC850Multilingual }
12034     { IBM851 cp851 851 csIBM851 }
12035     { IBM852 cp852 852 csPCp852 }
12036     { IBM855 cp855 855 csIBM855 }
12037     { IBM857 cp857 857 csIBM857 }
12038     { IBM860 cp860 860 csIBM860 }
12039     { IBM861 cp861 861 cp-is csIBM861 }
12040     { IBM862 cp862 862 csPC862LatinHebrew }
12041     { IBM863 cp863 863 csIBM863 }
12042     { IBM864 cp864 csIBM864 }
12043     { IBM865 cp865 865 csIBM865 }
12044     { IBM866 cp866 866 csIBM866 }
12045     { IBM868 CP868 cp-ar csIBM868 }
12046     { IBM869 cp869 869 cp-gr csIBM869 }
12047     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
12048     { IBM871 CP871 ebcdic-cp-is csIBM871 }
12049     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
12050     { IBM891 cp891 csIBM891 }
12051     { IBM903 cp903 csIBM903 }
12052     { IBM904 cp904 904 csIBBM904 }
12053     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
12054     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
12055     { IBM1026 CP1026 csIBM1026 }
12056     { EBCDIC-AT-DE csIBMEBCDICATDE }
12057     { EBCDIC-AT-DE-A csEBCDICATDEA }
12058     { EBCDIC-CA-FR csEBCDICCAFR }
12059     { EBCDIC-DK-NO csEBCDICDKNO }
12060     { EBCDIC-DK-NO-A csEBCDICDKNOA }
12061     { EBCDIC-FI-SE csEBCDICFISE }
12062     { EBCDIC-FI-SE-A csEBCDICFISEA }
12063     { EBCDIC-FR csEBCDICFR }
12064     { EBCDIC-IT csEBCDICIT }
12065     { EBCDIC-PT csEBCDICPT }
12066     { EBCDIC-ES csEBCDICES }
12067     { EBCDIC-ES-A csEBCDICESA }
12068     { EBCDIC-ES-S csEBCDICESS }
12069     { EBCDIC-UK csEBCDICUK }
12070     { EBCDIC-US csEBCDICUS }
12071     { UNKNOWN-8BIT csUnknown8BiT }
12072     { MNEMONIC csMnemonic }
12073     { MNEM csMnem }
12074     { VISCII csVISCII }
12075     { VIQR csVIQR }
12076     { KOI8-R csKOI8R }
12077     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
12078     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
12079     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
12080     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
12081     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
12082     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
12083     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
12084     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
12085     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
12086     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
12087     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
12088     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
12089     { IBM1047 IBM-1047 }
12090     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
12091     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
12092     { UNICODE-1-1 csUnicode11 }
12093     { CESU-8 csCESU-8 }
12094     { BOCU-1 csBOCU-1 }
12095     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
12096     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
12097       l8 }
12098     { ISO-8859-15 ISO_8859-15 Latin-9 }
12099     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
12100     { GBK CP936 MS936 windows-936 }
12101     { JIS_Encoding csJISEncoding }
12102     { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
12103     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
12104       EUC-JP }
12105     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
12106     { ISO-10646-UCS-Basic csUnicodeASCII }
12107     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
12108     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
12109     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
12110     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
12111     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
12112     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
12113     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
12114     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
12115     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
12116     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
12117     { Adobe-Standard-Encoding csAdobeStandardEncoding }
12118     { Ventura-US csVenturaUS }
12119     { Ventura-International csVenturaInternational }
12120     { PC8-Danish-Norwegian csPC8DanishNorwegian }
12121     { PC8-Turkish csPC8Turkish }
12122     { IBM-Symbols csIBMSymbols }
12123     { IBM-Thai csIBMThai }
12124     { HP-Legal csHPLegal }
12125     { HP-Pi-font csHPPiFont }
12126     { HP-Math8 csHPMath8 }
12127     { Adobe-Symbol-Encoding csHPPSMath }
12128     { HP-DeskTop csHPDesktop }
12129     { Ventura-Math csVenturaMath }
12130     { Microsoft-Publishing csMicrosoftPublishing }
12131     { Windows-31J csWindows31J }
12132     { GB2312 csGB2312 }
12133     { Big5 csBig5 }
12134 }
12135
12136 proc tcl_encoding {enc} {
12137     global encoding_aliases tcl_encoding_cache
12138     if {[info exists tcl_encoding_cache($enc)]} {
12139         return $tcl_encoding_cache($enc)
12140     }
12141     set names [encoding names]
12142     set lcnames [string tolower $names]
12143     set enc [string tolower $enc]
12144     set i [lsearch -exact $lcnames $enc]
12145     if {$i < 0} {
12146         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
12147         if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
12148             set i [lsearch -exact $lcnames $encx]
12149         }
12150     }
12151     if {$i < 0} {
12152         foreach l $encoding_aliases {
12153             set ll [string tolower $l]
12154             if {[lsearch -exact $ll $enc] < 0} continue
12155             # look through the aliases for one that tcl knows about
12156             foreach e $ll {
12157                 set i [lsearch -exact $lcnames $e]
12158                 if {$i < 0} {
12159                     if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
12160                         set i [lsearch -exact $lcnames $ex]
12161                     }
12162                 }
12163                 if {$i >= 0} break
12164             }
12165             break
12166         }
12167     }
12168     set tclenc {}
12169     if {$i >= 0} {
12170         set tclenc [lindex $names $i]
12171     }
12172     set tcl_encoding_cache($enc) $tclenc
12173     return $tclenc
12174 }
12175
12176 proc gitattr {path attr default} {
12177     global path_attr_cache
12178     if {[info exists path_attr_cache($attr,$path)]} {
12179         set r $path_attr_cache($attr,$path)
12180     } else {
12181         set r "unspecified"
12182         if {![catch {set line [exec git check-attr $attr -- $path]}]} {
12183             regexp "(.*): $attr: (.*)" $line m f r
12184         }
12185         set path_attr_cache($attr,$path) $r
12186     }
12187     if {$r eq "unspecified"} {
12188         return $default
12189     }
12190     return $r
12191 }
12192
12193 proc cache_gitattr {attr pathlist} {
12194     global path_attr_cache
12195     set newlist {}
12196     foreach path $pathlist {
12197         if {![info exists path_attr_cache($attr,$path)]} {
12198             lappend newlist $path
12199         }
12200     }
12201     set lim 1000
12202     if {[tk windowingsystem] == "win32"} {
12203         # windows has a 32k limit on the arguments to a command...
12204         set lim 30
12205     }
12206     while {$newlist ne {}} {
12207         set head [lrange $newlist 0 [expr {$lim - 1}]]
12208         set newlist [lrange $newlist $lim end]
12209         if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
12210             foreach row [split $rlist "\n"] {
12211                 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
12212                     if {[string index $path 0] eq "\""} {
12213                         set path [encoding convertfrom [lindex $path 0]]
12214                     }
12215                     set path_attr_cache($attr,$path) $value
12216                 }
12217             }
12218         }
12219     }
12220 }
12221
12222 proc get_path_encoding {path} {
12223     global gui_encoding perfile_attrs
12224     set tcl_enc $gui_encoding
12225     if {$path ne {} && $perfile_attrs} {
12226         set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
12227         if {$enc2 ne {}} {
12228             set tcl_enc $enc2
12229         }
12230     }
12231     return $tcl_enc
12232 }
12233
12234 ## For msgcat loading, first locate the installation location.
12235 if { [info exists ::env(GITK_MSGSDIR)] } {
12236     ## Msgsdir was manually set in the environment.
12237     set gitk_msgsdir $::env(GITK_MSGSDIR)
12238 } else {
12239     ## Let's guess the prefix from argv0.
12240     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12241     set gitk_libdir [file join $gitk_prefix share gitk lib]
12242     set gitk_msgsdir [file join $gitk_libdir msgs]
12243     unset gitk_prefix
12244 }
12245
12246 ## Internationalization (i18n) through msgcat and gettext. See
12247 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12248 package require msgcat
12249 namespace import ::msgcat::mc
12250 ## And eventually load the actual message catalog
12251 ::msgcat::mcload $gitk_msgsdir
12252
12253 # First check that Tcl/Tk is recent enough
12254 if {[catch {package require Tk 8.4} err]} {
12255     show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
12256                          Gitk requires at least Tcl/Tk 8.4."]
12257     exit 1
12258 }
12259
12260 # on OSX bring the current Wish process window to front
12261 if {[tk windowingsystem] eq "aqua"} {
12262     exec osascript -e [format {
12263         tell application "System Events"
12264             set frontmost of processes whose unix id is %d to true
12265         end tell
12266     } [pid] ]
12267 }
12268
12269 # Unset GIT_TRACE var if set
12270 if { [info exists ::env(GIT_TRACE)] } {
12271     unset ::env(GIT_TRACE)
12272 }
12273
12274 # defaults...
12275 set wrcomcmd "git diff-tree --stdin -p --pretty=email"
12276
12277 set gitencoding {}
12278 catch {
12279     set gitencoding [exec git config --get i18n.commitencoding]
12280 }
12281 catch {
12282     set gitencoding [exec git config --get i18n.logoutputencoding]
12283 }
12284 if {$gitencoding == ""} {
12285     set gitencoding "utf-8"
12286 }
12287 set tclencoding [tcl_encoding $gitencoding]
12288 if {$tclencoding == {}} {
12289     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
12290 }
12291
12292 set gui_encoding [encoding system]
12293 catch {
12294     set enc [exec git config --get gui.encoding]
12295     if {$enc ne {}} {
12296         set tclenc [tcl_encoding $enc]
12297         if {$tclenc ne {}} {
12298             set gui_encoding $tclenc
12299         } else {
12300             puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
12301         }
12302     }
12303 }
12304
12305 set log_showroot true
12306 catch {
12307     set log_showroot [exec git config --bool --get log.showroot]
12308 }
12309
12310 if {[tk windowingsystem] eq "aqua"} {
12311     set mainfont {{Lucida Grande} 9}
12312     set textfont {Monaco 9}
12313     set uifont {{Lucida Grande} 9 bold}
12314 } elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
12315     # fontconfig!
12316     set mainfont {sans 9}
12317     set textfont {monospace 9}
12318     set uifont {sans 9 bold}
12319 } else {
12320     set mainfont {Helvetica 9}
12321     set textfont {Courier 9}
12322     set uifont {Helvetica 9 bold}
12323 }
12324 set tabstop 8
12325 set findmergefiles 0
12326 set maxgraphpct 50
12327 set maxwidth 16
12328 set revlistorder 0
12329 set fastdate 0
12330 set uparrowlen 5
12331 set downarrowlen 5
12332 set mingaplen 100
12333 set cmitmode "patch"
12334 set wrapcomment "none"
12335 set showneartags 1
12336 set hideremotes 0
12337 set maxrefs 20
12338 set visiblerefs {"master"}
12339 set maxlinelen 200
12340 set showlocalchanges 1
12341 set limitdiffs 1
12342 set datetimeformat "%Y-%m-%d %H:%M:%S"
12343 set autoselect 1
12344 set autosellen 40
12345 set perfile_attrs 0
12346 set want_ttk 1
12347
12348 if {[tk windowingsystem] eq "aqua"} {
12349     set extdifftool "opendiff"
12350 } else {
12351     set extdifftool "meld"
12352 }
12353
12354 set colors {"#00ff00" red blue magenta darkgrey brown orange}
12355 if {[tk windowingsystem] eq "win32"} {
12356     set uicolor SystemButtonFace
12357     set uifgcolor SystemButtonText
12358     set uifgdisabledcolor SystemDisabledText
12359     set bgcolor SystemWindow
12360     set fgcolor SystemWindowText
12361     set selectbgcolor SystemHighlight
12362     set web_browser "cmd /c start"
12363 } else {
12364     set uicolor grey85
12365     set uifgcolor black
12366     set uifgdisabledcolor "#999"
12367     set bgcolor white
12368     set fgcolor black
12369     set selectbgcolor gray85
12370     if {[tk windowingsystem] eq "aqua"} {
12371         set web_browser "open"
12372     } else {
12373         set web_browser "xdg-open"
12374     }
12375 }
12376 set diffcolors {red "#00a000" blue}
12377 set diffcontext 3
12378 set mergecolors {red blue "#00ff00" purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12379 set ignorespace 0
12380 set worddiff ""
12381 set markbgcolor "#e0e0ff"
12382
12383 set headbgcolor "#00ff00"
12384 set headfgcolor black
12385 set headoutlinecolor black
12386 set remotebgcolor #ffddaa
12387 set tagbgcolor yellow
12388 set tagfgcolor black
12389 set tagoutlinecolor black
12390 set reflinecolor black
12391 set filesepbgcolor #aaaaaa
12392 set filesepfgcolor black
12393 set linehoverbgcolor #ffff80
12394 set linehoverfgcolor black
12395 set linehoveroutlinecolor black
12396 set mainheadcirclecolor yellow
12397 set workingfilescirclecolor red
12398 set indexcirclecolor "#00ff00"
12399 set circlecolors {white blue gray blue blue}
12400 set linkfgcolor blue
12401 set circleoutlinecolor $fgcolor
12402 set foundbgcolor yellow
12403 set currentsearchhitbgcolor orange
12404
12405 # button for popping up context menus
12406 if {[tk windowingsystem] eq "aqua"} {
12407     set ctxbut <Button-2>
12408 } else {
12409     set ctxbut <Button-3>
12410 }
12411
12412 catch {
12413     # follow the XDG base directory specification by default. See
12414     # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
12415     if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
12416         # XDG_CONFIG_HOME environment variable is set
12417         set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12418         set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
12419     } else {
12420         # default XDG_CONFIG_HOME
12421         set config_file "~/.config/git/gitk"
12422         set config_file_tmp "~/.config/git/gitk-tmp"
12423     }
12424     if {![file exists $config_file]} {
12425         # for backward compatibility use the old config file if it exists
12426         if {[file exists "~/.gitk"]} {
12427             set config_file "~/.gitk"
12428             set config_file_tmp "~/.gitk-tmp"
12429         } elseif {![file exists [file dirname $config_file]]} {
12430             file mkdir [file dirname $config_file]
12431         }
12432     }
12433     source $config_file
12434 }
12435 config_check_tmp_exists 50
12436
12437 set config_variables {
12438     mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
12439     cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
12440     hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
12441     bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
12442     markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
12443     extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
12444     remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
12445     filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
12446     linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
12447     indexcirclecolor circlecolors linkfgcolor circleoutlinecolor
12448     web_browser
12449 }
12450 foreach var $config_variables {
12451     config_init_trace $var
12452     trace add variable $var write config_variable_change_cb
12453 }
12454
12455 parsefont mainfont $mainfont
12456 eval font create mainfont [fontflags mainfont]
12457 eval font create mainfontbold [fontflags mainfont 1]
12458
12459 parsefont textfont $textfont
12460 eval font create textfont [fontflags textfont]
12461 eval font create textfontbold [fontflags textfont 1]
12462
12463 parsefont uifont $uifont
12464 eval font create uifont [fontflags uifont]
12465
12466 setui $uicolor
12467
12468 setoptions
12469
12470 # check that we can find a .git directory somewhere...
12471 if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12472     show_error {} . [mc "Cannot find a git repository here."]
12473     exit 1
12474 }
12475
12476 set selecthead {}
12477 set selectheadid {}
12478
12479 set revtreeargs {}
12480 set cmdline_files {}
12481 set i 0
12482 set revtreeargscmd {}
12483 foreach arg $argv {
12484     switch -glob -- $arg {
12485         "" { }
12486         "--" {
12487             set cmdline_files [lrange $argv [expr {$i + 1}] end]
12488             break
12489         }
12490         "--select-commit=*" {
12491             set selecthead [string range $arg 16 end]
12492         }
12493         "--argscmd=*" {
12494             set revtreeargscmd [string range $arg 10 end]
12495         }
12496         default {
12497             lappend revtreeargs $arg
12498         }
12499     }
12500     incr i
12501 }
12502
12503 if {$selecthead eq "HEAD"} {
12504     set selecthead {}
12505 }
12506
12507 if {$i >= [llength $argv] && $revtreeargs ne {}} {
12508     # no -- on command line, but some arguments (other than --argscmd)
12509     if {[catch {
12510         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12511         set cmdline_files [split $f "\n"]
12512         set n [llength $cmdline_files]
12513         set revtreeargs [lrange $revtreeargs 0 end-$n]
12514         # Unfortunately git rev-parse doesn't produce an error when
12515         # something is both a revision and a filename.  To be consistent
12516         # with git log and git rev-list, check revtreeargs for filenames.
12517         foreach arg $revtreeargs {
12518             if {[file exists $arg]} {
12519                 show_error {} . [mc "Ambiguous argument '%s': both revision\
12520                                  and filename" $arg]
12521                 exit 1
12522             }
12523         }
12524     } err]} {
12525         # unfortunately we get both stdout and stderr in $err,
12526         # so look for "fatal:".
12527         set i [string first "fatal:" $err]
12528         if {$i > 0} {
12529             set err [string range $err [expr {$i + 6}] end]
12530         }
12531         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12532         exit 1
12533     }
12534 }
12535
12536 set nullid "0000000000000000000000000000000000000000"
12537 set nullid2 "0000000000000000000000000000000000000001"
12538 set nullfile "/dev/null"
12539
12540 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12541 if {![info exists have_ttk]} {
12542     set have_ttk [llength [info commands ::ttk::style]]
12543 }
12544 set use_ttk [expr {$have_ttk && $want_ttk}]
12545 set NS [expr {$use_ttk ? "ttk" : ""}]
12546
12547 if {$use_ttk} {
12548     setttkstyle
12549 }
12550
12551 regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12552
12553 set show_notes {}
12554 if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12555     set show_notes "--show-notes"
12556 }
12557
12558 set appname "gitk"
12559
12560 set runq {}
12561 set history {}
12562 set historyindex 0
12563 set fh_serial 0
12564 set nhl_names {}
12565 set highlight_paths {}
12566 set findpattern {}
12567 set searchdirn -forwards
12568 set boldids {}
12569 set boldnameids {}
12570 set diffelide {0 0}
12571 set markingmatches 0
12572 set linkentercount 0
12573 set need_redisplay 0
12574 set nrows_drawn 0
12575 set firsttabstop 0
12576
12577 set nextviewnum 1
12578 set curview 0
12579 set selectedview 0
12580 set selectedhlview [mc "None"]
12581 set highlight_related [mc "None"]
12582 set highlight_files {}
12583 set viewfiles(0) {}
12584 set viewperm(0) 0
12585 set viewchanged(0) 0
12586 set viewargs(0) {}
12587 set viewargscmd(0) {}
12588
12589 set selectedline {}
12590 set numcommits 0
12591 set loginstance 0
12592 set cmdlineok 0
12593 set stopped 0
12594 set stuffsaved 0
12595 set patchnum 0
12596 set lserial 0
12597 set hasworktree [hasworktree]
12598 set cdup {}
12599 if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12600     set cdup [exec git rev-parse --show-cdup]
12601 }
12602 set worktree [exec git rev-parse --show-toplevel]
12603 setcoords
12604 makewindow
12605 catch {
12606     image create photo gitlogo      -width 16 -height 16
12607
12608     image create photo gitlogominus -width  4 -height  2
12609     gitlogominus put #C00000 -to 0 0 4 2
12610     gitlogo copy gitlogominus -to  1 5
12611     gitlogo copy gitlogominus -to  6 5
12612     gitlogo copy gitlogominus -to 11 5
12613     image delete gitlogominus
12614
12615     image create photo gitlogoplus  -width  4 -height  4
12616     gitlogoplus  put #008000 -to 1 0 3 4
12617     gitlogoplus  put #008000 -to 0 1 4 3
12618     gitlogo copy gitlogoplus  -to  1 9
12619     gitlogo copy gitlogoplus  -to  6 9
12620     gitlogo copy gitlogoplus  -to 11 9
12621     image delete gitlogoplus
12622
12623     image create photo gitlogo32    -width 32 -height 32
12624     gitlogo32 copy gitlogo -zoom 2 2
12625
12626     wm iconphoto . -default gitlogo gitlogo32
12627 }
12628 # wait for the window to become visible
12629 tkwait visibility .
12630 set_window_title
12631 update
12632 readrefs
12633
12634 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12635     # create a view for the files/dirs specified on the command line
12636     set curview 1
12637     set selectedview 1
12638     set nextviewnum 2
12639     set viewname(1) [mc "Command line"]
12640     set viewfiles(1) $cmdline_files
12641     set viewargs(1) $revtreeargs
12642     set viewargscmd(1) $revtreeargscmd
12643     set viewperm(1) 0
12644     set viewchanged(1) 0
12645     set vdatemode(1) 0
12646     addviewmenu 1
12647     .bar.view entryconf [mca "&Edit view..."] -state normal
12648     .bar.view entryconf [mca "&Delete view"] -state normal
12649 }
12650
12651 if {[info exists permviews]} {
12652     foreach v $permviews {
12653         set n $nextviewnum
12654         incr nextviewnum
12655         set viewname($n) [lindex $v 0]
12656         set viewfiles($n) [lindex $v 1]
12657         set viewargs($n) [lindex $v 2]
12658         set viewargscmd($n) [lindex $v 3]
12659         set viewperm($n) 1
12660         set viewchanged($n) 0
12661         addviewmenu $n
12662     }
12663 }
12664
12665 if {[tk windowingsystem] eq "win32"} {
12666     focus -force .
12667 }
12668
12669 getcommits {}
12670
12671 # Local variables:
12672 # mode: tcl
12673 # indent-tabs-mode: t
12674 # tab-width: 8
12675 # End: