Pileus Git - ~andy/git/blob - gitk-git/gitk

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 # Copyright © 2005-2011 Paul Mackerras.  All rights reserved.
   6 # This program is free software; it may be used, copied, modified
   7 # and distributed under the terms of the GNU General Public Licence,
   8 # either version 2, or (at your option) any later version.
   9
  10 package require Tk
  11
  12 proc hasworktree {} {
  13     return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
  14                   [exec git rev-parse --is-inside-git-dir] == "false"}]
  15 }
  16
  17 proc reponame {} {
  18     global gitdir
  19     set n [file normalize $gitdir]
  20     if {[string match "*/.git" $n]} {
  21         set n [string range $n 0 end-5]
  22     }
  23     return [file tail $n]
  24 }
  25
  26 proc gitworktree {} {
  27     variable _gitworktree
  28     if {[info exists _gitworktree]} {
  29         return $_gitworktree
  30     }
  31     # v1.7.0 introduced --show-toplevel to return the canonical work-tree
  32     if {[catch {set _gitworktree [exec git rev-parse --show-toplevel]}]} {
  33         # try to set work tree from environment, core.worktree or use
  34         # cdup to obtain a relative path to the top of the worktree. If
  35         # run from the top, the ./ prefix ensures normalize expands pwd.
  36         if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
  37             catch {set _gitworktree [exec git config --get core.worktree]}
  38             if {$_gitworktree eq ""} {
  39                 set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]]
  40             }
  41         }
  42     }
  43     return $_gitworktree
  44 }
  45
  46 # A simple scheduler for compute-intensive stuff.
  47 # The aim is to make sure that event handlers for GUI actions can
  48 # run at least every 50-100 ms.  Unfortunately fileevent handlers are
  49 # run before X event handlers, so reading from a fast source can
  50 # make the GUI completely unresponsive.
  51 proc run args {
  52     global isonrunq runq currunq
  53
  54     set script $args
  55     if {[info exists isonrunq($script)]} return
  56     if {$runq eq {} && ![info exists currunq]} {
  57         after idle dorunq
  58     }
  59     lappend runq [list {} $script]
  60     set isonrunq($script) 1
  61 }
  62
  63 proc filerun {fd script} {
  64     fileevent $fd readable [list filereadable $fd $script]
  65 }
  66
  67 proc filereadable {fd script} {
  68     global runq currunq
  69
  70     fileevent $fd readable {}
  71     if {$runq eq {} && ![info exists currunq]} {
  72         after idle dorunq
  73     }
  74     lappend runq [list $fd $script]
  75 }
  76
  77 proc nukefile {fd} {
  78     global runq
  79
  80     for {set i 0} {$i < [llength $runq]} {} {
  81         if {[lindex $runq $i 0] eq $fd} {
  82             set runq [lreplace $runq $i $i]
  83         } else {
  84             incr i
  85         }
  86     }
  87 }
  88
  89 proc dorunq {} {
  90     global isonrunq runq currunq
  91
  92     set tstart [clock clicks -milliseconds]
  93     set t0 $tstart
  94     while {[llength $runq] > 0} {
  95         set fd [lindex $runq 0 0]
  96         set script [lindex $runq 0 1]
  97         set currunq [lindex $runq 0]
  98         set runq [lrange $runq 1 end]
  99         set repeat [eval $script]
 100         unset currunq
 101         set t1 [clock clicks -milliseconds]
 102         set t [expr {$t1 - $t0}]
 103         if {$repeat ne {} && $repeat} {
 104             if {$fd eq {} || $repeat == 2} {
 105                 # script returns 1 if it wants to be readded
 106                 # file readers return 2 if they could do more straight away
 107                 lappend runq [list $fd $script]
 108             } else {
 109                 fileevent $fd readable [list filereadable $fd $script]
 110             }
 111         } elseif {$fd eq {}} {
 112             unset isonrunq($script)
 113         }
 114         set t0 $t1
 115         if {$t1 - $tstart >= 80} break
 116     }
 117     if {$runq ne {}} {
 118         after idle dorunq
 119     }
 120 }
 121
 122 proc reg_instance {fd} {
 123     global commfd leftover loginstance
 124
 125     set i [incr loginstance]
 126     set commfd($i) $fd
 127     set leftover($i) {}
 128     return $i
 129 }
 130
 131 proc unmerged_files {files} {
 132     global nr_unmerged
 133
 134     # find the list of unmerged files
 135     set mlist {}
 136     set nr_unmerged 0
 137     if {[catch {
 138         set fd [open "| git ls-files -u" r]
 139     } err]} {
 140         show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
 141         exit 1
 142     }
 143     while {[gets $fd line] >= 0} {
 144         set i [string first "\t" $line]
 145         if {$i < 0} continue
 146         set fname [string range $line [expr {$i+1}] end]
 147         if {[lsearch -exact $mlist $fname] >= 0} continue
 148         incr nr_unmerged
 149         if {$files eq {} || [path_filter $files $fname]} {
 150             lappend mlist $fname
 151         }
 152     }
 153     catch {close $fd}
 154     return $mlist
 155 }
 156
 157 proc parseviewargs {n arglist} {
 158     global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
 159     global vinlinediff
 160     global worddiff git_version
 161
 162     set vdatemode($n) 0
 163     set vmergeonly($n) 0
 164     set vinlinediff($n) 0
 165     set glflags {}
 166     set diffargs {}
 167     set nextisval 0
 168     set revargs {}
 169     set origargs $arglist
 170     set allknown 1
 171     set filtered 0
 172     set i -1
 173     foreach arg $arglist {
 174         incr i
 175         if {$nextisval} {
 176             lappend glflags $arg
 177             set nextisval 0
 178             continue
 179         }
 180         switch -glob -- $arg {
 181             "-d" -
 182             "--date-order" {
 183                 set vdatemode($n) 1
 184                 # remove from origargs in case we hit an unknown option
 185                 set origargs [lreplace $origargs $i $i]
 186                 incr i -1
 187             }
 188             "-[puabwcrRBMC]" -
 189             "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
 190             "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
 191             "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
 192             "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
 193             "--ignore-space-change" - "-U*" - "--unified=*" {
 194                 # These request or affect diff output, which we don't want.
 195                 # Some could be used to set our defaults for diff display.
 196                 lappend diffargs $arg
 197             }
 198             "--raw" - "--patch-with-raw" - "--patch-with-stat" -
 199             "--name-only" - "--name-status" - "--color" -
 200             "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
 201             "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
 202             "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
 203             "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
 204             "--objects" - "--objects-edge" - "--reverse" {
 205                 # These cause our parsing of git log's output to fail, or else
 206                 # they're options we want to set ourselves, so ignore them.
 207             }
 208             "--color-words*" - "--word-diff=color" {
 209                 # These trigger a word diff in the console interface,
 210                 # so help the user by enabling our own support
 211                 if {[package vcompare $git_version "1.7.2"] >= 0} {
 212                     set worddiff [mc "Color words"]
 213                 }
 214             }
 215             "--word-diff*" {
 216                 if {[package vcompare $git_version "1.7.2"] >= 0} {
 217                     set worddiff [mc "Markup words"]
 218                 }
 219             }
 220             "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
 221             "--check" - "--exit-code" - "--quiet" - "--topo-order" -
 222             "--full-history" - "--dense" - "--sparse" -
 223             "--follow" - "--left-right" - "--encoding=*" {
 224                 # These are harmless, and some are even useful
 225                 lappend glflags $arg
 226             }
 227             "--diff-filter=*" - "--no-merges" - "--unpacked" -
 228             "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
 229             "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
 230             "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
 231             "--remove-empty" - "--first-parent" - "--cherry-pick" -
 232             "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
 233             "--simplify-by-decoration" {
 234                 # These mean that we get a subset of the commits
 235                 set filtered 1
 236                 lappend glflags $arg
 237             }
 238             "-L*" {
 239                 # Line-log with 'stuck' argument (unstuck form is
 240                 # not supported)
 241                 set filtered 1
 242                 set vinlinediff($n) 1
 243                 set allknown 0
 244                 lappend glflags $arg
 245             }
 246             "-n" {
 247                 # This appears to be the only one that has a value as a
 248                 # separate word following it
 249                 set filtered 1
 250                 set nextisval 1
 251                 lappend glflags $arg
 252             }
 253             "--not" - "--all" {
 254                 lappend revargs $arg
 255             }
 256             "--merge" {
 257                 set vmergeonly($n) 1
 258                 # git rev-parse doesn't understand --merge
 259                 lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
 260             }
 261             "--no-replace-objects" {
 262                 set env(GIT_NO_REPLACE_OBJECTS) "1"
 263             }
 264             "-*" {
 265                 # Other flag arguments including -<n>
 266                 if {[string is digit -strict [string range $arg 1 end]]} {
 267                     set filtered 1
 268                 } else {
 269                     # a flag argument that we don't recognize;
 270                     # that means we can't optimize
 271                     set allknown 0
 272                 }
 273                 lappend glflags $arg
 274             }
 275             default {
 276                 # Non-flag arguments specify commits or ranges of commits
 277                 if {[string match "*...*" $arg]} {
 278                     lappend revargs --gitk-symmetric-diff-marker
 279                 }
 280                 lappend revargs $arg
 281             }
 282         }
 283     }
 284     set vdflags($n) $diffargs
 285     set vflags($n) $glflags
 286     set vrevs($n) $revargs
 287     set vfiltered($n) $filtered
 288     set vorigargs($n) $origargs
 289     return $allknown
 290 }
 291
 292 proc parseviewrevs {view revs} {
 293     global vposids vnegids
 294
 295     if {$revs eq {}} {
 296         set revs HEAD
 297     }
 298     if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
 299         # we get stdout followed by stderr in $err
 300         # for an unknown rev, git rev-parse echoes it and then errors out
 301         set errlines [split $err "\n"]
 302         set badrev {}
 303         for {set l 0} {$l < [llength $errlines]} {incr l} {
 304             set line [lindex $errlines $l]
 305             if {!([string length $line] == 40 && [string is xdigit $line])} {
 306                 if {[string match "fatal:*" $line]} {
 307                     if {[string match "fatal: ambiguous argument*" $line]
 308                         && $badrev ne {}} {
 309                         if {[llength $badrev] == 1} {
 310                             set err "unknown revision $badrev"
 311                         } else {
 312                             set err "unknown revisions: [join $badrev ", "]"
 313                         }
 314                     } else {
 315                         set err [join [lrange $errlines $l end] "\n"]
 316                     }
 317                     break
 318                 }
 319                 lappend badrev $line
 320             }
 321         }
 322         error_popup "[mc "Error parsing revisions:"] $err"
 323         return {}
 324     }
 325     set ret {}
 326     set pos {}
 327     set neg {}
 328     set sdm 0
 329     foreach id [split $ids "\n"] {
 330         if {$id eq "--gitk-symmetric-diff-marker"} {
 331             set sdm 4
 332         } elseif {[string match "^*" $id]} {
 333             if {$sdm != 1} {
 334                 lappend ret $id
 335                 if {$sdm == 3} {
 336                     set sdm 0
 337                 }
 338             }
 339             lappend neg [string range $id 1 end]
 340         } else {
 341             if {$sdm != 2} {
 342                 lappend ret $id
 343             } else {
 344                 lset ret end $id...[lindex $ret end]
 345             }
 346             lappend pos $id
 347         }
 348         incr sdm -1
 349     }
 350     set vposids($view) $pos
 351     set vnegids($view) $neg
 352     return $ret
 353 }
 354
 355 # Start off a git log process and arrange to read its output
 356 proc start_rev_list {view} {
 357     global startmsecs commitidx viewcomplete curview
 358     global tclencoding
 359     global viewargs viewargscmd viewfiles vfilelimit
 360     global showlocalchanges
 361     global viewactive viewinstances vmergeonly
 362     global mainheadid viewmainheadid viewmainheadid_orig
 363     global vcanopt vflags vrevs vorigargs
 364     global show_notes
 365
 366     set startmsecs [clock clicks -milliseconds]
 367     set commitidx($view) 0
 368     # these are set this way for the error exits
 369     set viewcomplete($view) 1
 370     set viewactive($view) 0
 371     varcinit $view
 372
 373     set args $viewargs($view)
 374     if {$viewargscmd($view) ne {}} {
 375         if {[catch {
 376             set str [exec sh -c $viewargscmd($view)]
 377         } err]} {
 378             error_popup "[mc "Error executing --argscmd command:"] $err"
 379             return 0
 380         }
 381         set args [concat $args [split $str "\n"]]
 382     }
 383     set vcanopt($view) [parseviewargs $view $args]
 384
 385     set files $viewfiles($view)
 386     if {$vmergeonly($view)} {
 387         set files [unmerged_files $files]
 388         if {$files eq {}} {
 389             global nr_unmerged
 390             if {$nr_unmerged == 0} {
 391                 error_popup [mc "No files selected: --merge specified but\
 392                              no files are unmerged."]
 393             } else {
 394                 error_popup [mc "No files selected: --merge specified but\
 395                              no unmerged files are within file limit."]
 396             }
 397             return 0
 398         }
 399     }
 400     set vfilelimit($view) $files
 401
 402     if {$vcanopt($view)} {
 403         set revs [parseviewrevs $view $vrevs($view)]
 404         if {$revs eq {}} {
 405             return 0
 406         }
 407         set args [concat $vflags($view) $revs]
 408     } else {
 409         set args $vorigargs($view)
 410     }
 411
 412     if {[catch {
 413         set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 414                         --parents --boundary $args "--" $files] r]
 415     } err]} {
 416         error_popup "[mc "Error executing git log:"] $err"
 417         return 0
 418     }
 419     set i [reg_instance $fd]
 420     set viewinstances($view) [list $i]
 421     set viewmainheadid($view) $mainheadid
 422     set viewmainheadid_orig($view) $mainheadid
 423     if {$files ne {} && $mainheadid ne {}} {
 424         get_viewmainhead $view
 425     }
 426     if {$showlocalchanges && $viewmainheadid($view) ne {}} {
 427         interestedin $viewmainheadid($view) dodiffindex
 428     }
 429     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 430     if {$tclencoding != {}} {
 431         fconfigure $fd -encoding $tclencoding
 432     }
 433     filerun $fd [list getcommitlines $fd $i $view 0]
 434     nowbusy $view [mc "Reading"]
 435     set viewcomplete($view) 0
 436     set viewactive($view) 1
 437     return 1
 438 }
 439
 440 proc stop_instance {inst} {
 441     global commfd leftover
 442
 443     set fd $commfd($inst)
 444     catch {
 445         set pid [pid $fd]
 446
 447         if {$::tcl_platform(platform) eq {windows}} {
 448             exec kill -f $pid
 449         } else {
 450             exec kill $pid
 451         }
 452     }
 453     catch {close $fd}
 454     nukefile $fd
 455     unset commfd($inst)
 456     unset leftover($inst)
 457 }
 458
 459 proc stop_backends {} {
 460     global commfd
 461
 462     foreach inst [array names commfd] {
 463         stop_instance $inst
 464     }
 465 }
 466
 467 proc stop_rev_list {view} {
 468     global viewinstances
 469
 470     foreach inst $viewinstances($view) {
 471         stop_instance $inst
 472     }
 473     set viewinstances($view) {}
 474 }
 475
 476 proc reset_pending_select {selid} {
 477     global pending_select mainheadid selectheadid
 478
 479     if {$selid ne {}} {
 480         set pending_select $selid
 481     } elseif {$selectheadid ne {}} {
 482         set pending_select $selectheadid
 483     } else {
 484         set pending_select $mainheadid
 485     }
 486 }
 487
 488 proc getcommits {selid} {
 489     global canv curview need_redisplay viewactive
 490
 491     initlayout
 492     if {[start_rev_list $curview]} {
 493         reset_pending_select $selid
 494         show_status [mc "Reading commits..."]
 495         set need_redisplay 1
 496     } else {
 497         show_status [mc "No commits selected"]
 498     }
 499 }
 500
 501 proc updatecommits {} {
 502     global curview vcanopt vorigargs vfilelimit viewinstances
 503     global viewactive viewcomplete tclencoding
 504     global startmsecs showneartags showlocalchanges
 505     global mainheadid viewmainheadid viewmainheadid_orig pending_select
 506     global hasworktree
 507     global varcid vposids vnegids vflags vrevs
 508     global show_notes
 509
 510     set hasworktree [hasworktree]
 511     rereadrefs
 512     set view $curview
 513     if {$mainheadid ne $viewmainheadid_orig($view)} {
 514         if {$showlocalchanges} {
 515             dohidelocalchanges
 516         }
 517         set viewmainheadid($view) $mainheadid
 518         set viewmainheadid_orig($view) $mainheadid
 519         if {$vfilelimit($view) ne {}} {
 520             get_viewmainhead $view
 521         }
 522     }
 523     if {$showlocalchanges} {
 524         doshowlocalchanges
 525     }
 526     if {$vcanopt($view)} {
 527         set oldpos $vposids($view)
 528         set oldneg $vnegids($view)
 529         set revs [parseviewrevs $view $vrevs($view)]
 530         if {$revs eq {}} {
 531             return
 532         }
 533         # note: getting the delta when negative refs change is hard,
 534         # and could require multiple git log invocations, so in that
 535         # case we ask git log for all the commits (not just the delta)
 536         if {$oldneg eq $vnegids($view)} {
 537             set newrevs {}
 538             set npos 0
 539             # take out positive refs that we asked for before or
 540             # that we have already seen
 541             foreach rev $revs {
 542                 if {[string length $rev] == 40} {
 543                     if {[lsearch -exact $oldpos $rev] < 0
 544                         && ![info exists varcid($view,$rev)]} {
 545                         lappend newrevs $rev
 546                         incr npos
 547                     }
 548                 } else {
 549                     lappend $newrevs $rev
 550                 }
 551             }
 552             if {$npos == 0} return
 553             set revs $newrevs
 554             set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
 555         }
 556         set args [concat $vflags($view) $revs --not $oldpos]
 557     } else {
 558         set args $vorigargs($view)
 559     }
 560     if {[catch {
 561         set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 562                         --parents --boundary $args "--" $vfilelimit($view)] r]
 563     } err]} {
 564         error_popup "[mc "Error executing git log:"] $err"
 565         return
 566     }
 567     if {$viewactive($view) == 0} {
 568         set startmsecs [clock clicks -milliseconds]
 569     }
 570     set i [reg_instance $fd]
 571     lappend viewinstances($view) $i
 572     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 573     if {$tclencoding != {}} {
 574         fconfigure $fd -encoding $tclencoding
 575     }
 576     filerun $fd [list getcommitlines $fd $i $view 1]
 577     incr viewactive($view)
 578     set viewcomplete($view) 0
 579     reset_pending_select {}
 580     nowbusy $view [mc "Reading"]
 581     if {$showneartags} {
 582         getallcommits
 583     }
 584 }
 585
 586 proc reloadcommits {} {
 587     global curview viewcomplete selectedline currentid thickerline
 588     global showneartags treediffs commitinterest cached_commitrow
 589     global targetid
 590
 591     set selid {}
 592     if {$selectedline ne {}} {
 593         set selid $currentid
 594     }
 595
 596     if {!$viewcomplete($curview)} {
 597         stop_rev_list $curview
 598     }
 599     resetvarcs $curview
 600     set selectedline {}
 601     catch {unset currentid}
 602     catch {unset thickerline}
 603     catch {unset treediffs}
 604     readrefs
 605     changedrefs
 606     if {$showneartags} {
 607         getallcommits
 608     }
 609     clear_display
 610     catch {unset commitinterest}
 611     catch {unset cached_commitrow}
 612     catch {unset targetid}
 613     setcanvscroll
 614     getcommits $selid
 615     return 0
 616 }
 617
 618 # This makes a string representation of a positive integer which
 619 # sorts as a string in numerical order
 620 proc strrep {n} {
 621     if {$n < 16} {
 622         return [format "%x" $n]
 623     } elseif {$n < 256} {
 624         return [format "x%.2x" $n]
 625     } elseif {$n < 65536} {
 626         return [format "y%.4x" $n]
 627     }
 628     return [format "z%.8x" $n]
 629 }
 630
 631 # Procedures used in reordering commits from git log (without
 632 # --topo-order) into the order for display.
 633
 634 proc varcinit {view} {
 635     global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
 636     global vtokmod varcmod vrowmod varcix vlastins
 637
 638     set varcstart($view) {{}}
 639     set vupptr($view) {0}
 640     set vdownptr($view) {0}
 641     set vleftptr($view) {0}
 642     set vbackptr($view) {0}
 643     set varctok($view) {{}}
 644     set varcrow($view) {{}}
 645     set vtokmod($view) {}
 646     set varcmod($view) 0
 647     set vrowmod($view) 0
 648     set varcix($view) {{}}
 649     set vlastins($view) {0}
 650 }
 651
 652 proc resetvarcs {view} {
 653     global varcid varccommits parents children vseedcount ordertok
 654     global vshortids
 655
 656     foreach vid [array names varcid $view,*] {
 657         unset varcid($vid)
 658         unset children($vid)
 659         unset parents($vid)
 660     }
 661     foreach vid [array names vshortids $view,*] {
 662         unset vshortids($vid)
 663     }
 664     # some commits might have children but haven't been seen yet
 665     foreach vid [array names children $view,*] {
 666         unset children($vid)
 667     }
 668     foreach va [array names varccommits $view,*] {
 669         unset varccommits($va)
 670     }
 671     foreach vd [array names vseedcount $view,*] {
 672         unset vseedcount($vd)
 673     }
 674     catch {unset ordertok}
 675 }
 676
 677 # returns a list of the commits with no children
 678 proc seeds {v} {
 679     global vdownptr vleftptr varcstart
 680
 681     set ret {}
 682     set a [lindex $vdownptr($v) 0]
 683     while {$a != 0} {
 684         lappend ret [lindex $varcstart($v) $a]
 685         set a [lindex $vleftptr($v) $a]
 686     }
 687     return $ret
 688 }
 689
 690 proc newvarc {view id} {
 691     global varcid varctok parents children vdatemode
 692     global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
 693     global commitdata commitinfo vseedcount varccommits vlastins
 694
 695     set a [llength $varctok($view)]
 696     set vid $view,$id
 697     if {[llength $children($vid)] == 0 || $vdatemode($view)} {
 698         if {![info exists commitinfo($id)]} {
 699             parsecommit $id $commitdata($id) 1
 700         }
 701         set cdate [lindex [lindex $commitinfo($id) 4] 0]
 702         if {![string is integer -strict $cdate]} {
 703             set cdate 0
 704         }
 705         if {![info exists vseedcount($view,$cdate)]} {
 706             set vseedcount($view,$cdate) -1
 707         }
 708         set c [incr vseedcount($view,$cdate)]
 709         set cdate [expr {$cdate ^ 0xffffffff}]
 710         set tok "s[strrep $cdate][strrep $c]"
 711     } else {
 712         set tok {}
 713     }
 714     set ka 0
 715     if {[llength $children($vid)] > 0} {
 716         set kid [lindex $children($vid) end]
 717         set k $varcid($view,$kid)
 718         if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
 719             set ki $kid
 720             set ka $k
 721             set tok [lindex $varctok($view) $k]
 722         }
 723     }
 724     if {$ka != 0} {
 725         set i [lsearch -exact $parents($view,$ki) $id]
 726         set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 727         append tok [strrep $j]
 728     }
 729     set c [lindex $vlastins($view) $ka]
 730     if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
 731         set c $ka
 732         set b [lindex $vdownptr($view) $ka]
 733     } else {
 734         set b [lindex $vleftptr($view) $c]
 735     }
 736     while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 737         set c $b
 738         set b [lindex $vleftptr($view) $c]
 739     }
 740     if {$c == $ka} {
 741         lset vdownptr($view) $ka $a
 742         lappend vbackptr($view) 0
 743     } else {
 744         lset vleftptr($view) $c $a
 745         lappend vbackptr($view) $c
 746     }
 747     lset vlastins($view) $ka $a
 748     lappend vupptr($view) $ka
 749     lappend vleftptr($view) $b
 750     if {$b != 0} {
 751         lset vbackptr($view) $b $a
 752     }
 753     lappend varctok($view) $tok
 754     lappend varcstart($view) $id
 755     lappend vdownptr($view) 0
 756     lappend varcrow($view) {}
 757     lappend varcix($view) {}
 758     set varccommits($view,$a) {}
 759     lappend vlastins($view) 0
 760     return $a
 761 }
 762
 763 proc splitvarc {p v} {
 764     global varcid varcstart varccommits varctok vtokmod
 765     global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
 766
 767     set oa $varcid($v,$p)
 768     set otok [lindex $varctok($v) $oa]
 769     set ac $varccommits($v,$oa)
 770     set i [lsearch -exact $varccommits($v,$oa) $p]
 771     if {$i <= 0} return
 772     set na [llength $varctok($v)]
 773     # "%" sorts before "0"...
 774     set tok "$otok%[strrep $i]"
 775     lappend varctok($v) $tok
 776     lappend varcrow($v) {}
 777     lappend varcix($v) {}
 778     set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 779     set varccommits($v,$na) [lrange $ac $i end]
 780     lappend varcstart($v) $p
 781     foreach id $varccommits($v,$na) {
 782         set varcid($v,$id) $na
 783     }
 784     lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 785     lappend vlastins($v) [lindex $vlastins($v) $oa]
 786     lset vdownptr($v) $oa $na
 787     lset vlastins($v) $oa 0
 788     lappend vupptr($v) $oa
 789     lappend vleftptr($v) 0
 790     lappend vbackptr($v) 0
 791     for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 792         lset vupptr($v) $b $na
 793     }
 794     if {[string compare $otok $vtokmod($v)] <= 0} {
 795         modify_arc $v $oa
 796     }
 797 }
 798
 799 proc renumbervarc {a v} {
 800     global parents children varctok varcstart varccommits
 801     global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
 802
 803     set t1 [clock clicks -milliseconds]
 804     set todo {}
 805     set isrelated($a) 1
 806     set kidchanged($a) 1
 807     set ntot 0
 808     while {$a != 0} {
 809         if {[info exists isrelated($a)]} {
 810             lappend todo $a
 811             set id [lindex $varccommits($v,$a) end]
 812             foreach p $parents($v,$id) {
 813                 if {[info exists varcid($v,$p)]} {
 814                     set isrelated($varcid($v,$p)) 1
 815                 }
 816             }
 817         }
 818         incr ntot
 819         set b [lindex $vdownptr($v) $a]
 820         if {$b == 0} {
 821             while {$a != 0} {
 822                 set b [lindex $vleftptr($v) $a]
 823                 if {$b != 0} break
 824                 set a [lindex $vupptr($v) $a]
 825             }
 826         }
 827         set a $b
 828     }
 829     foreach a $todo {
 830         if {![info exists kidchanged($a)]} continue
 831         set id [lindex $varcstart($v) $a]
 832         if {[llength $children($v,$id)] > 1} {
 833             set children($v,$id) [lsort -command [list vtokcmp $v] \
 834                                       $children($v,$id)]
 835         }
 836         set oldtok [lindex $varctok($v) $a]
 837         if {!$vdatemode($v)} {
 838             set tok {}
 839         } else {
 840             set tok $oldtok
 841         }
 842         set ka 0
 843         set kid [last_real_child $v,$id]
 844         if {$kid ne {}} {
 845             set k $varcid($v,$kid)
 846             if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
 847                 set ki $kid
 848                 set ka $k
 849                 set tok [lindex $varctok($v) $k]
 850             }
 851         }
 852         if {$ka != 0} {
 853             set i [lsearch -exact $parents($v,$ki) $id]
 854             set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 855             append tok [strrep $j]
 856         }
 857         if {$tok eq $oldtok} {
 858             continue
 859         }
 860         set id [lindex $varccommits($v,$a) end]
 861         foreach p $parents($v,$id) {
 862             if {[info exists varcid($v,$p)]} {
 863                 set kidchanged($varcid($v,$p)) 1
 864             } else {
 865                 set sortkids($p) 1
 866             }
 867         }
 868         lset varctok($v) $a $tok
 869         set b [lindex $vupptr($v) $a]
 870         if {$b != $ka} {
 871             if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
 872                 modify_arc $v $ka
 873             }
 874             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 875                 modify_arc $v $b
 876             }
 877             set c [lindex $vbackptr($v) $a]
 878             set d [lindex $vleftptr($v) $a]
 879             if {$c == 0} {
 880                 lset vdownptr($v) $b $d
 881             } else {
 882                 lset vleftptr($v) $c $d
 883             }
 884             if {$d != 0} {
 885                 lset vbackptr($v) $d $c
 886             }
 887             if {[lindex $vlastins($v) $b] == $a} {
 888                 lset vlastins($v) $b $c
 889             }
 890             lset vupptr($v) $a $ka
 891             set c [lindex $vlastins($v) $ka]
 892             if {$c == 0 || \
 893                     [string compare $tok [lindex $varctok($v) $c]] < 0} {
 894                 set c $ka
 895                 set b [lindex $vdownptr($v) $ka]
 896             } else {
 897                 set b [lindex $vleftptr($v) $c]
 898             }
 899             while {$b != 0 && \
 900                       [string compare $tok [lindex $varctok($v) $b]] >= 0} {
 901                 set c $b
 902                 set b [lindex $vleftptr($v) $c]
 903             }
 904             if {$c == $ka} {
 905                 lset vdownptr($v) $ka $a
 906                 lset vbackptr($v) $a 0
 907             } else {
 908                 lset vleftptr($v) $c $a
 909                 lset vbackptr($v) $a $c
 910             }
 911             lset vleftptr($v) $a $b
 912             if {$b != 0} {
 913                 lset vbackptr($v) $b $a
 914             }
 915             lset vlastins($v) $ka $a
 916         }
 917     }
 918     foreach id [array names sortkids] {
 919         if {[llength $children($v,$id)] > 1} {
 920             set children($v,$id) [lsort -command [list vtokcmp $v] \
 921                                       $children($v,$id)]
 922         }
 923     }
 924     set t2 [clock clicks -milliseconds]
 925     #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 926 }
 927
 928 # Fix up the graph after we have found out that in view $v,
 929 # $p (a commit that we have already seen) is actually the parent
 930 # of the last commit in arc $a.
 931 proc fix_reversal {p a v} {
 932     global varcid varcstart varctok vupptr
 933
 934     set pa $varcid($v,$p)
 935     if {$p ne [lindex $varcstart($v) $pa]} {
 936         splitvarc $p $v
 937         set pa $varcid($v,$p)
 938     }
 939     # seeds always need to be renumbered
 940     if {[lindex $vupptr($v) $pa] == 0 ||
 941         [string compare [lindex $varctok($v) $a] \
 942              [lindex $varctok($v) $pa]] > 0} {
 943         renumbervarc $pa $v
 944     }
 945 }
 946
 947 proc insertrow {id p v} {
 948     global cmitlisted children parents varcid varctok vtokmod
 949     global varccommits ordertok commitidx numcommits curview
 950     global targetid targetrow vshortids
 951
 952     readcommit $id
 953     set vid $v,$id
 954     set cmitlisted($vid) 1
 955     set children($vid) {}
 956     set parents($vid) [list $p]
 957     set a [newvarc $v $id]
 958     set varcid($vid) $a
 959     lappend vshortids($v,[string range $id 0 3]) $id
 960     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
 961         modify_arc $v $a
 962     }
 963     lappend varccommits($v,$a) $id
 964     set vp $v,$p
 965     if {[llength [lappend children($vp) $id]] > 1} {
 966         set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
 967         catch {unset ordertok}
 968     }
 969     fix_reversal $p $a $v
 970     incr commitidx($v)
 971     if {$v == $curview} {
 972         set numcommits $commitidx($v)
 973         setcanvscroll
 974         if {[info exists targetid]} {
 975             if {![comes_before $targetid $p]} {
 976                 incr targetrow
 977             }
 978         }
 979     }
 980 }
 981
 982 proc insertfakerow {id p} {
 983     global varcid varccommits parents children cmitlisted
 984     global commitidx varctok vtokmod targetid targetrow curview numcommits
 985
 986     set v $curview
 987     set a $varcid($v,$p)
 988     set i [lsearch -exact $varccommits($v,$a) $p]
 989     if {$i < 0} {
 990         puts "oops: insertfakerow can't find [shortids $p] on arc $a"
 991         return
 992     }
 993     set children($v,$id) {}
 994     set parents($v,$id) [list $p]
 995     set varcid($v,$id) $a
 996     lappend children($v,$p) $id
 997     set cmitlisted($v,$id) 1
 998     set numcommits [incr commitidx($v)]
 999     # note we deliberately don't update varcstart($v) even if $i == 0
1000     set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
1001     modify_arc $v $a $i
1002     if {[info exists targetid]} {
1003         if {![comes_before $targetid $p]} {
1004             incr targetrow
1005         }
1006     }
1007     setcanvscroll
1008     drawvisible
1009 }
1010
1011 proc removefakerow {id} {
1012     global varcid varccommits parents children commitidx
1013     global varctok vtokmod cmitlisted currentid selectedline
1014     global targetid curview numcommits
1015
1016     set v $curview
1017     if {[llength $parents($v,$id)] != 1} {
1018         puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1019         return
1020     }
1021     set p [lindex $parents($v,$id) 0]
1022     set a $varcid($v,$id)
1023     set i [lsearch -exact $varccommits($v,$a) $id]
1024     if {$i < 0} {
1025         puts "oops: removefakerow can't find [shortids $id] on arc $a"
1026         return
1027     }
1028     unset varcid($v,$id)
1029     set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1030     unset parents($v,$id)
1031     unset children($v,$id)
1032     unset cmitlisted($v,$id)
1033     set numcommits [incr commitidx($v) -1]
1034     set j [lsearch -exact $children($v,$p) $id]
1035     if {$j >= 0} {
1036         set children($v,$p) [lreplace $children($v,$p) $j $j]
1037     }
1038     modify_arc $v $a $i
1039     if {[info exist currentid] && $id eq $currentid} {
1040         unset currentid
1041         set selectedline {}
1042     }
1043     if {[info exists targetid] && $targetid eq $id} {
1044         set targetid $p
1045     }
1046     setcanvscroll
1047     drawvisible
1048 }
1049
1050 proc real_children {vp} {
1051     global children nullid nullid2
1052
1053     set kids {}
1054     foreach id $children($vp) {
1055         if {$id ne $nullid && $id ne $nullid2} {
1056             lappend kids $id
1057         }
1058     }
1059     return $kids
1060 }
1061
1062 proc first_real_child {vp} {
1063     global children nullid nullid2
1064
1065     foreach id $children($vp) {
1066         if {$id ne $nullid && $id ne $nullid2} {
1067             return $id
1068         }
1069     }
1070     return {}
1071 }
1072
1073 proc last_real_child {vp} {
1074     global children nullid nullid2
1075
1076     set kids $children($vp)
1077     for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1078         set id [lindex $kids $i]
1079         if {$id ne $nullid && $id ne $nullid2} {
1080             return $id
1081         }
1082     }
1083     return {}
1084 }
1085
1086 proc vtokcmp {v a b} {
1087     global varctok varcid
1088
1089     return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1090                 [lindex $varctok($v) $varcid($v,$b)]]
1091 }
1092
1093 # This assumes that if lim is not given, the caller has checked that
1094 # arc a's token is less than $vtokmod($v)
1095 proc modify_arc {v a {lim {}}} {
1096     global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1097
1098     if {$lim ne {}} {
1099         set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1100         if {$c > 0} return
1101         if {$c == 0} {
1102             set r [lindex $varcrow($v) $a]
1103             if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1104         }
1105     }
1106     set vtokmod($v) [lindex $varctok($v) $a]
1107     set varcmod($v) $a
1108     if {$v == $curview} {
1109         while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1110             set a [lindex $vupptr($v) $a]
1111             set lim {}
1112         }
1113         set r 0
1114         if {$a != 0} {
1115             if {$lim eq {}} {
1116                 set lim [llength $varccommits($v,$a)]
1117             }
1118             set r [expr {[lindex $varcrow($v) $a] + $lim}]
1119         }
1120         set vrowmod($v) $r
1121         undolayout $r
1122     }
1123 }
1124
1125 proc update_arcrows {v} {
1126     global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1127     global varcid vrownum varcorder varcix varccommits
1128     global vupptr vdownptr vleftptr varctok
1129     global displayorder parentlist curview cached_commitrow
1130
1131     if {$vrowmod($v) == $commitidx($v)} return
1132     if {$v == $curview} {
1133         if {[llength $displayorder] > $vrowmod($v)} {
1134             set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1135             set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1136         }
1137         catch {unset cached_commitrow}
1138     }
1139     set narctot [expr {[llength $varctok($v)] - 1}]
1140     set a $varcmod($v)
1141     while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1142         # go up the tree until we find something that has a row number,
1143         # or we get to a seed
1144         set a [lindex $vupptr($v) $a]
1145     }
1146     if {$a == 0} {
1147         set a [lindex $vdownptr($v) 0]
1148         if {$a == 0} return
1149         set vrownum($v) {0}
1150         set varcorder($v) [list $a]
1151         lset varcix($v) $a 0
1152         lset varcrow($v) $a 0
1153         set arcn 0
1154         set row 0
1155     } else {
1156         set arcn [lindex $varcix($v) $a]
1157         if {[llength $vrownum($v)] > $arcn + 1} {
1158             set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1159             set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1160         }
1161         set row [lindex $varcrow($v) $a]
1162     }
1163     while {1} {
1164         set p $a
1165         incr row [llength $varccommits($v,$a)]
1166         # go down if possible
1167         set b [lindex $vdownptr($v) $a]
1168         if {$b == 0} {
1169             # if not, go left, or go up until we can go left
1170             while {$a != 0} {
1171                 set b [lindex $vleftptr($v) $a]
1172                 if {$b != 0} break
1173                 set a [lindex $vupptr($v) $a]
1174             }
1175             if {$a == 0} break
1176         }
1177         set a $b
1178         incr arcn
1179         lappend vrownum($v) $row
1180         lappend varcorder($v) $a
1181         lset varcix($v) $a $arcn
1182         lset varcrow($v) $a $row
1183     }
1184     set vtokmod($v) [lindex $varctok($v) $p]
1185     set varcmod($v) $p
1186     set vrowmod($v) $row
1187     if {[info exists currentid]} {
1188         set selectedline [rowofcommit $currentid]
1189     }
1190 }
1191
1192 # Test whether view $v contains commit $id
1193 proc commitinview {id v} {
1194     global varcid
1195
1196     return [info exists varcid($v,$id)]
1197 }
1198
1199 # Return the row number for commit $id in the current view
1200 proc rowofcommit {id} {
1201     global varcid varccommits varcrow curview cached_commitrow
1202     global varctok vtokmod
1203
1204     set v $curview
1205     if {![info exists varcid($v,$id)]} {
1206         puts "oops rowofcommit no arc for [shortids $id]"
1207         return {}
1208     }
1209     set a $varcid($v,$id)
1210     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1211         update_arcrows $v
1212     }
1213     if {[info exists cached_commitrow($id)]} {
1214         return $cached_commitrow($id)
1215     }
1216     set i [lsearch -exact $varccommits($v,$a) $id]
1217     if {$i < 0} {
1218         puts "oops didn't find commit [shortids $id] in arc $a"
1219         return {}
1220     }
1221     incr i [lindex $varcrow($v) $a]
1222     set cached_commitrow($id) $i
1223     return $i
1224 }
1225
1226 # Returns 1 if a is on an earlier row than b, otherwise 0
1227 proc comes_before {a b} {
1228     global varcid varctok curview
1229
1230     set v $curview
1231     if {$a eq $b || ![info exists varcid($v,$a)] || \
1232             ![info exists varcid($v,$b)]} {
1233         return 0
1234     }
1235     if {$varcid($v,$a) != $varcid($v,$b)} {
1236         return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1237                            [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1238     }
1239     return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1240 }
1241
1242 proc bsearch {l elt} {
1243     if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1244         return 0
1245     }
1246     set lo 0
1247     set hi [llength $l]
1248     while {$hi - $lo > 1} {
1249         set mid [expr {int(($lo + $hi) / 2)}]
1250         set t [lindex $l $mid]
1251         if {$elt < $t} {
1252             set hi $mid
1253         } elseif {$elt > $t} {
1254             set lo $mid
1255         } else {
1256             return $mid
1257         }
1258     }
1259     return $lo
1260 }
1261
1262 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
1263 proc make_disporder {start end} {
1264     global vrownum curview commitidx displayorder parentlist
1265     global varccommits varcorder parents vrowmod varcrow
1266     global d_valid_start d_valid_end
1267
1268     if {$end > $vrowmod($curview)} {
1269         update_arcrows $curview
1270     }
1271     set ai [bsearch $vrownum($curview) $start]
1272     set start [lindex $vrownum($curview) $ai]
1273     set narc [llength $vrownum($curview)]
1274     for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1275         set a [lindex $varcorder($curview) $ai]
1276         set l [llength $displayorder]
1277         set al [llength $varccommits($curview,$a)]
1278         if {$l < $r + $al} {
1279             if {$l < $r} {
1280                 set pad [ntimes [expr {$r - $l}] {}]
1281                 set displayorder [concat $displayorder $pad]
1282                 set parentlist [concat $parentlist $pad]
1283             } elseif {$l > $r} {
1284                 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1285                 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1286             }
1287             foreach id $varccommits($curview,$a) {
1288                 lappend displayorder $id
1289                 lappend parentlist $parents($curview,$id)
1290             }
1291         } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1292             set i $r
1293             foreach id $varccommits($curview,$a) {
1294                 lset displayorder $i $id
1295                 lset parentlist $i $parents($curview,$id)
1296                 incr i
1297             }
1298         }
1299         incr r $al
1300     }
1301 }
1302
1303 proc commitonrow {row} {
1304     global displayorder
1305
1306     set id [lindex $displayorder $row]
1307     if {$id eq {}} {
1308         make_disporder $row [expr {$row + 1}]
1309         set id [lindex $displayorder $row]
1310     }
1311     return $id
1312 }
1313
1314 proc closevarcs {v} {
1315     global varctok varccommits varcid parents children
1316     global cmitlisted commitidx vtokmod
1317
1318     set missing_parents 0
1319     set scripts {}
1320     set narcs [llength $varctok($v)]
1321     for {set a 1} {$a < $narcs} {incr a} {
1322         set id [lindex $varccommits($v,$a) end]
1323         foreach p $parents($v,$id) {
1324             if {[info exists varcid($v,$p)]} continue
1325             # add p as a new commit
1326             incr missing_parents
1327             set cmitlisted($v,$p) 0
1328             set parents($v,$p) {}
1329             if {[llength $children($v,$p)] == 1 &&
1330                 [llength $parents($v,$id)] == 1} {
1331                 set b $a
1332             } else {
1333                 set b [newvarc $v $p]
1334             }
1335             set varcid($v,$p) $b
1336             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1337                 modify_arc $v $b
1338             }
1339             lappend varccommits($v,$b) $p
1340             incr commitidx($v)
1341             set scripts [check_interest $p $scripts]
1342         }
1343     }
1344     if {$missing_parents > 0} {
1345         foreach s $scripts {
1346             eval $s
1347         }
1348     }
1349 }
1350
1351 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1352 # Assumes we already have an arc for $rwid.
1353 proc rewrite_commit {v id rwid} {
1354     global children parents varcid varctok vtokmod varccommits
1355
1356     foreach ch $children($v,$id) {
1357         # make $rwid be $ch's parent in place of $id
1358         set i [lsearch -exact $parents($v,$ch) $id]
1359         if {$i < 0} {
1360             puts "oops rewrite_commit didn't find $id in parent list for $ch"
1361         }
1362         set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1363         # add $ch to $rwid's children and sort the list if necessary
1364         if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1365             set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1366                                         $children($v,$rwid)]
1367         }
1368         # fix the graph after joining $id to $rwid
1369         set a $varcid($v,$ch)
1370         fix_reversal $rwid $a $v
1371         # parentlist is wrong for the last element of arc $a
1372         # even if displayorder is right, hence the 3rd arg here
1373         modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1374     }
1375 }
1376
1377 # Mechanism for registering a command to be executed when we come
1378 # across a particular commit.  To handle the case when only the
1379 # prefix of the commit is known, the commitinterest array is now
1380 # indexed by the first 4 characters of the ID.  Each element is a
1381 # list of id, cmd pairs.
1382 proc interestedin {id cmd} {
1383     global commitinterest
1384
1385     lappend commitinterest([string range $id 0 3]) $id $cmd
1386 }
1387
1388 proc check_interest {id scripts} {
1389     global commitinterest
1390
1391     set prefix [string range $id 0 3]
1392     if {[info exists commitinterest($prefix)]} {
1393         set newlist {}
1394         foreach {i script} $commitinterest($prefix) {
1395             if {[string match "$i*" $id]} {
1396                 lappend scripts [string map [list "%I" $id "%P" $i] $script]
1397             } else {
1398                 lappend newlist $i $script
1399             }
1400         }
1401         if {$newlist ne {}} {
1402             set commitinterest($prefix) $newlist
1403         } else {
1404             unset commitinterest($prefix)
1405         }
1406     }
1407     return $scripts
1408 }
1409
1410 proc getcommitlines {fd inst view updating}  {
1411     global cmitlisted leftover
1412     global commitidx commitdata vdatemode
1413     global parents children curview hlview
1414     global idpending ordertok
1415     global varccommits varcid varctok vtokmod vfilelimit vshortids
1416
1417     set stuff [read $fd 500000]
1418     # git log doesn't terminate the last commit with a null...
1419     if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1420         set stuff "\0"
1421     }
1422     if {$stuff == {}} {
1423         if {![eof $fd]} {
1424             return 1
1425         }
1426         global commfd viewcomplete viewactive viewname
1427         global viewinstances
1428         unset commfd($inst)
1429         set i [lsearch -exact $viewinstances($view) $inst]
1430         if {$i >= 0} {
1431             set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1432         }
1433         # set it blocking so we wait for the process to terminate
1434         fconfigure $fd -blocking 1
1435         if {[catch {close $fd} err]} {
1436             set fv {}
1437             if {$view != $curview} {
1438                 set fv " for the \"$viewname($view)\" view"
1439             }
1440             if {[string range $err 0 4] == "usage"} {
1441                 set err "Gitk: error reading commits$fv:\
1442                         bad arguments to git log."
1443                 if {$viewname($view) eq "Command line"} {
1444                     append err \
1445                         "  (Note: arguments to gitk are passed to git log\
1446                          to allow selection of commits to be displayed.)"
1447                 }
1448             } else {
1449                 set err "Error reading commits$fv: $err"
1450             }
1451             error_popup $err
1452         }
1453         if {[incr viewactive($view) -1] <= 0} {
1454             set viewcomplete($view) 1
1455             # Check if we have seen any ids listed as parents that haven't
1456             # appeared in the list
1457             closevarcs $view
1458             notbusy $view
1459         }
1460         if {$view == $curview} {
1461             run chewcommits
1462         }
1463         return 0
1464     }
1465     set start 0
1466     set gotsome 0
1467     set scripts {}
1468     while 1 {
1469         set i [string first "\0" $stuff $start]
1470         if {$i < 0} {
1471             append leftover($inst) [string range $stuff $start end]
1472             break
1473         }
1474         if {$start == 0} {
1475             set cmit $leftover($inst)
1476             append cmit [string range $stuff 0 [expr {$i - 1}]]
1477             set leftover($inst) {}
1478         } else {
1479             set cmit [string range $stuff $start [expr {$i - 1}]]
1480         }
1481         set start [expr {$i + 1}]
1482         set j [string first "\n" $cmit]
1483         set ok 0
1484         set listed 1
1485         if {$j >= 0 && [string match "commit *" $cmit]} {
1486             set ids [string range $cmit 7 [expr {$j - 1}]]
1487             if {[string match {[-^<>]*} $ids]} {
1488                 switch -- [string index $ids 0] {
1489                     "-" {set listed 0}
1490                     "^" {set listed 2}
1491                     "<" {set listed 3}
1492                     ">" {set listed 4}
1493                 }
1494                 set ids [string range $ids 1 end]
1495             }
1496             set ok 1
1497             foreach id $ids {
1498                 if {[string length $id] != 40} {
1499                     set ok 0
1500                     break
1501                 }
1502             }
1503         }
1504         if {!$ok} {
1505             set shortcmit $cmit
1506             if {[string length $shortcmit] > 80} {
1507                 set shortcmit "[string range $shortcmit 0 80]..."
1508             }
1509             error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1510             exit 1
1511         }
1512         set id [lindex $ids 0]
1513         set vid $view,$id
1514
1515         lappend vshortids($view,[string range $id 0 3]) $id
1516
1517         if {!$listed && $updating && ![info exists varcid($vid)] &&
1518             $vfilelimit($view) ne {}} {
1519             # git log doesn't rewrite parents for unlisted commits
1520             # when doing path limiting, so work around that here
1521             # by working out the rewritten parent with git rev-list
1522             # and if we already know about it, using the rewritten
1523             # parent as a substitute parent for $id's children.
1524             if {![catch {
1525                 set rwid [exec git rev-list --first-parent --max-count=1 \
1526                               $id -- $vfilelimit($view)]
1527             }]} {
1528                 if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1529                     # use $rwid in place of $id
1530                     rewrite_commit $view $id $rwid
1531                     continue
1532                 }
1533             }
1534         }
1535
1536         set a 0
1537         if {[info exists varcid($vid)]} {
1538             if {$cmitlisted($vid) || !$listed} continue
1539             set a $varcid($vid)
1540         }
1541         if {$listed} {
1542             set olds [lrange $ids 1 end]
1543         } else {
1544             set olds {}
1545         }
1546         set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1547         set cmitlisted($vid) $listed
1548         set parents($vid) $olds
1549         if {![info exists children($vid)]} {
1550             set children($vid) {}
1551         } elseif {$a == 0 && [llength $children($vid)] == 1} {
1552             set k [lindex $children($vid) 0]
1553             if {[llength $parents($view,$k)] == 1 &&
1554                 (!$vdatemode($view) ||
1555                  $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1556                 set a $varcid($view,$k)
1557             }
1558         }
1559         if {$a == 0} {
1560             # new arc
1561             set a [newvarc $view $id]
1562         }
1563         if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1564             modify_arc $view $a
1565         }
1566         if {![info exists varcid($vid)]} {
1567             set varcid($vid) $a
1568             lappend varccommits($view,$a) $id
1569             incr commitidx($view)
1570         }
1571
1572         set i 0
1573         foreach p $olds {
1574             if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1575                 set vp $view,$p
1576                 if {[llength [lappend children($vp) $id]] > 1 &&
1577                     [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1578                     set children($vp) [lsort -command [list vtokcmp $view] \
1579                                            $children($vp)]
1580                     catch {unset ordertok}
1581                 }
1582                 if {[info exists varcid($view,$p)]} {
1583                     fix_reversal $p $a $view
1584                 }
1585             }
1586             incr i
1587         }
1588
1589         set scripts [check_interest $id $scripts]
1590         set gotsome 1
1591     }
1592     if {$gotsome} {
1593         global numcommits hlview
1594
1595         if {$view == $curview} {
1596             set numcommits $commitidx($view)
1597             run chewcommits
1598         }
1599         if {[info exists hlview] && $view == $hlview} {
1600             # we never actually get here...
1601             run vhighlightmore
1602         }
1603         foreach s $scripts {
1604             eval $s
1605         }
1606     }
1607     return 2
1608 }
1609
1610 proc chewcommits {} {
1611     global curview hlview viewcomplete
1612     global pending_select
1613
1614     layoutmore
1615     if {$viewcomplete($curview)} {
1616         global commitidx varctok
1617         global numcommits startmsecs
1618
1619         if {[info exists pending_select]} {
1620             update
1621             reset_pending_select {}
1622
1623             if {[commitinview $pending_select $curview]} {
1624                 selectline [rowofcommit $pending_select] 1
1625             } else {
1626                 set row [first_real_row]
1627                 selectline $row 1
1628             }
1629         }
1630         if {$commitidx($curview) > 0} {
1631             #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1632             #puts "overall $ms ms for $numcommits commits"
1633             #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1634         } else {
1635             show_status [mc "No commits selected"]
1636         }
1637         notbusy layout
1638     }
1639     return 0
1640 }
1641
1642 proc do_readcommit {id} {
1643     global tclencoding
1644
1645     # Invoke git-log to handle automatic encoding conversion
1646     set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1647     # Read the results using i18n.logoutputencoding
1648     fconfigure $fd -translation lf -eofchar {}
1649     if {$tclencoding != {}} {
1650         fconfigure $fd -encoding $tclencoding
1651     }
1652     set contents [read $fd]
1653     close $fd
1654     # Remove the heading line
1655     regsub {^commit [0-9a-f]+\n} $contents {} contents
1656
1657     return $contents
1658 }
1659
1660 proc readcommit {id} {
1661     if {[catch {set contents [do_readcommit $id]}]} return
1662     parsecommit $id $contents 1
1663 }
1664
1665 proc parsecommit {id contents listed} {
1666     global commitinfo
1667
1668     set inhdr 1
1669     set comment {}
1670     set headline {}
1671     set auname {}
1672     set audate {}
1673     set comname {}
1674     set comdate {}
1675     set hdrend [string first "\n\n" $contents]
1676     if {$hdrend < 0} {
1677         # should never happen...
1678         set hdrend [string length $contents]
1679     }
1680     set header [string range $contents 0 [expr {$hdrend - 1}]]
1681     set comment [string range $contents [expr {$hdrend + 2}] end]
1682     foreach line [split $header "\n"] {
1683         set line [split $line " "]
1684         set tag [lindex $line 0]
1685         if {$tag == "author"} {
1686             set audate [lrange $line end-1 end]
1687             set auname [join [lrange $line 1 end-2] " "]
1688         } elseif {$tag == "committer"} {
1689             set comdate [lrange $line end-1 end]
1690             set comname [join [lrange $line 1 end-2] " "]
1691         }
1692     }
1693     set headline {}
1694     # take the first non-blank line of the comment as the headline
1695     set headline [string trimleft $comment]
1696     set i [string first "\n" $headline]
1697     if {$i >= 0} {
1698         set headline [string range $headline 0 $i]
1699     }
1700     set headline [string trimright $headline]
1701     set i [string first "\r" $headline]
1702     if {$i >= 0} {
1703         set headline [string trimright [string range $headline 0 $i]]
1704     }
1705     if {!$listed} {
1706         # git log indents the comment by 4 spaces;
1707         # if we got this via git cat-file, add the indentation
1708         set newcomment {}
1709         foreach line [split $comment "\n"] {
1710             append newcomment "    "
1711             append newcomment $line
1712             append newcomment "\n"
1713         }
1714         set comment $newcomment
1715     }
1716     set hasnote [string first "\nNotes:\n" $contents]
1717     set diff ""
1718     # If there is diff output shown in the git-log stream, split it
1719     # out.  But get rid of the empty line that always precedes the
1720     # diff.
1721     set i [string first "\n\ndiff" $comment]
1722     if {$i >= 0} {
1723         set diff [string range $comment $i+1 end]
1724         set comment [string range $comment 0 $i-1]
1725     }
1726     set commitinfo($id) [list $headline $auname $audate \
1727                              $comname $comdate $comment $hasnote $diff]
1728 }
1729
1730 proc getcommit {id} {
1731     global commitdata commitinfo
1732
1733     if {[info exists commitdata($id)]} {
1734         parsecommit $id $commitdata($id) 1
1735     } else {
1736         readcommit $id
1737         if {![info exists commitinfo($id)]} {
1738             set commitinfo($id) [list [mc "No commit information available"]]
1739         }
1740     }
1741     return 1
1742 }
1743
1744 # Expand an abbreviated commit ID to a list of full 40-char IDs that match
1745 # and are present in the current view.
1746 # This is fairly slow...
1747 proc longid {prefix} {
1748     global varcid curview vshortids
1749
1750     set ids {}
1751     if {[string length $prefix] >= 4} {
1752         set vshortid $curview,[string range $prefix 0 3]
1753         if {[info exists vshortids($vshortid)]} {
1754             foreach id $vshortids($vshortid) {
1755                 if {[string match "$prefix*" $id]} {
1756                     if {[lsearch -exact $ids $id] < 0} {
1757                         lappend ids $id
1758                         if {[llength $ids] >= 2} break
1759                     }
1760                 }
1761             }
1762         }
1763     } else {
1764         foreach match [array names varcid "$curview,$prefix*"] {
1765             lappend ids [lindex [split $match ","] 1]
1766             if {[llength $ids] >= 2} break
1767         }
1768     }
1769     return $ids
1770 }
1771
1772 proc readrefs {} {
1773     global tagids idtags headids idheads tagobjid
1774     global otherrefids idotherrefs mainhead mainheadid
1775     global selecthead selectheadid
1776     global hideremotes
1777
1778     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1779         catch {unset $v}
1780     }
1781     set refd [open [list | git show-ref -d] r]
1782     while {[gets $refd line] >= 0} {
1783         if {[string index $line 40] ne " "} continue
1784         set id [string range $line 0 39]
1785         set ref [string range $line 41 end]
1786         if {![string match "refs/*" $ref]} continue
1787         set name [string range $ref 5 end]
1788         if {[string match "remotes/*" $name]} {
1789             if {![string match "*/HEAD" $name] && !$hideremotes} {
1790                 set headids($name) $id
1791                 lappend idheads($id) $name
1792             }
1793         } elseif {[string match "heads/*" $name]} {
1794             set name [string range $name 6 end]
1795             set headids($name) $id
1796             lappend idheads($id) $name
1797         } elseif {[string match "tags/*" $name]} {
1798             # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1799             # which is what we want since the former is the commit ID
1800             set name [string range $name 5 end]
1801             if {[string match "*^{}" $name]} {
1802                 set name [string range $name 0 end-3]
1803             } else {
1804                 set tagobjid($name) $id
1805             }
1806             set tagids($name) $id
1807             lappend idtags($id) $name
1808         } else {
1809             set otherrefids($name) $id
1810             lappend idotherrefs($id) $name
1811         }
1812     }
1813     catch {close $refd}
1814     set mainhead {}
1815     set mainheadid {}
1816     catch {
1817         set mainheadid [exec git rev-parse HEAD]
1818         set thehead [exec git symbolic-ref HEAD]
1819         if {[string match "refs/heads/*" $thehead]} {
1820             set mainhead [string range $thehead 11 end]
1821         }
1822     }
1823     set selectheadid {}
1824     if {$selecthead ne {}} {
1825         catch {
1826             set selectheadid [exec git rev-parse --verify $selecthead]
1827         }
1828     }
1829 }
1830
1831 # skip over fake commits
1832 proc first_real_row {} {
1833     global nullid nullid2 numcommits
1834
1835     for {set row 0} {$row < $numcommits} {incr row} {
1836         set id [commitonrow $row]
1837         if {$id ne $nullid && $id ne $nullid2} {
1838             break
1839         }
1840     }
1841     return $row
1842 }
1843
1844 # update things for a head moved to a child of its previous location
1845 proc movehead {id name} {
1846     global headids idheads
1847
1848     removehead $headids($name) $name
1849     set headids($name) $id
1850     lappend idheads($id) $name
1851 }
1852
1853 # update things when a head has been removed
1854 proc removehead {id name} {
1855     global headids idheads
1856
1857     if {$idheads($id) eq $name} {
1858         unset idheads($id)
1859     } else {
1860         set i [lsearch -exact $idheads($id) $name]
1861         if {$i >= 0} {
1862             set idheads($id) [lreplace $idheads($id) $i $i]
1863         }
1864     }
1865     unset headids($name)
1866 }
1867
1868 proc ttk_toplevel {w args} {
1869     global use_ttk
1870     eval [linsert $args 0 ::toplevel $w]
1871     if {$use_ttk} {
1872         place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1873     }
1874     return $w
1875 }
1876
1877 proc make_transient {window origin} {
1878     global have_tk85
1879
1880     # In MacOS Tk 8.4 transient appears to work by setting
1881     # overrideredirect, which is utterly useless, since the
1882     # windows get no border, and are not even kept above
1883     # the parent.
1884     if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1885
1886     wm transient $window $origin
1887
1888     # Windows fails to place transient windows normally, so
1889     # schedule a callback to center them on the parent.
1890     if {[tk windowingsystem] eq {win32}} {
1891         after idle [list tk::PlaceWindow $window widget $origin]
1892     }
1893 }
1894
1895 proc show_error {w top msg {mc mc}} {
1896     global NS
1897     if {![info exists NS]} {set NS ""}
1898     if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1899     message $w.m -text $msg -justify center -aspect 400
1900     pack $w.m -side top -fill x -padx 20 -pady 20
1901     ${NS}::button $w.ok -default active -text [$mc OK] -command "destroy $top"
1902     pack $w.ok -side bottom -fill x
1903     bind $top <Visibility> "grab $top; focus $top"
1904     bind $top <Key-Return> "destroy $top"
1905     bind $top <Key-space>  "destroy $top"
1906     bind $top <Key-Escape> "destroy $top"
1907     tkwait window $top
1908 }
1909
1910 proc error_popup {msg {owner .}} {
1911     if {[tk windowingsystem] eq "win32"} {
1912         tk_messageBox -icon error -type ok -title [wm title .] \
1913             -parent $owner -message $msg
1914     } else {
1915         set w .error
1916         ttk_toplevel $w
1917         make_transient $w $owner
1918         show_error $w $w $msg
1919     }
1920 }
1921
1922 proc confirm_popup {msg {owner .}} {
1923     global confirm_ok NS
1924     set confirm_ok 0
1925     set w .confirm
1926     ttk_toplevel $w
1927     make_transient $w $owner
1928     message $w.m -text $msg -justify center -aspect 400
1929     pack $w.m -side top -fill x -padx 20 -pady 20
1930     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1931     pack $w.ok -side left -fill x
1932     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1933     pack $w.cancel -side right -fill x
1934     bind $w <Visibility> "grab $w; focus $w"
1935     bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1936     bind $w <Key-space>  "set confirm_ok 1; destroy $w"
1937     bind $w <Key-Escape> "destroy $w"
1938     tk::PlaceWindow $w widget $owner
1939     tkwait window $w
1940     return $confirm_ok
1941 }
1942
1943 proc setoptions {} {
1944     if {[tk windowingsystem] ne "win32"} {
1945         option add *Panedwindow.showHandle 1 startupFile
1946         option add *Panedwindow.sashRelief raised startupFile
1947         if {[tk windowingsystem] ne "aqua"} {
1948             option add *Menu.font uifont startupFile
1949         }
1950     } else {
1951         option add *Menu.TearOff 0 startupFile
1952     }
1953     option add *Button.font uifont startupFile
1954     option add *Checkbutton.font uifont startupFile
1955     option add *Radiobutton.font uifont startupFile
1956     option add *Menubutton.font uifont startupFile
1957     option add *Label.font uifont startupFile
1958     option add *Message.font uifont startupFile
1959     option add *Entry.font textfont startupFile
1960     option add *Text.font textfont startupFile
1961     option add *Labelframe.font uifont startupFile
1962     option add *Spinbox.font textfont startupFile
1963     option add *Listbox.font mainfont startupFile
1964 }
1965
1966 # Make a menu and submenus.
1967 # m is the window name for the menu, items is the list of menu items to add.
1968 # Each item is a list {mc label type description options...}
1969 # mc is ignored; it's so we can put mc there to alert xgettext
1970 # label is the string that appears in the menu
1971 # type is cascade, command or radiobutton (should add checkbutton)
1972 # description depends on type; it's the sublist for cascade, the
1973 # command to invoke for command, or {variable value} for radiobutton
1974 proc makemenu {m items} {
1975     menu $m
1976     if {[tk windowingsystem] eq {aqua}} {
1977         set Meta1 Cmd
1978     } else {
1979         set Meta1 Ctrl
1980     }
1981     foreach i $items {
1982         set name [mc [lindex $i 1]]
1983         set type [lindex $i 2]
1984         set thing [lindex $i 3]
1985         set params [list $type]
1986         if {$name ne {}} {
1987             set u [string first "&" [string map {&& x} $name]]
1988             lappend params -label [string map {&& & & {}} $name]
1989             if {$u >= 0} {
1990                 lappend params -underline $u
1991             }
1992         }
1993         switch -- $type {
1994             "cascade" {
1995                 set submenu [string tolower [string map {& ""} [lindex $i 1]]]
1996                 lappend params -menu $m.$submenu
1997             }
1998             "command" {
1999                 lappend params -command $thing
2000             }
2001             "radiobutton" {
2002                 lappend params -variable [lindex $thing 0] \
2003                     -value [lindex $thing 1]
2004             }
2005         }
2006         set tail [lrange $i 4 end]
2007         regsub -all {\yMeta1\y} $tail $Meta1 tail
2008         eval $m add $params $tail
2009         if {$type eq "cascade"} {
2010             makemenu $m.$submenu $thing
2011         }
2012     }
2013 }
2014
2015 # translate string and remove ampersands
2016 proc mca {str} {
2017     return [string map {&& & & {}} [mc $str]]
2018 }
2019
2020 proc cleardropsel {w} {
2021     $w selection clear
2022 }
2023 proc makedroplist {w varname args} {
2024     global use_ttk
2025     if {$use_ttk} {
2026         set width 0
2027         foreach label $args {
2028             set cx [string length $label]
2029             if {$cx > $width} {set width $cx}
2030         }
2031         set gm [ttk::combobox $w -width $width -state readonly\
2032                     -textvariable $varname -values $args \
2033                     -exportselection false]
2034         bind $gm <<ComboboxSelected>> [list $gm selection clear]
2035     } else {
2036         set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2037     }
2038     return $gm
2039 }
2040
2041 proc makewindow {} {
2042     global canv canv2 canv3 linespc charspc ctext cflist cscroll
2043     global tabstop
2044     global findtype findtypemenu findloc findstring fstring geometry
2045     global entries sha1entry sha1string sha1but
2046     global diffcontextstring diffcontext
2047     global ignorespace
2048     global maincursor textcursor curtextcursor
2049     global rowctxmenu fakerowmenu mergemax wrapcomment
2050     global highlight_files gdttype
2051     global searchstring sstring
2052     global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
2053     global uifgcolor uifgdisabledcolor
2054     global filesepbgcolor filesepfgcolor
2055     global mergecolors foundbgcolor currentsearchhitbgcolor
2056     global headctxmenu progresscanv progressitem progresscoords statusw
2057     global fprogitem fprogcoord lastprogupdate progupdatepending
2058     global rprogitem rprogcoord rownumsel numcommits
2059     global have_tk85 use_ttk NS
2060     global git_version
2061     global worddiff
2062
2063     # The "mc" arguments here are purely so that xgettext
2064     # sees the following string as needing to be translated
2065     set file {
2066         mc "File" cascade {
2067             {mc "Update" command updatecommits -accelerator F5}
2068             {mc "Reload" command reloadcommits -accelerator Shift-F5}
2069             {mc "Reread references" command rereadrefs}
2070             {mc "List references" command showrefs -accelerator F2}
2071             {xx "" separator}
2072             {mc "Start git gui" command {exec git gui &}}
2073             {xx "" separator}
2074             {mc "Quit" command doquit -accelerator Meta1-Q}
2075         }}
2076     set edit {
2077         mc "Edit" cascade {
2078             {mc "Preferences" command doprefs}
2079         }}
2080     set view {
2081         mc "View" cascade {
2082             {mc "New view..." command {newview 0} -accelerator Shift-F4}
2083             {mc "Edit view..." command editview -state disabled -accelerator F4}
2084             {mc "Delete view" command delview -state disabled}
2085             {xx "" separator}
2086             {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
2087         }}
2088     if {[tk windowingsystem] ne "aqua"} {
2089         set help {
2090         mc "Help" cascade {
2091             {mc "About gitk" command about}
2092             {mc "Key bindings" command keys}
2093         }}
2094         set bar [list $file $edit $view $help]
2095     } else {
2096         proc ::tk::mac::ShowPreferences {} {doprefs}
2097         proc ::tk::mac::Quit {} {doquit}
2098         lset file end [lreplace [lindex $file end] end-1 end]
2099         set apple {
2100         xx "Apple" cascade {
2101             {mc "About gitk" command about}
2102             {xx "" separator}
2103         }}
2104         set help {
2105         mc "Help" cascade {
2106             {mc "Key bindings" command keys}
2107         }}
2108         set bar [list $apple $file $view $help]
2109     }
2110     makemenu .bar $bar
2111     . configure -menu .bar
2112
2113     if {$use_ttk} {
2114         # cover the non-themed toplevel with a themed frame.
2115         place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2116     }
2117
2118     # the gui has upper and lower half, parts of a paned window.
2119     ${NS}::panedwindow .ctop -orient vertical
2120
2121     # possibly use assumed geometry
2122     if {![info exists geometry(pwsash0)]} {
2123         set geometry(topheight) [expr {15 * $linespc}]
2124         set geometry(topwidth) [expr {80 * $charspc}]
2125         set geometry(botheight) [expr {15 * $linespc}]
2126         set geometry(botwidth) [expr {50 * $charspc}]
2127         set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2128         set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2129     }
2130
2131     # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2132     ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2133     ${NS}::frame .tf.histframe
2134     ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2135     if {!$use_ttk} {
2136         .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2137     }
2138
2139     # create three canvases
2140     set cscroll .tf.histframe.csb
2141     set canv .tf.histframe.pwclist.canv
2142     canvas $canv \
2143         -selectbackground $selectbgcolor \
2144         -background $bgcolor -bd 0 \
2145         -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2146     .tf.histframe.pwclist add $canv
2147     set canv2 .tf.histframe.pwclist.canv2
2148     canvas $canv2 \
2149         -selectbackground $selectbgcolor \
2150         -background $bgcolor -bd 0 -yscrollincr $linespc
2151     .tf.histframe.pwclist add $canv2
2152     set canv3 .tf.histframe.pwclist.canv3
2153     canvas $canv3 \
2154         -selectbackground $selectbgcolor \
2155         -background $bgcolor -bd 0 -yscrollincr $linespc
2156     .tf.histframe.pwclist add $canv3
2157     if {$use_ttk} {
2158         bind .tf.histframe.pwclist <Map> {
2159             bind %W <Map> {}
2160             .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2161             .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2162         }
2163     } else {
2164         eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2165         eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2166     }
2167
2168     # a scroll bar to rule them
2169     ${NS}::scrollbar $cscroll -command {allcanvs yview}
2170     if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2171     pack $cscroll -side right -fill y
2172     bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2173     lappend bglist $canv $canv2 $canv3
2174     pack .tf.histframe.pwclist -fill both -expand 1 -side left
2175
2176     # we have two button bars at bottom of top frame. Bar 1
2177     ${NS}::frame .tf.bar
2178     ${NS}::frame .tf.lbar -height 15
2179
2180     set sha1entry .tf.bar.sha1
2181     set entries $sha1entry
2182     set sha1but .tf.bar.sha1label
2183     button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2184         -command gotocommit -width 8
2185     $sha1but conf -disabledforeground [$sha1but cget -foreground]
2186     pack .tf.bar.sha1label -side left
2187     ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2188     trace add variable sha1string write sha1change
2189     pack $sha1entry -side left -pady 2
2190
2191     set bm_left_data {
2192         #define left_width 16
2193         #define left_height 16
2194         static unsigned char left_bits[] = {
2195         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2196         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2197         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2198     }
2199     set bm_right_data {
2200         #define right_width 16
2201         #define right_height 16
2202         static unsigned char right_bits[] = {
2203         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2204         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2205         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2206     }
2207     image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2208     image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2209     image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2210     image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
2211
2212     ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2213     if {$use_ttk} {
2214         .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2215     } else {
2216         .tf.bar.leftbut configure -image bm-left
2217     }
2218     pack .tf.bar.leftbut -side left -fill y
2219     ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2220     if {$use_ttk} {
2221         .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2222     } else {
2223         .tf.bar.rightbut configure -image bm-right
2224     }
2225     pack .tf.bar.rightbut -side left -fill y
2226
2227     ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2228     set rownumsel {}
2229     ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2230         -relief sunken -anchor e
2231     ${NS}::label .tf.bar.rowlabel2 -text "/"
2232     ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2233         -relief sunken -anchor e
2234     pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2235         -side left
2236     if {!$use_ttk} {
2237         foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2238     }
2239     global selectedline
2240     trace add variable selectedline write selectedline_change
2241
2242     # Status label and progress bar
2243     set statusw .tf.bar.status
2244     ${NS}::label $statusw -width 15 -relief sunken
2245     pack $statusw -side left -padx 5
2246     if {$use_ttk} {
2247         set progresscanv [ttk::progressbar .tf.bar.progress]
2248     } else {
2249         set h [expr {[font metrics uifont -linespace] + 2}]
2250         set progresscanv .tf.bar.progress
2251         canvas $progresscanv -relief sunken -height $h -borderwidth 2
2252         set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
2253         set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2254         set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2255     }
2256     pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2257     set progresscoords {0 0}
2258     set fprogcoord 0
2259     set rprogcoord 0
2260     bind $progresscanv <Configure> adjustprogress
2261     set lastprogupdate [clock clicks -milliseconds]
2262     set progupdatepending 0
2263
2264     # build up the bottom bar of upper window
2265     ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2266     ${NS}::button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
2267     ${NS}::button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
2268     ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2269     pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2270         -side left -fill y
2271     set gdttype [mc "containing:"]
2272     set gm [makedroplist .tf.lbar.gdttype gdttype \
2273                 [mc "containing:"] \
2274                 [mc "touching paths:"] \
2275                 [mc "adding/removing string:"] \
2276                 [mc "changing lines matching:"]]
2277     trace add variable gdttype write gdttype_change
2278     pack .tf.lbar.gdttype -side left -fill y
2279
2280     set findstring {}
2281     set fstring .tf.lbar.findstring
2282     lappend entries $fstring
2283     ${NS}::entry $fstring -width 30 -textvariable findstring
2284     trace add variable findstring write find_change
2285     set findtype [mc "Exact"]
2286     set findtypemenu [makedroplist .tf.lbar.findtype \
2287                           findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2288     trace add variable findtype write findcom_change
2289     set findloc [mc "All fields"]
2290     makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2291         [mc "Comments"] [mc "Author"] [mc "Committer"]
2292     trace add variable findloc write find_change
2293     pack .tf.lbar.findloc -side right
2294     pack .tf.lbar.findtype -side right
2295     pack $fstring -side left -expand 1 -fill x
2296
2297     # Finish putting the upper half of the viewer together
2298     pack .tf.lbar -in .tf -side bottom -fill x
2299     pack .tf.bar -in .tf -side bottom -fill x
2300     pack .tf.histframe -fill both -side top -expand 1
2301     .ctop add .tf
2302     if {!$use_ttk} {
2303         .ctop paneconfigure .tf -height $geometry(topheight)
2304         .ctop paneconfigure .tf -width $geometry(topwidth)
2305     }
2306
2307     # now build up the bottom
2308     ${NS}::panedwindow .pwbottom -orient horizontal
2309
2310     # lower left, a text box over search bar, scroll bar to the right
2311     # if we know window height, then that will set the lower text height, otherwise
2312     # we set lower text height which will drive window height
2313     if {[info exists geometry(main)]} {
2314         ${NS}::frame .bleft -width $geometry(botwidth)
2315     } else {
2316         ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2317     }
2318     ${NS}::frame .bleft.top
2319     ${NS}::frame .bleft.mid
2320     ${NS}::frame .bleft.bottom
2321
2322     ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2323     pack .bleft.top.search -side left -padx 5
2324     set sstring .bleft.top.sstring
2325     set searchstring ""
2326     ${NS}::entry $sstring -width 20 -textvariable searchstring
2327     lappend entries $sstring
2328     trace add variable searchstring write incrsearch
2329     pack $sstring -side left -expand 1 -fill x
2330     ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2331         -command changediffdisp -variable diffelide -value {0 0}
2332     ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2333         -command changediffdisp -variable diffelide -value {0 1}
2334     ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2335         -command changediffdisp -variable diffelide -value {1 0}
2336     ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2337     pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
2338     spinbox .bleft.mid.diffcontext -width 5 \
2339         -from 0 -increment 1 -to 10000000 \
2340         -validate all -validatecommand "diffcontextvalidate %P" \
2341         -textvariable diffcontextstring
2342     .bleft.mid.diffcontext set $diffcontext
2343     trace add variable diffcontextstring write diffcontextchange
2344     lappend entries .bleft.mid.diffcontext
2345     pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
2346     ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2347         -command changeignorespace -variable ignorespace
2348     pack .bleft.mid.ignspace -side left -padx 5
2349
2350     set worddiff [mc "Line diff"]
2351     if {[package vcompare $git_version "1.7.2"] >= 0} {
2352         makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2353             [mc "Markup words"] [mc "Color words"]
2354         trace add variable worddiff write changeworddiff
2355         pack .bleft.mid.worddiff -side left -padx 5
2356     }
2357
2358     set ctext .bleft.bottom.ctext
2359     text $ctext -background $bgcolor -foreground $fgcolor \
2360         -state disabled -font textfont \
2361         -yscrollcommand scrolltext -wrap none \
2362         -xscrollcommand ".bleft.bottom.sbhorizontal set"
2363     if {$have_tk85} {
2364         $ctext conf -tabstyle wordprocessor
2365     }
2366     ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2367     ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2368     pack .bleft.top -side top -fill x
2369     pack .bleft.mid -side top -fill x
2370     grid $ctext .bleft.bottom.sb -sticky nsew
2371     grid .bleft.bottom.sbhorizontal -sticky ew
2372     grid columnconfigure .bleft.bottom 0 -weight 1
2373     grid rowconfigure .bleft.bottom 0 -weight 1
2374     grid rowconfigure .bleft.bottom 1 -weight 0
2375     pack .bleft.bottom -side top -fill both -expand 1
2376     lappend bglist $ctext
2377     lappend fglist $ctext
2378
2379     $ctext tag conf comment -wrap $wrapcomment
2380     $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
2381     $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2382     $ctext tag conf d0 -fore [lindex $diffcolors 0]
2383     $ctext tag conf dresult -fore [lindex $diffcolors 1]
2384     $ctext tag conf m0 -fore [lindex $mergecolors 0]
2385     $ctext tag conf m1 -fore [lindex $mergecolors 1]
2386     $ctext tag conf m2 -fore [lindex $mergecolors 2]
2387     $ctext tag conf m3 -fore [lindex $mergecolors 3]
2388     $ctext tag conf m4 -fore [lindex $mergecolors 4]
2389     $ctext tag conf m5 -fore [lindex $mergecolors 5]
2390     $ctext tag conf m6 -fore [lindex $mergecolors 6]
2391     $ctext tag conf m7 -fore [lindex $mergecolors 7]
2392     $ctext tag conf m8 -fore [lindex $mergecolors 8]
2393     $ctext tag conf m9 -fore [lindex $mergecolors 9]
2394     $ctext tag conf m10 -fore [lindex $mergecolors 10]
2395     $ctext tag conf m11 -fore [lindex $mergecolors 11]
2396     $ctext tag conf m12 -fore [lindex $mergecolors 12]
2397     $ctext tag conf m13 -fore [lindex $mergecolors 13]
2398     $ctext tag conf m14 -fore [lindex $mergecolors 14]
2399     $ctext tag conf m15 -fore [lindex $mergecolors 15]
2400     $ctext tag conf mmax -fore darkgrey
2401     set mergemax 16
2402     $ctext tag conf mresult -font textfontbold
2403     $ctext tag conf msep -font textfontbold
2404     $ctext tag conf found -back $foundbgcolor
2405     $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
2406     $ctext tag conf wwrap -wrap word
2407     $ctext tag conf bold -font textfontbold
2408
2409     .pwbottom add .bleft
2410     if {!$use_ttk} {
2411         .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2412     }
2413
2414     # lower right
2415     ${NS}::frame .bright
2416     ${NS}::frame .bright.mode
2417     ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2418         -command reselectline -variable cmitmode -value "patch"
2419     ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2420         -command reselectline -variable cmitmode -value "tree"
2421     grid .bright.mode.patch .bright.mode.tree -sticky ew
2422     pack .bright.mode -side top -fill x
2423     set cflist .bright.cfiles
2424     set indent [font measure mainfont "nn"]
2425     text $cflist \
2426         -selectbackground $selectbgcolor \
2427         -background $bgcolor -foreground $fgcolor \
2428         -font mainfont \
2429         -tabs [list $indent [expr {2 * $indent}]] \
2430         -yscrollcommand ".bright.sb set" \
2431         -cursor [. cget -cursor] \
2432         -spacing1 1 -spacing3 1
2433     lappend bglist $cflist
2434     lappend fglist $cflist
2435     ${NS}::scrollbar .bright.sb -command "$cflist yview"
2436     pack .bright.sb -side right -fill y
2437     pack $cflist -side left -fill both -expand 1
2438     $cflist tag configure highlight \
2439         -background [$cflist cget -selectbackground]
2440     $cflist tag configure bold -font mainfontbold
2441
2442     .pwbottom add .bright
2443     .ctop add .pwbottom
2444
2445     # restore window width & height if known
2446     if {[info exists geometry(main)]} {
2447         if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2448             if {$w > [winfo screenwidth .]} {
2449                 set w [winfo screenwidth .]
2450             }
2451             if {$h > [winfo screenheight .]} {
2452                 set h [winfo screenheight .]
2453             }
2454             wm geometry . "${w}x$h"
2455         }
2456     }
2457
2458     if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2459         wm state . $geometry(state)
2460     }
2461
2462     if {[tk windowingsystem] eq {aqua}} {
2463         set M1B M1
2464         set ::BM "3"
2465     } else {
2466         set M1B Control
2467         set ::BM "2"
2468     }
2469
2470     if {$use_ttk} {
2471         bind .ctop <Map> {
2472             bind %W <Map> {}
2473             %W sashpos 0 $::geometry(topheight)
2474         }
2475         bind .pwbottom <Map> {
2476             bind %W <Map> {}
2477             %W sashpos 0 $::geometry(botwidth)
2478         }
2479     }
2480
2481     bind .pwbottom <Configure> {resizecdetpanes %W %w}
2482     pack .ctop -fill both -expand 1
2483     bindall <1> {selcanvline %W %x %y}
2484     #bindall <B1-Motion> {selcanvline %W %x %y}
2485     if {[tk windowingsystem] == "win32"} {
2486         bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2487         bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2488     } else {
2489         bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2490         bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2491         if {[tk windowingsystem] eq "aqua"} {
2492             bindall <MouseWheel> {
2493                 set delta [expr {- (%D)}]
2494                 allcanvs yview scroll $delta units
2495             }
2496             bindall <Shift-MouseWheel> {
2497                 set delta [expr {- (%D)}]
2498                 $canv xview scroll $delta units
2499             }
2500         }
2501     }
2502     bindall <$::BM> "canvscan mark %W %x %y"
2503     bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2504     bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2505     bind . <$M1B-Key-w> doquit
2506     bindkey <Home> selfirstline
2507     bindkey <End> sellastline
2508     bind . <Key-Up> "selnextline -1"
2509     bind . <Key-Down> "selnextline 1"
2510     bind . <Shift-Key-Up> "dofind -1 0"
2511     bind . <Shift-Key-Down> "dofind 1 0"
2512     bindkey <Key-Right> "goforw"
2513     bindkey <Key-Left> "goback"
2514     bind . <Key-Prior> "selnextpage -1"
2515     bind . <Key-Next> "selnextpage 1"
2516     bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2517     bind . <$M1B-End> "allcanvs yview moveto 1.0"
2518     bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2519     bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2520     bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2521     bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2522     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2523     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2524     bindkey <Key-space> "$ctext yview scroll 1 pages"
2525     bindkey p "selnextline -1"
2526     bindkey n "selnextline 1"
2527     bindkey z "goback"
2528     bindkey x "goforw"
2529     bindkey k "selnextline -1"
2530     bindkey j "selnextline 1"
2531     bindkey h "goback"
2532     bindkey l "goforw"
2533     bindkey b prevfile
2534     bindkey d "$ctext yview scroll 18 units"
2535     bindkey u "$ctext yview scroll -18 units"
2536     bindkey / {focus $fstring}
2537     bindkey <Key-KP_Divide> {focus $fstring}
2538     bindkey <Key-Return> {dofind 1 1}
2539     bindkey ? {dofind -1 1}
2540     bindkey f nextfile
2541     bind . <F5> updatecommits
2542     bindmodfunctionkey Shift 5 reloadcommits
2543     bind . <F2> showrefs
2544     bindmodfunctionkey Shift 4 {newview 0}
2545     bind . <F4> edit_or_newview
2546     bind . <$M1B-q> doquit
2547     bind . <$M1B-f> {dofind 1 1}
2548     bind . <$M1B-g> {dofind 1 0}
2549     bind . <$M1B-r> dosearchback
2550     bind . <$M1B-s> dosearch
2551     bind . <$M1B-equal> {incrfont 1}
2552     bind . <$M1B-plus> {incrfont 1}
2553     bind . <$M1B-KP_Add> {incrfont 1}
2554     bind . <$M1B-minus> {incrfont -1}
2555     bind . <$M1B-KP_Subtract> {incrfont -1}
2556     wm protocol . WM_DELETE_WINDOW doquit
2557     bind . <Destroy> {stop_backends}
2558     bind . <Button-1> "click %W"
2559     bind $fstring <Key-Return> {dofind 1 1}
2560     bind $sha1entry <Key-Return> {gotocommit; break}
2561     bind $sha1entry <<PasteSelection>> clearsha1
2562     bind $cflist <1> {sel_flist %W %x %y; break}
2563     bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2564     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2565     global ctxbut
2566     bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2567     bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2568     bind $ctext <Button-1> {focus %W}
2569     bind $ctext <<Selection>> rehighlight_search_results
2570
2571     set maincursor [. cget -cursor]
2572     set textcursor [$ctext cget -cursor]
2573     set curtextcursor $textcursor
2574
2575     set rowctxmenu .rowctxmenu
2576     makemenu $rowctxmenu {
2577         {mc "Diff this -> selected" command {diffvssel 0}}
2578         {mc "Diff selected -> this" command {diffvssel 1}}
2579         {mc "Make patch" command mkpatch}
2580         {mc "Create tag" command mktag}
2581         {mc "Write commit to file" command writecommit}
2582         {mc "Create new branch" command mkbranch}
2583         {mc "Cherry-pick this commit" command cherrypick}
2584         {mc "Reset HEAD branch to here" command resethead}
2585         {mc "Mark this commit" command markhere}
2586         {mc "Return to mark" command gotomark}
2587         {mc "Find descendant of this and mark" command find_common_desc}
2588         {mc "Compare with marked commit" command compare_commits}
2589         {mc "Diff this -> marked commit" command {diffvsmark 0}}
2590         {mc "Diff marked commit -> this" command {diffvsmark 1}}
2591         {mc "Revert this commit" command revert}
2592     }
2593     $rowctxmenu configure -tearoff 0
2594
2595     set fakerowmenu .fakerowmenu
2596     makemenu $fakerowmenu {
2597         {mc "Diff this -> selected" command {diffvssel 0}}
2598         {mc "Diff selected -> this" command {diffvssel 1}}
2599         {mc "Make patch" command mkpatch}
2600         {mc "Diff this -> marked commit" command {diffvsmark 0}}
2601         {mc "Diff marked commit -> this" command {diffvsmark 1}}
2602     }
2603     $fakerowmenu configure -tearoff 0
2604
2605     set headctxmenu .headctxmenu
2606     makemenu $headctxmenu {
2607         {mc "Check out this branch" command cobranch}
2608         {mc "Remove this branch" command rmbranch}
2609     }
2610     $headctxmenu configure -tearoff 0
2611
2612     global flist_menu
2613     set flist_menu .flistctxmenu
2614     makemenu $flist_menu {
2615         {mc "Highlight this too" command {flist_hl 0}}
2616         {mc "Highlight this only" command {flist_hl 1}}
2617         {mc "External diff" command {external_diff}}
2618         {mc "Blame parent commit" command {external_blame 1}}
2619     }
2620     $flist_menu configure -tearoff 0
2621
2622     global diff_menu
2623     set diff_menu .diffctxmenu
2624     makemenu $diff_menu {
2625         {mc "Show origin of this line" command show_line_source}
2626         {mc "Run git gui blame on this line" command {external_blame_diff}}
2627     }
2628     $diff_menu configure -tearoff 0
2629 }
2630
2631 # Windows sends all mouse wheel events to the current focused window, not
2632 # the one where the mouse hovers, so bind those events here and redirect
2633 # to the correct window
2634 proc windows_mousewheel_redirector {W X Y D} {
2635     global canv canv2 canv3
2636     set w [winfo containing -displayof $W $X $Y]
2637     if {$w ne ""} {
2638         set u [expr {$D < 0 ? 5 : -5}]
2639         if {$w == $canv || $w == $canv2 || $w == $canv3} {
2640             allcanvs yview scroll $u units
2641         } else {
2642             catch {
2643                 $w yview scroll $u units
2644             }
2645         }
2646     }
2647 }
2648
2649 # Update row number label when selectedline changes
2650 proc selectedline_change {n1 n2 op} {
2651     global selectedline rownumsel
2652
2653     if {$selectedline eq {}} {
2654         set rownumsel {}
2655     } else {
2656         set rownumsel [expr {$selectedline + 1}]
2657     }
2658 }
2659
2660 # mouse-2 makes all windows scan vertically, but only the one
2661 # the cursor is in scans horizontally
2662 proc canvscan {op w x y} {
2663     global canv canv2 canv3
2664     foreach c [list $canv $canv2 $canv3] {
2665         if {$c == $w} {
2666             $c scan $op $x $y
2667         } else {
2668             $c scan $op 0 $y
2669         }
2670     }
2671 }
2672
2673 proc scrollcanv {cscroll f0 f1} {
2674     $cscroll set $f0 $f1
2675     drawvisible
2676     flushhighlights
2677 }
2678
2679 # when we make a key binding for the toplevel, make sure
2680 # it doesn't get triggered when that key is pressed in the
2681 # find string entry widget.
2682 proc bindkey {ev script} {
2683     global entries
2684     bind . $ev $script
2685     set escript [bind Entry $ev]
2686     if {$escript == {}} {
2687         set escript [bind Entry <Key>]
2688     }
2689     foreach e $entries {
2690         bind $e $ev "$escript; break"
2691     }
2692 }
2693
2694 proc bindmodfunctionkey {mod n script} {
2695     bind . <$mod-F$n> $script
2696     catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2697 }
2698
2699 # set the focus back to the toplevel for any click outside
2700 # the entry widgets
2701 proc click {w} {
2702     global ctext entries
2703     foreach e [concat $entries $ctext] {
2704         if {$w == $e} return
2705     }
2706     focus .
2707 }
2708
2709 # Adjust the progress bar for a change in requested extent or canvas size
2710 proc adjustprogress {} {
2711     global progresscanv progressitem progresscoords
2712     global fprogitem fprogcoord lastprogupdate progupdatepending
2713     global rprogitem rprogcoord use_ttk
2714
2715     if {$use_ttk} {
2716         $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2717         return
2718     }
2719
2720     set w [expr {[winfo width $progresscanv] - 4}]
2721     set x0 [expr {$w * [lindex $progresscoords 0]}]
2722     set x1 [expr {$w * [lindex $progresscoords 1]}]
2723     set h [winfo height $progresscanv]
2724     $progresscanv coords $progressitem $x0 0 $x1 $h
2725     $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2726     $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2727     set now [clock clicks -milliseconds]
2728     if {$now >= $lastprogupdate + 100} {
2729         set progupdatepending 0
2730         update
2731     } elseif {!$progupdatepending} {
2732         set progupdatepending 1
2733         after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2734     }
2735 }
2736
2737 proc doprogupdate {} {
2738     global lastprogupdate progupdatepending
2739
2740     if {$progupdatepending} {
2741         set progupdatepending 0
2742         set lastprogupdate [clock clicks -milliseconds]
2743         update
2744     }
2745 }
2746
2747 proc savestuff {w} {
2748     global canv canv2 canv3 mainfont textfont uifont tabstop
2749     global stuffsaved findmergefiles maxgraphpct
2750     global maxwidth showneartags showlocalchanges
2751     global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2752     global cmitmode wrapcomment datetimeformat limitdiffs
2753     global colors uicolor bgcolor fgcolor diffcolors diffcontext selectbgcolor
2754     global uifgcolor uifgdisabledcolor
2755     global headbgcolor headfgcolor headoutlinecolor remotebgcolor
2756     global tagbgcolor tagfgcolor tagoutlinecolor
2757     global reflinecolor filesepbgcolor filesepfgcolor
2758     global mergecolors foundbgcolor currentsearchhitbgcolor
2759     global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor circlecolors
2760     global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
2761     global linkfgcolor circleoutlinecolor
2762     global autoselect autosellen extdifftool perfile_attrs markbgcolor use_ttk
2763     global hideremotes want_ttk maxrefs
2764
2765     if {$stuffsaved} return
2766     if {![winfo viewable .]} return
2767     catch {
2768         if {[file exists ~/.gitk-new]} {file delete -force ~/.gitk-new}
2769         set f [open "~/.gitk-new" w]
2770         if {$::tcl_platform(platform) eq {windows}} {
2771             file attributes "~/.gitk-new" -hidden true
2772         }
2773         puts $f [list set mainfont $mainfont]
2774         puts $f [list set textfont $textfont]
2775         puts $f [list set uifont $uifont]
2776         puts $f [list set tabstop $tabstop]
2777         puts $f [list set findmergefiles $findmergefiles]
2778         puts $f [list set maxgraphpct $maxgraphpct]
2779         puts $f [list set maxwidth $maxwidth]
2780         puts $f [list set cmitmode $cmitmode]
2781         puts $f [list set wrapcomment $wrapcomment]
2782         puts $f [list set autoselect $autoselect]
2783         puts $f [list set autosellen $autosellen]
2784         puts $f [list set showneartags $showneartags]
2785         puts $f [list set maxrefs $maxrefs]
2786         puts $f [list set hideremotes $hideremotes]
2787         puts $f [list set showlocalchanges $showlocalchanges]
2788         puts $f [list set datetimeformat $datetimeformat]
2789         puts $f [list set limitdiffs $limitdiffs]
2790         puts $f [list set uicolor $uicolor]
2791         puts $f [list set want_ttk $want_ttk]
2792         puts $f [list set bgcolor $bgcolor]
2793         puts $f [list set fgcolor $fgcolor]
2794         puts $f [list set uifgcolor $uifgcolor]
2795         puts $f [list set uifgdisabledcolor $uifgdisabledcolor]
2796         puts $f [list set colors $colors]
2797         puts $f [list set diffcolors $diffcolors]
2798         puts $f [list set mergecolors $mergecolors]
2799         puts $f [list set markbgcolor $markbgcolor]
2800         puts $f [list set diffcontext $diffcontext]
2801         puts $f [list set selectbgcolor $selectbgcolor]
2802         puts $f [list set foundbgcolor $foundbgcolor]
2803         puts $f [list set currentsearchhitbgcolor $currentsearchhitbgcolor]
2804         puts $f [list set extdifftool $extdifftool]
2805         puts $f [list set perfile_attrs $perfile_attrs]
2806         puts $f [list set headbgcolor $headbgcolor]
2807         puts $f [list set headfgcolor $headfgcolor]
2808         puts $f [list set headoutlinecolor $headoutlinecolor]
2809         puts $f [list set remotebgcolor $remotebgcolor]
2810         puts $f [list set tagbgcolor $tagbgcolor]
2811         puts $f [list set tagfgcolor $tagfgcolor]
2812         puts $f [list set tagoutlinecolor $tagoutlinecolor]
2813         puts $f [list set reflinecolor $reflinecolor]
2814         puts $f [list set filesepbgcolor $filesepbgcolor]
2815         puts $f [list set filesepfgcolor $filesepfgcolor]
2816         puts $f [list set linehoverbgcolor $linehoverbgcolor]
2817         puts $f [list set linehoverfgcolor $linehoverfgcolor]
2818         puts $f [list set linehoveroutlinecolor $linehoveroutlinecolor]
2819         puts $f [list set mainheadcirclecolor $mainheadcirclecolor]
2820         puts $f [list set workingfilescirclecolor $workingfilescirclecolor]
2821         puts $f [list set indexcirclecolor $indexcirclecolor]
2822         puts $f [list set circlecolors $circlecolors]
2823         puts $f [list set linkfgcolor $linkfgcolor]
2824         puts $f [list set circleoutlinecolor $circleoutlinecolor]
2825
2826         puts $f "set geometry(main) [wm geometry .]"
2827         puts $f "set geometry(state) [wm state .]"
2828         puts $f "set geometry(topwidth) [winfo width .tf]"
2829         puts $f "set geometry(topheight) [winfo height .tf]"
2830         if {$use_ttk} {
2831             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2832             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2833         } else {
2834             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2835             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2836         }
2837         puts $f "set geometry(botwidth) [winfo width .bleft]"
2838         puts $f "set geometry(botheight) [winfo height .bleft]"
2839
2840         puts -nonewline $f "set permviews {"
2841         for {set v 0} {$v < $nextviewnum} {incr v} {
2842             if {$viewperm($v)} {
2843                 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2844             }
2845         }
2846         puts $f "}"
2847         close $f
2848         file rename -force "~/.gitk-new" "~/.gitk"
2849     }
2850     set stuffsaved 1
2851 }
2852
2853 proc resizeclistpanes {win w} {
2854     global oldwidth use_ttk
2855     if {[info exists oldwidth($win)]} {
2856         if {$use_ttk} {
2857             set s0 [$win sashpos 0]
2858             set s1 [$win sashpos 1]
2859         } else {
2860             set s0 [$win sash coord 0]
2861             set s1 [$win sash coord 1]
2862         }
2863         if {$w < 60} {
2864             set sash0 [expr {int($w/2 - 2)}]
2865             set sash1 [expr {int($w*5/6 - 2)}]
2866         } else {
2867             set factor [expr {1.0 * $w / $oldwidth($win)}]
2868             set sash0 [expr {int($factor * [lindex $s0 0])}]
2869             set sash1 [expr {int($factor * [lindex $s1 0])}]
2870             if {$sash0 < 30} {
2871                 set sash0 30
2872             }
2873             if {$sash1 < $sash0 + 20} {
2874                 set sash1 [expr {$sash0 + 20}]
2875             }
2876             if {$sash1 > $w - 10} {
2877                 set sash1 [expr {$w - 10}]
2878                 if {$sash0 > $sash1 - 20} {
2879                     set sash0 [expr {$sash1 - 20}]
2880                 }
2881             }
2882         }
2883         if {$use_ttk} {
2884             $win sashpos 0 $sash0
2885             $win sashpos 1 $sash1
2886         } else {
2887             $win sash place 0 $sash0 [lindex $s0 1]
2888             $win sash place 1 $sash1 [lindex $s1 1]
2889         }
2890     }
2891     set oldwidth($win) $w
2892 }
2893
2894 proc resizecdetpanes {win w} {
2895     global oldwidth use_ttk
2896     if {[info exists oldwidth($win)]} {
2897         if {$use_ttk} {
2898             set s0 [$win sashpos 0]
2899         } else {
2900             set s0 [$win sash coord 0]
2901         }
2902         if {$w < 60} {
2903             set sash0 [expr {int($w*3/4 - 2)}]
2904         } else {
2905             set factor [expr {1.0 * $w / $oldwidth($win)}]
2906             set sash0 [expr {int($factor * [lindex $s0 0])}]
2907             if {$sash0 < 45} {
2908                 set sash0 45
2909             }
2910             if {$sash0 > $w - 15} {
2911                 set sash0 [expr {$w - 15}]
2912             }
2913         }
2914         if {$use_ttk} {
2915             $win sashpos 0 $sash0
2916         } else {
2917             $win sash place 0 $sash0 [lindex $s0 1]
2918         }
2919     }
2920     set oldwidth($win) $w
2921 }
2922
2923 proc allcanvs args {
2924     global canv canv2 canv3
2925     eval $canv $args
2926     eval $canv2 $args
2927     eval $canv3 $args
2928 }
2929
2930 proc bindall {event action} {
2931     global canv canv2 canv3
2932     bind $canv $event $action
2933     bind $canv2 $event $action
2934     bind $canv3 $event $action
2935 }
2936
2937 proc about {} {
2938     global uifont NS
2939     set w .about
2940     if {[winfo exists $w]} {
2941         raise $w
2942         return
2943     }
2944     ttk_toplevel $w
2945     wm title $w [mc "About gitk"]
2946     make_transient $w .
2947     message $w.m -text [mc "
2948 Gitk - a commit viewer for git
2949
2950 Copyright \u00a9 2005-2011 Paul Mackerras
2951
2952 Use and redistribute under the terms of the GNU General Public License"] \
2953             -justify center -aspect 400 -border 2 -bg white -relief groove
2954     pack $w.m -side top -fill x -padx 2 -pady 2
2955     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2956     pack $w.ok -side bottom
2957     bind $w <Visibility> "focus $w.ok"
2958     bind $w <Key-Escape> "destroy $w"
2959     bind $w <Key-Return> "destroy $w"
2960     tk::PlaceWindow $w widget .
2961 }
2962
2963 proc keys {} {
2964     global NS
2965     set w .keys
2966     if {[winfo exists $w]} {
2967         raise $w
2968         return
2969     }
2970     if {[tk windowingsystem] eq {aqua}} {
2971         set M1T Cmd
2972     } else {
2973         set M1T Ctrl
2974     }
2975     ttk_toplevel $w
2976     wm title $w [mc "Gitk key bindings"]
2977     make_transient $w .
2978     message $w.m -text "
2979 [mc "Gitk key bindings:"]
2980
2981 [mc "<%s-Q>             Quit" $M1T]
2982 [mc "<%s-W>             Close window" $M1T]
2983 [mc "<Home>             Move to first commit"]
2984 [mc "<End>              Move to last commit"]
2985 [mc "<Up>, p, k Move up one commit"]
2986 [mc "<Down>, n, j       Move down one commit"]
2987 [mc "<Left>, z, h       Go back in history list"]
2988 [mc "<Right>, x, l      Go forward in history list"]
2989 [mc "<PageUp>   Move up one page in commit list"]
2990 [mc "<PageDown> Move down one page in commit list"]
2991 [mc "<%s-Home>  Scroll to top of commit list" $M1T]
2992 [mc "<%s-End>   Scroll to bottom of commit list" $M1T]
2993 [mc "<%s-Up>    Scroll commit list up one line" $M1T]
2994 [mc "<%s-Down>  Scroll commit list down one line" $M1T]
2995 [mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
2996 [mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
2997 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
2998 [mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
2999 [mc "<Delete>, b        Scroll diff view up one page"]
3000 [mc "<Backspace>        Scroll diff view up one page"]
3001 [mc "<Space>            Scroll diff view down one page"]
3002 [mc "u          Scroll diff view up 18 lines"]
3003 [mc "d          Scroll diff view down 18 lines"]
3004 [mc "<%s-F>             Find" $M1T]
3005 [mc "<%s-G>             Move to next find hit" $M1T]
3006 [mc "<Return>   Move to next find hit"]
3007 [mc "/          Focus the search box"]
3008 [mc "?          Move to previous find hit"]
3009 [mc "f          Scroll diff view to next file"]
3010 [mc "<%s-S>             Search for next hit in diff view" $M1T]
3011 [mc "<%s-R>             Search for previous hit in diff view" $M1T]
3012 [mc "<%s-KP+>   Increase font size" $M1T]
3013 [mc "<%s-plus>  Increase font size" $M1T]
3014 [mc "<%s-KP->   Decrease font size" $M1T]
3015 [mc "<%s-minus> Decrease font size" $M1T]
3016 [mc "<F5>               Update"]
3017 " \
3018             -justify left -bg white -border 2 -relief groove
3019     pack $w.m -side top -fill both -padx 2 -pady 2
3020     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3021     bind $w <Key-Escape> [list destroy $w]
3022     pack $w.ok -side bottom
3023     bind $w <Visibility> "focus $w.ok"
3024     bind $w <Key-Escape> "destroy $w"
3025     bind $w <Key-Return> "destroy $w"
3026 }
3027
3028 # Procedures for manipulating the file list window at the
3029 # bottom right of the overall window.
3030
3031 proc treeview {w l openlevs} {
3032     global treecontents treediropen treeheight treeparent treeindex
3033
3034     set ix 0
3035     set treeindex() 0
3036     set lev 0
3037     set prefix {}
3038     set prefixend -1
3039     set prefendstack {}
3040     set htstack {}
3041     set ht 0
3042     set treecontents() {}
3043     $w conf -state normal
3044     foreach f $l {
3045         while {[string range $f 0 $prefixend] ne $prefix} {
3046             if {$lev <= $openlevs} {
3047                 $w mark set e:$treeindex($prefix) "end -1c"
3048                 $w mark gravity e:$treeindex($prefix) left
3049             }
3050             set treeheight($prefix) $ht
3051             incr ht [lindex $htstack end]
3052             set htstack [lreplace $htstack end end]
3053             set prefixend [lindex $prefendstack end]
3054             set prefendstack [lreplace $prefendstack end end]
3055             set prefix [string range $prefix 0 $prefixend]
3056             incr lev -1
3057         }
3058         set tail [string range $f [expr {$prefixend+1}] end]
3059         while {[set slash [string first "/" $tail]] >= 0} {
3060             lappend htstack $ht
3061             set ht 0
3062             lappend prefendstack $prefixend
3063             incr prefixend [expr {$slash + 1}]
3064             set d [string range $tail 0 $slash]
3065             lappend treecontents($prefix) $d
3066             set oldprefix $prefix
3067             append prefix $d
3068             set treecontents($prefix) {}
3069             set treeindex($prefix) [incr ix]
3070             set treeparent($prefix) $oldprefix
3071             set tail [string range $tail [expr {$slash+1}] end]
3072             if {$lev <= $openlevs} {
3073                 set ht 1
3074                 set treediropen($prefix) [expr {$lev < $openlevs}]
3075                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3076                 $w mark set d:$ix "end -1c"
3077                 $w mark gravity d:$ix left
3078                 set str "\n"
3079                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3080                 $w insert end $str
3081                 $w image create end -align center -image $bm -padx 1 \
3082                     -name a:$ix
3083                 $w insert end $d [highlight_tag $prefix]
3084                 $w mark set s:$ix "end -1c"
3085                 $w mark gravity s:$ix left
3086             }
3087             incr lev
3088         }
3089         if {$tail ne {}} {
3090             if {$lev <= $openlevs} {
3091                 incr ht
3092                 set str "\n"
3093                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3094                 $w insert end $str
3095                 $w insert end $tail [highlight_tag $f]
3096             }
3097             lappend treecontents($prefix) $tail
3098         }
3099     }
3100     while {$htstack ne {}} {
3101         set treeheight($prefix) $ht
3102         incr ht [lindex $htstack end]
3103         set htstack [lreplace $htstack end end]
3104         set prefixend [lindex $prefendstack end]
3105         set prefendstack [lreplace $prefendstack end end]
3106         set prefix [string range $prefix 0 $prefixend]
3107     }
3108     $w conf -state disabled
3109 }
3110
3111 proc linetoelt {l} {
3112     global treeheight treecontents
3113
3114     set y 2
3115     set prefix {}
3116     while {1} {
3117         foreach e $treecontents($prefix) {
3118             if {$y == $l} {
3119                 return "$prefix$e"
3120             }
3121             set n 1
3122             if {[string index $e end] eq "/"} {
3123                 set n $treeheight($prefix$e)
3124                 if {$y + $n > $l} {
3125                     append prefix $e
3126                     incr y
3127                     break
3128                 }
3129             }
3130             incr y $n
3131         }
3132     }
3133 }
3134
3135 proc highlight_tree {y prefix} {
3136     global treeheight treecontents cflist
3137
3138     foreach e $treecontents($prefix) {
3139         set path $prefix$e
3140         if {[highlight_tag $path] ne {}} {
3141             $cflist tag add bold $y.0 "$y.0 lineend"
3142         }
3143         incr y
3144         if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3145             set y [highlight_tree $y $path]
3146         }
3147     }
3148     return $y
3149 }
3150
3151 proc treeclosedir {w dir} {
3152     global treediropen treeheight treeparent treeindex
3153
3154     set ix $treeindex($dir)
3155     $w conf -state normal
3156     $w delete s:$ix e:$ix
3157     set treediropen($dir) 0
3158     $w image configure a:$ix -image tri-rt
3159     $w conf -state disabled
3160     set n [expr {1 - $treeheight($dir)}]
3161     while {$dir ne {}} {
3162         incr treeheight($dir) $n
3163         set dir $treeparent($dir)
3164     }
3165 }
3166
3167 proc treeopendir {w dir} {
3168     global treediropen treeheight treeparent treecontents treeindex
3169
3170     set ix $treeindex($dir)
3171     $w conf -state normal
3172     $w image configure a:$ix -image tri-dn
3173     $w mark set e:$ix s:$ix
3174     $w mark gravity e:$ix right
3175     set lev 0
3176     set str "\n"
3177     set n [llength $treecontents($dir)]
3178     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3179         incr lev
3180         append str "\t"
3181         incr treeheight($x) $n
3182     }
3183     foreach e $treecontents($dir) {
3184         set de $dir$e
3185         if {[string index $e end] eq "/"} {
3186             set iy $treeindex($de)
3187             $w mark set d:$iy e:$ix
3188             $w mark gravity d:$iy left
3189             $w insert e:$ix $str
3190             set treediropen($de) 0
3191             $w image create e:$ix -align center -image tri-rt -padx 1 \
3192                 -name a:$iy
3193             $w insert e:$ix $e [highlight_tag $de]
3194             $w mark set s:$iy e:$ix
3195             $w mark gravity s:$iy left
3196             set treeheight($de) 1
3197         } else {
3198             $w insert e:$ix $str
3199             $w insert e:$ix $e [highlight_tag $de]
3200         }
3201     }
3202     $w mark gravity e:$ix right
3203     $w conf -state disabled
3204     set treediropen($dir) 1
3205     set top [lindex [split [$w index @0,0] .] 0]
3206     set ht [$w cget -height]
3207     set l [lindex [split [$w index s:$ix] .] 0]
3208     if {$l < $top} {
3209         $w yview $l.0
3210     } elseif {$l + $n + 1 > $top + $ht} {
3211         set top [expr {$l + $n + 2 - $ht}]
3212         if {$l < $top} {
3213             set top $l
3214         }
3215         $w yview $top.0
3216     }
3217 }
3218
3219 proc treeclick {w x y} {
3220     global treediropen cmitmode ctext cflist cflist_top
3221
3222     if {$cmitmode ne "tree"} return
3223     if {![info exists cflist_top]} return
3224     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3225     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3226     $cflist tag add highlight $l.0 "$l.0 lineend"
3227     set cflist_top $l
3228     if {$l == 1} {
3229         $ctext yview 1.0
3230         return
3231     }
3232     set e [linetoelt $l]
3233     if {[string index $e end] ne "/"} {
3234         showfile $e
3235     } elseif {$treediropen($e)} {
3236         treeclosedir $w $e
3237     } else {
3238         treeopendir $w $e
3239     }
3240 }
3241
3242 proc setfilelist {id} {
3243     global treefilelist cflist jump_to_here
3244
3245     treeview $cflist $treefilelist($id) 0
3246     if {$jump_to_here ne {}} {
3247         set f [lindex $jump_to_here 0]
3248         if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3249             showfile $f
3250         }
3251     }
3252 }
3253
3254 image create bitmap tri-rt -background black -foreground blue -data {
3255     #define tri-rt_width 13
3256     #define tri-rt_height 13
3257     static unsigned char tri-rt_bits[] = {
3258        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3259        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3260        0x00, 0x00};
3261 } -maskdata {
3262     #define tri-rt-mask_width 13
3263     #define tri-rt-mask_height 13
3264     static unsigned char tri-rt-mask_bits[] = {
3265        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3266        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3267        0x08, 0x00};
3268 }
3269 image create bitmap tri-dn -background black -foreground blue -data {
3270     #define tri-dn_width 13
3271     #define tri-dn_height 13
3272     static unsigned char tri-dn_bits[] = {
3273        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3274        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3275        0x00, 0x00};
3276 } -maskdata {
3277     #define tri-dn-mask_width 13
3278     #define tri-dn-mask_height 13
3279     static unsigned char tri-dn-mask_bits[] = {
3280        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3281        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3282        0x00, 0x00};
3283 }
3284
3285 image create bitmap reficon-T -background black -foreground yellow -data {
3286     #define tagicon_width 13
3287     #define tagicon_height 9
3288     static unsigned char tagicon_bits[] = {
3289        0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3290        0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3291 } -maskdata {
3292     #define tagicon-mask_width 13
3293     #define tagicon-mask_height 9
3294     static unsigned char tagicon-mask_bits[] = {
3295        0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3296        0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3297 }
3298 set rectdata {
3299     #define headicon_width 13
3300     #define headicon_height 9
3301     static unsigned char headicon_bits[] = {
3302        0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3303        0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3304 }
3305 set rectmask {
3306     #define headicon-mask_width 13
3307     #define headicon-mask_height 9
3308     static unsigned char headicon-mask_bits[] = {
3309        0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3310        0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3311 }
3312 image create bitmap reficon-H -background black -foreground green \
3313     -data $rectdata -maskdata $rectmask
3314 image create bitmap reficon-o -background black -foreground "#ddddff" \
3315     -data $rectdata -maskdata $rectmask
3316
3317 proc init_flist {first} {
3318     global cflist cflist_top difffilestart
3319
3320     $cflist conf -state normal
3321     $cflist delete 0.0 end
3322     if {$first ne {}} {
3323         $cflist insert end $first
3324         set cflist_top 1
3325         $cflist tag add highlight 1.0 "1.0 lineend"
3326     } else {
3327         catch {unset cflist_top}
3328     }
3329     $cflist conf -state disabled
3330     set difffilestart {}
3331 }
3332
3333 proc highlight_tag {f} {
3334     global highlight_paths
3335
3336     foreach p $highlight_paths {
3337         if {[string match $p $f]} {
3338             return "bold"
3339         }
3340     }
3341     return {}
3342 }
3343
3344 proc highlight_filelist {} {
3345     global cmitmode cflist
3346
3347     $cflist conf -state normal
3348     if {$cmitmode ne "tree"} {
3349         set end [lindex [split [$cflist index end] .] 0]
3350         for {set l 2} {$l < $end} {incr l} {
3351             set line [$cflist get $l.0 "$l.0 lineend"]
3352             if {[highlight_tag $line] ne {}} {
3353                 $cflist tag add bold $l.0 "$l.0 lineend"
3354             }
3355         }
3356     } else {
3357         highlight_tree 2 {}
3358     }
3359     $cflist conf -state disabled
3360 }
3361
3362 proc unhighlight_filelist {} {
3363     global cflist
3364
3365     $cflist conf -state normal
3366     $cflist tag remove bold 1.0 end
3367     $cflist conf -state disabled
3368 }
3369
3370 proc add_flist {fl} {
3371     global cflist
3372
3373     $cflist conf -state normal
3374     foreach f $fl {
3375         $cflist insert end "\n"
3376         $cflist insert end $f [highlight_tag $f]
3377     }
3378     $cflist conf -state disabled
3379 }
3380
3381 proc sel_flist {w x y} {
3382     global ctext difffilestart cflist cflist_top cmitmode
3383
3384     if {$cmitmode eq "tree"} return
3385     if {![info exists cflist_top]} return
3386     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3387     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3388     $cflist tag add highlight $l.0 "$l.0 lineend"
3389     set cflist_top $l
3390     if {$l == 1} {
3391         $ctext yview 1.0
3392     } else {
3393         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3394     }
3395     suppress_highlighting_file_for_current_scrollpos
3396 }
3397
3398 proc pop_flist_menu {w X Y x y} {
3399     global ctext cflist cmitmode flist_menu flist_menu_file
3400     global treediffs diffids
3401
3402     stopfinding
3403     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3404     if {$l <= 1} return
3405     if {$cmitmode eq "tree"} {
3406         set e [linetoelt $l]
3407         if {[string index $e end] eq "/"} return
3408     } else {
3409         set e [lindex $treediffs($diffids) [expr {$l-2}]]
3410     }
3411     set flist_menu_file $e
3412     set xdiffstate "normal"
3413     if {$cmitmode eq "tree"} {
3414         set xdiffstate "disabled"
3415     }
3416     # Disable "External diff" item in tree mode
3417     $flist_menu entryconf 2 -state $xdiffstate
3418     tk_popup $flist_menu $X $Y
3419 }
3420
3421 proc find_ctext_fileinfo {line} {
3422     global ctext_file_names ctext_file_lines
3423
3424     set ok [bsearch $ctext_file_lines $line]
3425     set tline [lindex $ctext_file_lines $ok]
3426
3427     if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3428         return {}
3429     } else {
3430         return [list [lindex $ctext_file_names $ok] $tline]
3431     }
3432 }
3433
3434 proc pop_diff_menu {w X Y x y} {
3435     global ctext diff_menu flist_menu_file
3436     global diff_menu_txtpos diff_menu_line
3437     global diff_menu_filebase
3438
3439     set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3440     set diff_menu_line [lindex $diff_menu_txtpos 0]
3441     # don't pop up the menu on hunk-separator or file-separator lines
3442     if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3443         return
3444     }
3445     stopfinding
3446     set f [find_ctext_fileinfo $diff_menu_line]
3447     if {$f eq {}} return
3448     set flist_menu_file [lindex $f 0]
3449     set diff_menu_filebase [lindex $f 1]
3450     tk_popup $diff_menu $X $Y
3451 }
3452
3453 proc flist_hl {only} {
3454     global flist_menu_file findstring gdttype
3455
3456     set x [shellquote $flist_menu_file]
3457     if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3458         set findstring $x
3459     } else {
3460         append findstring " " $x
3461     }
3462     set gdttype [mc "touching paths:"]
3463 }
3464
3465 proc gitknewtmpdir {} {
3466     global diffnum gitktmpdir gitdir
3467
3468     if {![info exists gitktmpdir]} {
3469         set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3470         if {[catch {file mkdir $gitktmpdir} err]} {
3471             error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3472             unset gitktmpdir
3473             return {}
3474         }
3475         set diffnum 0
3476     }
3477     incr diffnum
3478     set diffdir [file join $gitktmpdir $diffnum]
3479     if {[catch {file mkdir $diffdir} err]} {
3480         error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3481         return {}
3482     }
3483     return $diffdir
3484 }
3485
3486 proc save_file_from_commit {filename output what} {
3487     global nullfile
3488
3489     if {[catch {exec git show $filename -- > $output} err]} {
3490         if {[string match "fatal: bad revision *" $err]} {
3491             return $nullfile
3492         }
3493         error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3494         return {}
3495     }
3496     return $output
3497 }
3498
3499 proc external_diff_get_one_file {diffid filename diffdir} {
3500     global nullid nullid2 nullfile
3501     global worktree
3502
3503     if {$diffid == $nullid} {
3504         set difffile [file join $worktree $filename]
3505         if {[file exists $difffile]} {
3506             return $difffile
3507         }
3508         return $nullfile
3509     }
3510     if {$diffid == $nullid2} {
3511         set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3512         return [save_file_from_commit :$filename $difffile index]
3513     }
3514     set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3515     return [save_file_from_commit $diffid:$filename $difffile \
3516                "revision $diffid"]
3517 }
3518
3519 proc external_diff {} {
3520     global nullid nullid2
3521     global flist_menu_file
3522     global diffids
3523     global extdifftool
3524
3525     if {[llength $diffids] == 1} {
3526         # no reference commit given
3527         set diffidto [lindex $diffids 0]
3528         if {$diffidto eq $nullid} {
3529             # diffing working copy with index
3530             set diffidfrom $nullid2
3531         } elseif {$diffidto eq $nullid2} {
3532             # diffing index with HEAD
3533             set diffidfrom "HEAD"
3534         } else {
3535             # use first parent commit
3536             global parentlist selectedline
3537             set diffidfrom [lindex $parentlist $selectedline 0]
3538         }
3539     } else {
3540         set diffidfrom [lindex $diffids 0]
3541         set diffidto [lindex $diffids 1]
3542     }
3543
3544     # make sure that several diffs wont collide
3545     set diffdir [gitknewtmpdir]
3546     if {$diffdir eq {}} return
3547
3548     # gather files to diff
3549     set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3550     set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3551
3552     if {$difffromfile ne {} && $difftofile ne {}} {
3553         set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3554         if {[catch {set fl [open |$cmd r]} err]} {
3555             file delete -force $diffdir
3556             error_popup "$extdifftool: [mc "command failed:"] $err"
3557         } else {
3558             fconfigure $fl -blocking 0
3559             filerun $fl [list delete_at_eof $fl $diffdir]
3560         }
3561     }
3562 }
3563
3564 proc find_hunk_blamespec {base line} {
3565     global ctext
3566
3567     # Find and parse the hunk header
3568     set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3569     if {$s_lix eq {}} return
3570
3571     set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3572     if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3573             s_line old_specs osz osz1 new_line nsz]} {
3574         return
3575     }
3576
3577     # base lines for the parents
3578     set base_lines [list $new_line]
3579     foreach old_spec [lrange [split $old_specs " "] 1 end] {
3580         if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3581                 old_spec old_line osz]} {
3582             return
3583         }
3584         lappend base_lines $old_line
3585     }
3586
3587     # Now scan the lines to determine offset within the hunk
3588     set max_parent [expr {[llength $base_lines]-2}]
3589     set dline 0
3590     set s_lno [lindex [split $s_lix "."] 0]
3591
3592     # Determine if the line is removed
3593     set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3594     if {[string match {[-+ ]*} $chunk]} {
3595         set removed_idx [string first "-" $chunk]
3596         # Choose a parent index
3597         if {$removed_idx >= 0} {
3598             set parent $removed_idx
3599         } else {
3600             set unchanged_idx [string first " " $chunk]
3601             if {$unchanged_idx >= 0} {
3602                 set parent $unchanged_idx
3603             } else {
3604                 # blame the current commit
3605                 set parent -1
3606             }
3607         }
3608         # then count other lines that belong to it
3609         for {set i $line} {[incr i -1] > $s_lno} {} {
3610             set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3611             # Determine if the line is removed
3612             set removed_idx [string first "-" $chunk]
3613             if {$parent >= 0} {
3614                 set code [string index $chunk $parent]
3615                 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3616                     incr dline
3617                 }
3618             } else {
3619                 if {$removed_idx < 0} {
3620                     incr dline
3621                 }
3622             }
3623         }
3624         incr parent
3625     } else {
3626         set parent 0
3627     }
3628
3629     incr dline [lindex $base_lines $parent]
3630     return [list $parent $dline]
3631 }
3632
3633 proc external_blame_diff {} {
3634     global currentid cmitmode
3635     global diff_menu_txtpos diff_menu_line
3636     global diff_menu_filebase flist_menu_file
3637
3638     if {$cmitmode eq "tree"} {
3639         set parent_idx 0
3640         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3641     } else {
3642         set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3643         if {$hinfo ne {}} {
3644             set parent_idx [lindex $hinfo 0]
3645             set line [lindex $hinfo 1]
3646         } else {
3647             set parent_idx 0
3648             set line 0
3649         }
3650     }
3651
3652     external_blame $parent_idx $line
3653 }
3654
3655 # Find the SHA1 ID of the blob for file $fname in the index
3656 # at stage 0 or 2
3657 proc index_sha1 {fname} {
3658     set f [open [list | git ls-files -s $fname] r]
3659     while {[gets $f line] >= 0} {
3660         set info [lindex [split $line "\t"] 0]
3661         set stage [lindex $info 2]
3662         if {$stage eq "0" || $stage eq "2"} {
3663             close $f
3664             return [lindex $info 1]
3665         }
3666     }
3667     close $f
3668     return {}
3669 }
3670
3671 # Turn an absolute path into one relative to the current directory
3672 proc make_relative {f} {
3673     if {[file pathtype $f] eq "relative"} {
3674         return $f
3675     }
3676     set elts [file split $f]
3677     set here [file split [pwd]]
3678     set ei 0
3679     set hi 0
3680     set res {}
3681     foreach d $here {
3682         if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3683             lappend res ".."
3684         } else {
3685             incr ei
3686         }
3687         incr hi
3688     }
3689     set elts [concat $res [lrange $elts $ei end]]
3690     return [eval file join $elts]
3691 }
3692
3693 proc external_blame {parent_idx {line {}}} {
3694     global flist_menu_file cdup
3695     global nullid nullid2
3696     global parentlist selectedline currentid
3697
3698     if {$parent_idx > 0} {
3699         set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3700     } else {
3701         set base_commit $currentid
3702     }
3703
3704     if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3705         error_popup [mc "No such commit"]
3706         return
3707     }
3708
3709     set cmdline [list git gui blame]
3710     if {$line ne {} && $line > 1} {
3711         lappend cmdline "--line=$line"
3712     }
3713     set f [file join $cdup $flist_menu_file]
3714     # Unfortunately it seems git gui blame doesn't like
3715     # being given an absolute path...
3716     set f [make_relative $f]
3717     lappend cmdline $base_commit $f
3718     if {[catch {eval exec $cmdline &} err]} {
3719         error_popup "[mc "git gui blame: command failed:"] $err"
3720     }
3721 }
3722
3723 proc show_line_source {} {
3724     global cmitmode currentid parents curview blamestuff blameinst
3725     global diff_menu_line diff_menu_filebase flist_menu_file
3726     global nullid nullid2 gitdir cdup
3727
3728     set from_index {}
3729     if {$cmitmode eq "tree"} {
3730         set id $currentid
3731         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3732     } else {
3733         set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3734         if {$h eq {}} return
3735         set pi [lindex $h 0]
3736         if {$pi == 0} {
3737             mark_ctext_line $diff_menu_line
3738             return
3739         }
3740         incr pi -1
3741         if {$currentid eq $nullid} {
3742             if {$pi > 0} {
3743                 # must be a merge in progress...
3744                 if {[catch {
3745                     # get the last line from .git/MERGE_HEAD
3746                     set f [open [file join $gitdir MERGE_HEAD] r]
3747                     set id [lindex [split [read $f] "\n"] end-1]
3748                     close $f
3749                 } err]} {
3750                     error_popup [mc "Couldn't read merge head: %s" $err]
3751                     return
3752                 }
3753             } elseif {$parents($curview,$currentid) eq $nullid2} {
3754                 # need to do the blame from the index
3755                 if {[catch {
3756                     set from_index [index_sha1 $flist_menu_file]
3757                 } err]} {
3758                     error_popup [mc "Error reading index: %s" $err]
3759                     return
3760                 }
3761             } else {
3762                 set id $parents($curview,$currentid)
3763             }
3764         } else {
3765             set id [lindex $parents($curview,$currentid) $pi]
3766         }
3767         set line [lindex $h 1]
3768     }
3769     set blameargs {}
3770     if {$from_index ne {}} {
3771         lappend blameargs | git cat-file blob $from_index
3772     }
3773     lappend blameargs | git blame -p -L$line,+1
3774     if {$from_index ne {}} {
3775         lappend blameargs --contents -
3776     } else {
3777         lappend blameargs $id
3778     }
3779     lappend blameargs -- [file join $cdup $flist_menu_file]
3780     if {[catch {
3781         set f [open $blameargs r]
3782     } err]} {
3783         error_popup [mc "Couldn't start git blame: %s" $err]
3784         return
3785     }
3786     nowbusy blaming [mc "Searching"]
3787     fconfigure $f -blocking 0
3788     set i [reg_instance $f]
3789     set blamestuff($i) {}
3790     set blameinst $i
3791     filerun $f [list read_line_source $f $i]
3792 }
3793
3794 proc stopblaming {} {
3795     global blameinst
3796
3797     if {[info exists blameinst]} {
3798         stop_instance $blameinst
3799         unset blameinst
3800         notbusy blaming
3801     }
3802 }
3803
3804 proc read_line_source {fd inst} {
3805     global blamestuff curview commfd blameinst nullid nullid2
3806
3807     while {[gets $fd line] >= 0} {
3808         lappend blamestuff($inst) $line
3809     }
3810     if {![eof $fd]} {
3811         return 1
3812     }
3813     unset commfd($inst)
3814     unset blameinst
3815     notbusy blaming
3816     fconfigure $fd -blocking 1
3817     if {[catch {close $fd} err]} {
3818         error_popup [mc "Error running git blame: %s" $err]
3819         return 0
3820     }
3821
3822     set fname {}
3823     set line [split [lindex $blamestuff($inst) 0] " "]
3824     set id [lindex $line 0]
3825     set lnum [lindex $line 1]
3826     if {[string length $id] == 40 && [string is xdigit $id] &&
3827         [string is digit -strict $lnum]} {
3828         # look for "filename" line
3829         foreach l $blamestuff($inst) {
3830             if {[string match "filename *" $l]} {
3831                 set fname [string range $l 9 end]
3832                 break
3833             }
3834         }
3835     }
3836     if {$fname ne {}} {
3837         # all looks good, select it
3838         if {$id eq $nullid} {
3839             # blame uses all-zeroes to mean not committed,
3840             # which would mean a change in the index
3841             set id $nullid2
3842         }
3843         if {[commitinview $id $curview]} {
3844             selectline [rowofcommit $id] 1 [list $fname $lnum]
3845         } else {
3846             error_popup [mc "That line comes from commit %s, \
3847                              which is not in this view" [shortids $id]]
3848         }
3849     } else {
3850         puts "oops couldn't parse git blame output"
3851     }
3852     return 0
3853 }
3854
3855 # delete $dir when we see eof on $f (presumably because the child has exited)
3856 proc delete_at_eof {f dir} {
3857     while {[gets $f line] >= 0} {}
3858     if {[eof $f]} {
3859         if {[catch {close $f} err]} {
3860             error_popup "[mc "External diff viewer failed:"] $err"
3861         }
3862         file delete -force $dir
3863         return 0
3864     }
3865     return 1
3866 }
3867
3868 # Functions for adding and removing shell-type quoting
3869
3870 proc shellquote {str} {
3871     if {![string match "*\['\"\\ \t]*" $str]} {
3872         return $str
3873     }
3874     if {![string match "*\['\"\\]*" $str]} {
3875         return "\"$str\""
3876     }
3877     if {![string match "*'*" $str]} {
3878         return "'$str'"
3879     }
3880     return "\"[string map {\" \\\" \\ \\\\} $str]\""
3881 }
3882
3883 proc shellarglist {l} {
3884     set str {}
3885     foreach a $l {
3886         if {$str ne {}} {
3887             append str " "
3888         }
3889         append str [shellquote $a]
3890     }
3891     return $str
3892 }
3893
3894 proc shelldequote {str} {
3895     set ret {}
3896     set used -1
3897     while {1} {
3898         incr used
3899         if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3900             append ret [string range $str $used end]
3901             set used [string length $str]
3902             break
3903         }
3904         set first [lindex $first 0]
3905         set ch [string index $str $first]
3906         if {$first > $used} {
3907             append ret [string range $str $used [expr {$first - 1}]]
3908             set used $first
3909         }
3910         if {$ch eq " " || $ch eq "\t"} break
3911         incr used
3912         if {$ch eq "'"} {
3913             set first [string first "'" $str $used]
3914             if {$first < 0} {
3915                 error "unmatched single-quote"
3916             }
3917             append ret [string range $str $used [expr {$first - 1}]]
3918             set used $first
3919             continue
3920         }
3921         if {$ch eq "\\"} {
3922             if {$used >= [string length $str]} {
3923                 error "trailing backslash"
3924             }
3925             append ret [string index $str $used]
3926             continue
3927         }
3928         # here ch == "\""
3929         while {1} {
3930             if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3931                 error "unmatched double-quote"
3932             }
3933             set first [lindex $first 0]
3934             set ch [string index $str $first]
3935             if {$first > $used} {
3936                 append ret [string range $str $used [expr {$first - 1}]]
3937                 set used $first
3938             }
3939             if {$ch eq "\""} break
3940             incr used
3941             append ret [string index $str $used]
3942             incr used
3943         }
3944     }
3945     return [list $used $ret]
3946 }
3947
3948 proc shellsplit {str} {
3949     set l {}
3950     while {1} {
3951         set str [string trimleft $str]
3952         if {$str eq {}} break
3953         set dq [shelldequote $str]
3954         set n [lindex $dq 0]
3955         set word [lindex $dq 1]
3956         set str [string range $str $n end]
3957         lappend l $word
3958     }
3959     return $l
3960 }
3961
3962 # Code to implement multiple views
3963
3964 proc newview {ishighlight} {
3965     global nextviewnum newviewname newishighlight
3966     global revtreeargs viewargscmd newviewopts curview
3967
3968     set newishighlight $ishighlight
3969     set top .gitkview
3970     if {[winfo exists $top]} {
3971         raise $top
3972         return
3973     }
3974     decode_view_opts $nextviewnum $revtreeargs
3975     set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3976     set newviewopts($nextviewnum,perm) 0
3977     set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
3978     vieweditor $top $nextviewnum [mc "Gitk view definition"]
3979 }
3980
3981 set known_view_options {
3982     {perm      b    .  {}               {mc "Remember this view"}}
3983     {reflabel  l    +  {}               {mc "References (space separated list):"}}
3984     {refs      t15  .. {}               {mc "Branches & tags:"}}
3985     {allrefs   b    *. "--all"          {mc "All refs"}}
3986     {branches  b    .  "--branches"     {mc "All (local) branches"}}
3987     {tags      b    .  "--tags"         {mc "All tags"}}
3988     {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
3989     {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
3990     {author    t15  .. "--author=*"     {mc "Author:"}}
3991     {committer t15  .  "--committer=*"  {mc "Committer:"}}
3992     {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
3993     {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
3994     {changes_l l    +  {}               {mc "Changes to Files:"}}
3995     {pickaxe_s r0   .  {}               {mc "Fixed String"}}
3996     {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
3997     {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
3998     {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
3999     {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
4000     {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
4001     {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
4002     {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
4003     {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
4004     {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
4005     {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
4006     {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
4007     {first     b    .  "--first-parent" {mc "Limit to first parent"}}
4008     {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
4009     {args      t50  *. {}               {mc "Additional arguments to git log:"}}
4010     {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
4011     {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
4012     }
4013
4014 # Convert $newviewopts($n, ...) into args for git log.
4015 proc encode_view_opts {n} {
4016     global known_view_options newviewopts
4017
4018     set rargs [list]
4019     foreach opt $known_view_options {
4020         set patterns [lindex $opt 3]
4021         if {$patterns eq {}} continue
4022         set pattern [lindex $patterns 0]
4023
4024         if {[lindex $opt 1] eq "b"} {
4025             set val $newviewopts($n,[lindex $opt 0])
4026             if {$val} {
4027                 lappend rargs $pattern
4028             }
4029         } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4030             regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4031             set val $newviewopts($n,$button_id)
4032             if {$val eq $value} {
4033                 lappend rargs $pattern
4034             }
4035         } else {
4036             set val $newviewopts($n,[lindex $opt 0])
4037             set val [string trim $val]
4038             if {$val ne {}} {
4039                 set pfix [string range $pattern 0 end-1]
4040                 lappend rargs $pfix$val
4041             }
4042         }
4043     }
4044     set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4045     return [concat $rargs [shellsplit $newviewopts($n,args)]]
4046 }
4047
4048 # Fill $newviewopts($n, ...) based on args for git log.
4049 proc decode_view_opts {n view_args} {
4050     global known_view_options newviewopts
4051
4052     foreach opt $known_view_options {
4053         set id [lindex $opt 0]
4054         if {[lindex $opt 1] eq "b"} {
4055             # Checkboxes
4056             set val 0
4057         } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4058             # Radiobuttons
4059             regexp {^(.*_)} $id uselessvar id
4060             set val 0
4061         } else {
4062             # Text fields
4063             set val {}
4064         }
4065         set newviewopts($n,$id) $val
4066     }
4067     set oargs [list]
4068     set refargs [list]
4069     foreach arg $view_args {
4070         if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4071             && ![info exists found(limit)]} {
4072             set newviewopts($n,limit) $cnt
4073             set found(limit) 1
4074             continue
4075         }
4076         catch { unset val }
4077         foreach opt $known_view_options {
4078             set id [lindex $opt 0]
4079             if {[info exists found($id)]} continue
4080             foreach pattern [lindex $opt 3] {
4081                 if {![string match $pattern $arg]} continue
4082                 if {[lindex $opt 1] eq "b"} {
4083                     # Check buttons
4084                     set val 1
4085                 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4086                     # Radio buttons
4087                     regexp {^(.*_)} $id uselessvar id
4088                     set val $num
4089                 } else {
4090                     # Text input fields
4091                     set size [string length $pattern]
4092                     set val [string range $arg [expr {$size-1}] end]
4093                 }
4094                 set newviewopts($n,$id) $val
4095                 set found($id) 1
4096                 break
4097             }
4098             if {[info exists val]} break
4099         }
4100         if {[info exists val]} continue
4101         if {[regexp {^-} $arg]} {
4102             lappend oargs $arg
4103         } else {
4104             lappend refargs $arg
4105         }
4106     }
4107     set newviewopts($n,refs) [shellarglist $refargs]
4108     set newviewopts($n,args) [shellarglist $oargs]
4109 }
4110
4111 proc edit_or_newview {} {
4112     global curview
4113
4114     if {$curview > 0} {
4115         editview
4116     } else {
4117         newview 0
4118     }
4119 }
4120
4121 proc editview {} {
4122     global curview
4123     global viewname viewperm newviewname newviewopts
4124     global viewargs viewargscmd
4125
4126     set top .gitkvedit-$curview
4127     if {[winfo exists $top]} {
4128         raise $top
4129         return
4130     }
4131     decode_view_opts $curview $viewargs($curview)
4132     set newviewname($curview)      $viewname($curview)
4133     set newviewopts($curview,perm) $viewperm($curview)
4134     set newviewopts($curview,cmd)  $viewargscmd($curview)
4135     vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4136 }
4137
4138 proc vieweditor {top n title} {
4139     global newviewname newviewopts viewfiles bgcolor
4140     global known_view_options NS
4141
4142     ttk_toplevel $top
4143     wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4144     make_transient $top .
4145
4146     # View name
4147     ${NS}::frame $top.nfr
4148     ${NS}::label $top.nl -text [mc "View Name"]
4149     ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4150     pack $top.nfr -in $top -fill x -pady 5 -padx 3
4151     pack $top.nl -in $top.nfr -side left -padx {0 5}
4152     pack $top.name -in $top.nfr -side left -padx {0 25}
4153
4154     # View options
4155     set cframe $top.nfr
4156     set cexpand 0
4157     set cnt 0
4158     foreach opt $known_view_options {
4159         set id [lindex $opt 0]
4160         set type [lindex $opt 1]
4161         set flags [lindex $opt 2]
4162         set title [eval [lindex $opt 4]]
4163         set lxpad 0
4164
4165         if {$flags eq "+" || $flags eq "*"} {
4166             set cframe $top.fr$cnt
4167             incr cnt
4168             ${NS}::frame $cframe
4169             pack $cframe -in $top -fill x -pady 3 -padx 3
4170             set cexpand [expr {$flags eq "*"}]
4171         } elseif {$flags eq ".." || $flags eq "*."} {
4172             set cframe $top.fr$cnt
4173             incr cnt
4174             ${NS}::frame $cframe
4175             pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4176             set cexpand [expr {$flags eq "*."}]
4177         } else {
4178             set lxpad 5
4179         }
4180
4181         if {$type eq "l"} {
4182             ${NS}::label $cframe.l_$id -text $title
4183             pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4184         } elseif {$type eq "b"} {
4185             ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4186             pack $cframe.c_$id -in $cframe -side left \
4187                 -padx [list $lxpad 0] -expand $cexpand -anchor w
4188         } elseif {[regexp {^r(\d+)$} $type type sz]} {
4189             regexp {^(.*_)} $id uselessvar button_id
4190             ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4191             pack $cframe.c_$id -in $cframe -side left \
4192                 -padx [list $lxpad 0] -expand $cexpand -anchor w
4193         } elseif {[regexp {^t(\d+)$} $type type sz]} {
4194             ${NS}::label $cframe.l_$id -text $title
4195             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4196                 -textvariable newviewopts($n,$id)
4197             pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4198             pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4199         } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4200             ${NS}::label $cframe.l_$id -text $title
4201             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4202                 -textvariable newviewopts($n,$id)
4203             pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4204             pack $cframe.e_$id -in $cframe -side top -fill x
4205         } elseif {$type eq "path"} {
4206             ${NS}::label $top.l -text $title
4207             pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4208             text $top.t -width 40 -height 5 -background $bgcolor
4209             if {[info exists viewfiles($n)]} {
4210                 foreach f $viewfiles($n) {
4211                     $top.t insert end $f
4212                     $top.t insert end "\n"
4213                 }
4214                 $top.t delete {end - 1c} end
4215                 $top.t mark set insert 0.0
4216             }
4217             pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4218         }
4219     }
4220
4221     ${NS}::frame $top.buts
4222     ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4223     ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4224     ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4225     bind $top <Control-Return> [list newviewok $top $n]
4226     bind $top <F5> [list newviewok $top $n 1]
4227     bind $top <Escape> [list destroy $top]
4228     grid $top.buts.ok $top.buts.apply $top.buts.can
4229     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4230     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4231     grid columnconfigure $top.buts 2 -weight 1 -uniform a
4232     pack $top.buts -in $top -side top -fill x
4233     focus $top.t
4234 }
4235
4236 proc doviewmenu {m first cmd op argv} {
4237     set nmenu [$m index end]
4238     for {set i $first} {$i <= $nmenu} {incr i} {
4239         if {[$m entrycget $i -command] eq $cmd} {
4240             eval $m $op $i $argv
4241             break
4242         }
4243     }
4244 }
4245
4246 proc allviewmenus {n op args} {
4247     # global viewhlmenu
4248
4249     doviewmenu .bar.view 5 [list showview $n] $op $args
4250     # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4251 }
4252
4253 proc newviewok {top n {apply 0}} {
4254     global nextviewnum newviewperm newviewname newishighlight
4255     global viewname viewfiles viewperm selectedview curview
4256     global viewargs viewargscmd newviewopts viewhlmenu
4257
4258     if {[catch {
4259         set newargs [encode_view_opts $n]
4260     } err]} {
4261         error_popup "[mc "Error in commit selection arguments:"] $err" $top
4262         return
4263     }
4264     set files {}
4265     foreach f [split [$top.t get 0.0 end] "\n"] {
4266         set ft [string trim $f]
4267         if {$ft ne {}} {
4268             lappend files $ft
4269         }
4270     }
4271     if {![info exists viewfiles($n)]} {
4272         # creating a new view
4273         incr nextviewnum
4274         set viewname($n) $newviewname($n)
4275         set viewperm($n) $newviewopts($n,perm)
4276         set viewfiles($n) $files
4277         set viewargs($n) $newargs
4278         set viewargscmd($n) $newviewopts($n,cmd)
4279         addviewmenu $n
4280         if {!$newishighlight} {
4281             run showview $n
4282         } else {
4283             run addvhighlight $n
4284         }
4285     } else {
4286         # editing an existing view
4287         set viewperm($n) $newviewopts($n,perm)
4288         if {$newviewname($n) ne $viewname($n)} {
4289             set viewname($n) $newviewname($n)
4290             doviewmenu .bar.view 5 [list showview $n] \
4291                 entryconf [list -label $viewname($n)]
4292             # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4293                 # entryconf [list -label $viewname($n) -value $viewname($n)]
4294         }
4295         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4296                 $newviewopts($n,cmd) ne $viewargscmd($n)} {
4297             set viewfiles($n) $files
4298             set viewargs($n) $newargs
4299             set viewargscmd($n) $newviewopts($n,cmd)
4300             if {$curview == $n} {
4301                 run reloadcommits
4302             }
4303         }
4304     }
4305     if {$apply} return
4306     catch {destroy $top}
4307 }
4308
4309 proc delview {} {
4310     global curview viewperm hlview selectedhlview
4311
4312     if {$curview == 0} return
4313     if {[info exists hlview] && $hlview == $curview} {
4314         set selectedhlview [mc "None"]
4315         unset hlview
4316     }
4317     allviewmenus $curview delete
4318     set viewperm($curview) 0
4319     showview 0
4320 }
4321
4322 proc addviewmenu {n} {
4323     global viewname viewhlmenu
4324
4325     .bar.view add radiobutton -label $viewname($n) \
4326         -command [list showview $n] -variable selectedview -value $n
4327     #$viewhlmenu add radiobutton -label $viewname($n) \
4328     #   -command [list addvhighlight $n] -variable selectedhlview
4329 }
4330
4331 proc showview {n} {
4332     global curview cached_commitrow ordertok
4333     global displayorder parentlist rowidlist rowisopt rowfinal
4334     global colormap rowtextx nextcolor canvxmax
4335     global numcommits viewcomplete
4336     global selectedline currentid canv canvy0
4337     global treediffs
4338     global pending_select mainheadid
4339     global commitidx
4340     global selectedview
4341     global hlview selectedhlview commitinterest
4342
4343     if {$n == $curview} return
4344     set selid {}
4345     set ymax [lindex [$canv cget -scrollregion] 3]
4346     set span [$canv yview]
4347     set ytop [expr {[lindex $span 0] * $ymax}]
4348     set ybot [expr {[lindex $span 1] * $ymax}]
4349     set yscreen [expr {($ybot - $ytop) / 2}]
4350     if {$selectedline ne {}} {
4351         set selid $currentid
4352         set y [yc $selectedline]
4353         if {$ytop < $y && $y < $ybot} {
4354             set yscreen [expr {$y - $ytop}]
4355         }
4356     } elseif {[info exists pending_select]} {
4357         set selid $pending_select
4358         unset pending_select
4359     }
4360     unselectline
4361     normalline
4362     catch {unset treediffs}
4363     clear_display
4364     if {[info exists hlview] && $hlview == $n} {
4365         unset hlview
4366         set selectedhlview [mc "None"]
4367     }
4368     catch {unset commitinterest}
4369     catch {unset cached_commitrow}
4370     catch {unset ordertok}
4371
4372     set curview $n
4373     set selectedview $n
4374     .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4375     .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4376
4377     run refill_reflist
4378     if {![info exists viewcomplete($n)]} {
4379         getcommits $selid
4380         return
4381     }
4382
4383     set displayorder {}
4384     set parentlist {}
4385     set rowidlist {}
4386     set rowisopt {}
4387     set rowfinal {}
4388     set numcommits $commitidx($n)
4389
4390     catch {unset colormap}
4391     catch {unset rowtextx}
4392     set nextcolor 0
4393     set canvxmax [$canv cget -width]
4394     set curview $n
4395     set row 0
4396     setcanvscroll
4397     set yf 0
4398     set row {}
4399     if {$selid ne {} && [commitinview $selid $n]} {
4400         set row [rowofcommit $selid]
4401         # try to get the selected row in the same position on the screen
4402         set ymax [lindex [$canv cget -scrollregion] 3]
4403         set ytop [expr {[yc $row] - $yscreen}]
4404         if {$ytop < 0} {
4405             set ytop 0
4406         }
4407         set yf [expr {$ytop * 1.0 / $ymax}]
4408     }
4409     allcanvs yview moveto $yf
4410     drawvisible
4411     if {$row ne {}} {
4412         selectline $row 0
4413     } elseif {!$viewcomplete($n)} {
4414         reset_pending_select $selid
4415     } else {
4416         reset_pending_select {}
4417
4418         if {[commitinview $pending_select $curview]} {
4419             selectline [rowofcommit $pending_select] 1
4420         } else {
4421             set row [first_real_row]
4422             if {$row < $numcommits} {
4423                 selectline $row 0
4424             }
4425         }
4426     }
4427     if {!$viewcomplete($n)} {
4428         if {$numcommits == 0} {
4429             show_status [mc "Reading commits..."]
4430         }
4431     } elseif {$numcommits == 0} {
4432         show_status [mc "No commits selected"]
4433     }
4434 }
4435
4436 # Stuff relating to the highlighting facility
4437
4438 proc ishighlighted {id} {
4439     global vhighlights fhighlights nhighlights rhighlights
4440
4441     if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4442         return $nhighlights($id)
4443     }
4444     if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4445         return $vhighlights($id)
4446     }
4447     if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4448         return $fhighlights($id)
4449     }
4450     if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4451         return $rhighlights($id)
4452     }
4453     return 0
4454 }
4455
4456 proc bolden {id font} {
4457     global canv linehtag currentid boldids need_redisplay markedid
4458
4459     # need_redisplay = 1 means the display is stale and about to be redrawn
4460     if {$need_redisplay} return
4461     lappend boldids $id
4462     $canv itemconf $linehtag($id) -font $font
4463     if {[info exists currentid] && $id eq $currentid} {
4464         $canv delete secsel
4465         set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4466                    -outline {{}} -tags secsel \
4467                    -fill [$canv cget -selectbackground]]
4468         $canv lower $t
4469     }
4470     if {[info exists markedid] && $id eq $markedid} {
4471         make_idmark $id
4472     }
4473 }
4474
4475 proc bolden_name {id font} {
4476     global canv2 linentag currentid boldnameids need_redisplay
4477
4478     if {$need_redisplay} return
4479     lappend boldnameids $id
4480     $canv2 itemconf $linentag($id) -font $font
4481     if {[info exists currentid] && $id eq $currentid} {
4482         $canv2 delete secsel
4483         set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4484                    -outline {{}} -tags secsel \
4485                    -fill [$canv2 cget -selectbackground]]
4486         $canv2 lower $t
4487     }
4488 }
4489
4490 proc unbolden {} {
4491     global boldids
4492
4493     set stillbold {}
4494     foreach id $boldids {
4495         if {![ishighlighted $id]} {
4496             bolden $id mainfont
4497         } else {
4498             lappend stillbold $id
4499         }
4500     }
4501     set boldids $stillbold
4502 }
4503
4504 proc addvhighlight {n} {
4505     global hlview viewcomplete curview vhl_done commitidx
4506
4507     if {[info exists hlview]} {
4508         delvhighlight
4509     }
4510     set hlview $n
4511     if {$n != $curview && ![info exists viewcomplete($n)]} {
4512         start_rev_list $n
4513     }
4514     set vhl_done $commitidx($hlview)
4515     if {$vhl_done > 0} {
4516         drawvisible
4517     }
4518 }
4519
4520 proc delvhighlight {} {
4521     global hlview vhighlights
4522
4523     if {![info exists hlview]} return
4524     unset hlview
4525     catch {unset vhighlights}
4526     unbolden
4527 }
4528
4529 proc vhighlightmore {} {
4530     global hlview vhl_done commitidx vhighlights curview
4531
4532     set max $commitidx($hlview)
4533     set vr [visiblerows]
4534     set r0 [lindex $vr 0]
4535     set r1 [lindex $vr 1]
4536     for {set i $vhl_done} {$i < $max} {incr i} {
4537         set id [commitonrow $i $hlview]
4538         if {[commitinview $id $curview]} {
4539             set row [rowofcommit $id]
4540             if {$r0 <= $row && $row <= $r1} {
4541                 if {![highlighted $row]} {
4542                     bolden $id mainfontbold
4543                 }
4544                 set vhighlights($id) 1
4545             }
4546         }
4547     }
4548     set vhl_done $max
4549     return 0
4550 }
4551
4552 proc askvhighlight {row id} {
4553     global hlview vhighlights iddrawn
4554
4555     if {[commitinview $id $hlview]} {
4556         if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4557             bolden $id mainfontbold
4558         }
4559         set vhighlights($id) 1
4560     } else {
4561         set vhighlights($id) 0
4562     }
4563 }
4564
4565 proc hfiles_change {} {
4566     global highlight_files filehighlight fhighlights fh_serial
4567     global highlight_paths
4568
4569     if {[info exists filehighlight]} {
4570         # delete previous highlights
4571         catch {close $filehighlight}
4572         unset filehighlight
4573         catch {unset fhighlights}
4574         unbolden
4575         unhighlight_filelist
4576     }
4577     set highlight_paths {}
4578     after cancel do_file_hl $fh_serial
4579     incr fh_serial
4580     if {$highlight_files ne {}} {
4581         after 300 do_file_hl $fh_serial
4582     }
4583 }
4584
4585 proc gdttype_change {name ix op} {
4586     global gdttype highlight_files findstring findpattern
4587
4588     stopfinding
4589     if {$findstring ne {}} {
4590         if {$gdttype eq [mc "containing:"]} {
4591             if {$highlight_files ne {}} {
4592                 set highlight_files {}
4593                 hfiles_change
4594             }
4595             findcom_change
4596         } else {
4597             if {$findpattern ne {}} {
4598                 set findpattern {}
4599                 findcom_change
4600             }
4601             set highlight_files $findstring
4602             hfiles_change
4603         }
4604         drawvisible
4605     }
4606     # enable/disable findtype/findloc menus too
4607 }
4608
4609 proc find_change {name ix op} {
4610     global gdttype findstring highlight_files
4611
4612     stopfinding
4613     if {$gdttype eq [mc "containing:"]} {
4614         findcom_change
4615     } else {
4616         if {$highlight_files ne $findstring} {
4617             set highlight_files $findstring
4618             hfiles_change
4619         }
4620     }
4621     drawvisible
4622 }
4623
4624 proc findcom_change args {
4625     global nhighlights boldnameids
4626     global findpattern findtype findstring gdttype
4627
4628     stopfinding
4629     # delete previous highlights, if any
4630     foreach id $boldnameids {
4631         bolden_name $id mainfont
4632     }
4633     set boldnameids {}
4634     catch {unset nhighlights}
4635     unbolden
4636     unmarkmatches
4637     if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4638         set findpattern {}
4639     } elseif {$findtype eq [mc "Regexp"]} {
4640         set findpattern $findstring
4641     } else {
4642         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4643                    $findstring]
4644         set findpattern "*$e*"
4645     }
4646 }
4647
4648 proc makepatterns {l} {
4649     set ret {}
4650     foreach e $l {
4651         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4652         if {[string index $ee end] eq "/"} {
4653             lappend ret "$ee*"
4654         } else {
4655             lappend ret $ee
4656             lappend ret "$ee/*"
4657         }
4658     }
4659     return $ret
4660 }
4661
4662 proc do_file_hl {serial} {
4663     global highlight_files filehighlight highlight_paths gdttype fhl_list
4664     global cdup findtype
4665
4666     if {$gdttype eq [mc "touching paths:"]} {
4667         # If "exact" match then convert backslashes to forward slashes.
4668         # Most useful to support Windows-flavoured file paths.
4669         if {$findtype eq [mc "Exact"]} {
4670             set highlight_files [string map {"\\" "/"} $highlight_files]
4671         }
4672         if {[catch {set paths [shellsplit $highlight_files]}]} return
4673         set highlight_paths [makepatterns $paths]
4674         highlight_filelist
4675         set relative_paths {}
4676         foreach path $paths {
4677             lappend relative_paths [file join $cdup $path]
4678         }
4679         set gdtargs [concat -- $relative_paths]
4680     } elseif {$gdttype eq [mc "adding/removing string:"]} {
4681         set gdtargs [list "-S$highlight_files"]
4682     } elseif {$gdttype eq [mc "changing lines matching:"]} {
4683         set gdtargs [list "-G$highlight_files"]
4684     } else {
4685         # must be "containing:", i.e. we're searching commit info
4686         return
4687     }
4688     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4689     set filehighlight [open $cmd r+]
4690     fconfigure $filehighlight -blocking 0
4691     filerun $filehighlight readfhighlight
4692     set fhl_list {}
4693     drawvisible
4694     flushhighlights
4695 }
4696
4697 proc flushhighlights {} {
4698     global filehighlight fhl_list
4699
4700     if {[info exists filehighlight]} {
4701         lappend fhl_list {}
4702         puts $filehighlight ""
4703         flush $filehighlight
4704     }
4705 }
4706
4707 proc askfilehighlight {row id} {
4708     global filehighlight fhighlights fhl_list
4709
4710     lappend fhl_list $id
4711     set fhighlights($id) -1
4712     puts $filehighlight $id
4713 }
4714
4715 proc readfhighlight {} {
4716     global filehighlight fhighlights curview iddrawn
4717     global fhl_list find_dirn
4718
4719     if {![info exists filehighlight]} {
4720         return 0
4721     }
4722     set nr 0
4723     while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4724         set line [string trim $line]
4725         set i [lsearch -exact $fhl_list $line]
4726         if {$i < 0} continue
4727         for {set j 0} {$j < $i} {incr j} {
4728             set id [lindex $fhl_list $j]
4729             set fhighlights($id) 0
4730         }
4731         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4732         if {$line eq {}} continue
4733         if {![commitinview $line $curview]} continue
4734         if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4735             bolden $line mainfontbold
4736         }
4737         set fhighlights($line) 1
4738     }
4739     if {[eof $filehighlight]} {
4740         # strange...
4741         puts "oops, git diff-tree died"
4742         catch {close $filehighlight}
4743         unset filehighlight
4744         return 0
4745     }
4746     if {[info exists find_dirn]} {
4747         run findmore
4748     }
4749     return 1
4750 }
4751
4752 proc doesmatch {f} {
4753     global findtype findpattern
4754
4755     if {$findtype eq [mc "Regexp"]} {
4756         return [regexp $findpattern $f]
4757     } elseif {$findtype eq [mc "IgnCase"]} {
4758         return [string match -nocase $findpattern $f]
4759     } else {
4760         return [string match $findpattern $f]
4761     }
4762 }
4763
4764 proc askfindhighlight {row id} {
4765     global nhighlights commitinfo iddrawn
4766     global findloc
4767     global markingmatches
4768
4769     if {![info exists commitinfo($id)]} {
4770         getcommit $id
4771     }
4772     set info $commitinfo($id)
4773     set isbold 0
4774     set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
4775     foreach f $info ty $fldtypes {
4776         if {$ty eq ""} continue
4777         if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4778             [doesmatch $f]} {
4779             if {$ty eq [mc "Author"]} {
4780                 set isbold 2
4781                 break
4782             }
4783             set isbold 1
4784         }
4785     }
4786     if {$isbold && [info exists iddrawn($id)]} {
4787         if {![ishighlighted $id]} {
4788             bolden $id mainfontbold
4789             if {$isbold > 1} {
4790                 bolden_name $id mainfontbold
4791             }
4792         }
4793         if {$markingmatches} {
4794             markrowmatches $row $id
4795         }
4796     }
4797     set nhighlights($id) $isbold
4798 }
4799
4800 proc markrowmatches {row id} {
4801     global canv canv2 linehtag linentag commitinfo findloc
4802
4803     set headline [lindex $commitinfo($id) 0]
4804     set author [lindex $commitinfo($id) 1]
4805     $canv delete match$row
4806     $canv2 delete match$row
4807     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4808         set m [findmatches $headline]
4809         if {$m ne {}} {
4810             markmatches $canv $row $headline $linehtag($id) $m \
4811                 [$canv itemcget $linehtag($id) -font] $row
4812         }
4813     }
4814     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4815         set m [findmatches $author]
4816         if {$m ne {}} {
4817             markmatches $canv2 $row $author $linentag($id) $m \
4818                 [$canv2 itemcget $linentag($id) -font] $row
4819         }
4820     }
4821 }
4822
4823 proc vrel_change {name ix op} {
4824     global highlight_related
4825
4826     rhighlight_none
4827     if {$highlight_related ne [mc "None"]} {
4828         run drawvisible
4829     }
4830 }
4831
4832 # prepare for testing whether commits are descendents or ancestors of a
4833 proc rhighlight_sel {a} {
4834     global descendent desc_todo ancestor anc_todo
4835     global highlight_related
4836
4837     catch {unset descendent}
4838     set desc_todo [list $a]
4839     catch {unset ancestor}
4840     set anc_todo [list $a]
4841     if {$highlight_related ne [mc "None"]} {
4842         rhighlight_none
4843         run drawvisible
4844     }
4845 }
4846
4847 proc rhighlight_none {} {
4848     global rhighlights
4849
4850     catch {unset rhighlights}
4851     unbolden
4852 }
4853
4854 proc is_descendent {a} {
4855     global curview children descendent desc_todo
4856
4857     set v $curview
4858     set la [rowofcommit $a]
4859     set todo $desc_todo
4860     set leftover {}
4861     set done 0
4862     for {set i 0} {$i < [llength $todo]} {incr i} {
4863         set do [lindex $todo $i]
4864         if {[rowofcommit $do] < $la} {
4865             lappend leftover $do
4866             continue
4867         }
4868         foreach nk $children($v,$do) {
4869             if {![info exists descendent($nk)]} {
4870                 set descendent($nk) 1
4871                 lappend todo $nk
4872                 if {$nk eq $a} {
4873                     set done 1
4874                 }
4875             }
4876         }
4877         if {$done} {
4878             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4879             return
4880         }
4881     }
4882     set descendent($a) 0
4883     set desc_todo $leftover
4884 }
4885
4886 proc is_ancestor {a} {
4887     global curview parents ancestor anc_todo
4888
4889     set v $curview
4890     set la [rowofcommit $a]
4891     set todo $anc_todo
4892     set leftover {}
4893     set done 0
4894     for {set i 0} {$i < [llength $todo]} {incr i} {
4895         set do [lindex $todo $i]
4896         if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4897             lappend leftover $do
4898             continue
4899         }
4900         foreach np $parents($v,$do) {
4901             if {![info exists ancestor($np)]} {
4902                 set ancestor($np) 1
4903                 lappend todo $np
4904                 if {$np eq $a} {
4905                     set done 1
4906                 }
4907             }
4908         }
4909         if {$done} {
4910             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4911             return
4912         }
4913     }
4914     set ancestor($a) 0
4915     set anc_todo $leftover
4916 }
4917
4918 proc askrelhighlight {row id} {
4919     global descendent highlight_related iddrawn rhighlights
4920     global selectedline ancestor
4921
4922     if {$selectedline eq {}} return
4923     set isbold 0
4924     if {$highlight_related eq [mc "Descendant"] ||
4925         $highlight_related eq [mc "Not descendant"]} {
4926         if {![info exists descendent($id)]} {
4927             is_descendent $id
4928         }
4929         if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4930             set isbold 1
4931         }
4932     } elseif {$highlight_related eq [mc "Ancestor"] ||
4933               $highlight_related eq [mc "Not ancestor"]} {
4934         if {![info exists ancestor($id)]} {
4935             is_ancestor $id
4936         }
4937         if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4938             set isbold 1
4939         }
4940     }
4941     if {[info exists iddrawn($id)]} {
4942         if {$isbold && ![ishighlighted $id]} {
4943             bolden $id mainfontbold
4944         }
4945     }
4946     set rhighlights($id) $isbold
4947 }
4948
4949 # Graph layout functions
4950
4951 proc shortids {ids} {
4952     set res {}
4953     foreach id $ids {
4954         if {[llength $id] > 1} {
4955             lappend res [shortids $id]
4956         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4957             lappend res [string range $id 0 7]
4958         } else {
4959             lappend res $id
4960         }
4961     }
4962     return $res
4963 }
4964
4965 proc ntimes {n o} {
4966     set ret {}
4967     set o [list $o]
4968     for {set mask 1} {$mask <= $n} {incr mask $mask} {
4969         if {($n & $mask) != 0} {
4970             set ret [concat $ret $o]
4971         }
4972         set o [concat $o $o]
4973     }
4974     return $ret
4975 }
4976
4977 proc ordertoken {id} {
4978     global ordertok curview varcid varcstart varctok curview parents children
4979     global nullid nullid2
4980
4981     if {[info exists ordertok($id)]} {
4982         return $ordertok($id)
4983     }
4984     set origid $id
4985     set todo {}
4986     while {1} {
4987         if {[info exists varcid($curview,$id)]} {
4988             set a $varcid($curview,$id)
4989             set p [lindex $varcstart($curview) $a]
4990         } else {
4991             set p [lindex $children($curview,$id) 0]
4992         }
4993         if {[info exists ordertok($p)]} {
4994             set tok $ordertok($p)
4995             break
4996         }
4997         set id [first_real_child $curview,$p]
4998         if {$id eq {}} {
4999             # it's a root
5000             set tok [lindex $varctok($curview) $varcid($curview,$p)]
5001             break
5002         }
5003         if {[llength $parents($curview,$id)] == 1} {
5004             lappend todo [list $p {}]
5005         } else {
5006             set j [lsearch -exact $parents($curview,$id) $p]
5007             if {$j < 0} {
5008                 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5009             }
5010             lappend todo [list $p [strrep $j]]
5011         }
5012     }
5013     for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5014         set p [lindex $todo $i 0]
5015         append tok [lindex $todo $i 1]
5016         set ordertok($p) $tok
5017     }
5018     set ordertok($origid) $tok
5019     return $tok
5020 }
5021
5022 # Work out where id should go in idlist so that order-token
5023 # values increase from left to right
5024 proc idcol {idlist id {i 0}} {
5025     set t [ordertoken $id]
5026     if {$i < 0} {
5027         set i 0
5028     }
5029     if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
5030         if {$i > [llength $idlist]} {
5031             set i [llength $idlist]
5032         }
5033         while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5034         incr i
5035     } else {
5036         if {$t > [ordertoken [lindex $idlist $i]]} {
5037             while {[incr i] < [llength $idlist] &&
5038                    $t >= [ordertoken [lindex $idlist $i]]} {}
5039         }
5040     }
5041     return $i
5042 }
5043
5044 proc initlayout {} {
5045     global rowidlist rowisopt rowfinal displayorder parentlist
5046     global numcommits canvxmax canv
5047     global nextcolor
5048     global colormap rowtextx
5049
5050     set numcommits 0
5051     set displayorder {}
5052     set parentlist {}
5053     set nextcolor 0
5054     set rowidlist {}
5055     set rowisopt {}
5056     set rowfinal {}
5057     set canvxmax [$canv cget -width]
5058     catch {unset colormap}
5059     catch {unset rowtextx}
5060     setcanvscroll
5061 }
5062
5063 proc setcanvscroll {} {
5064     global canv canv2 canv3 numcommits linespc canvxmax canvy0
5065     global lastscrollset lastscrollrows
5066
5067     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5068     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5069     $canv2 conf -scrollregion [list 0 0 0 $ymax]
5070     $canv3 conf -scrollregion [list 0 0 0 $ymax]
5071     set lastscrollset [clock clicks -milliseconds]
5072     set lastscrollrows $numcommits
5073 }
5074
5075 proc visiblerows {} {
5076     global canv numcommits linespc
5077
5078     set ymax [lindex [$canv cget -scrollregion] 3]
5079     if {$ymax eq {} || $ymax == 0} return
5080     set f [$canv yview]
5081     set y0 [expr {int([lindex $f 0] * $ymax)}]
5082     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5083     if {$r0 < 0} {
5084         set r0 0
5085     }
5086     set y1 [expr {int([lindex $f 1] * $ymax)}]
5087     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5088     if {$r1 >= $numcommits} {
5089         set r1 [expr {$numcommits - 1}]
5090     }
5091     return [list $r0 $r1]
5092 }
5093
5094 proc layoutmore {} {
5095     global commitidx viewcomplete curview
5096     global numcommits pending_select curview
5097     global lastscrollset lastscrollrows
5098
5099     if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5100         [clock clicks -milliseconds] - $lastscrollset > 500} {
5101         setcanvscroll
5102     }
5103     if {[info exists pending_select] &&
5104         [commitinview $pending_select $curview]} {
5105         update
5106         selectline [rowofcommit $pending_select] 1
5107     }
5108     drawvisible
5109 }
5110
5111 # With path limiting, we mightn't get the actual HEAD commit,
5112 # so ask git rev-list what is the first ancestor of HEAD that
5113 # touches a file in the path limit.
5114 proc get_viewmainhead {view} {
5115     global viewmainheadid vfilelimit viewinstances mainheadid
5116
5117     catch {
5118         set rfd [open [concat | git rev-list -1 $mainheadid \
5119                            -- $vfilelimit($view)] r]
5120         set j [reg_instance $rfd]
5121         lappend viewinstances($view) $j
5122         fconfigure $rfd -blocking 0
5123         filerun $rfd [list getviewhead $rfd $j $view]
5124         set viewmainheadid($curview) {}
5125     }
5126 }
5127
5128 # git rev-list should give us just 1 line to use as viewmainheadid($view)
5129 proc getviewhead {fd inst view} {
5130     global viewmainheadid commfd curview viewinstances showlocalchanges
5131
5132     set id {}
5133     if {[gets $fd line] < 0} {
5134         if {![eof $fd]} {
5135             return 1
5136         }
5137     } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5138         set id $line
5139     }
5140     set viewmainheadid($view) $id
5141     close $fd
5142     unset commfd($inst)
5143     set i [lsearch -exact $viewinstances($view) $inst]
5144     if {$i >= 0} {
5145         set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5146     }
5147     if {$showlocalchanges && $id ne {} && $view == $curview} {
5148         doshowlocalchanges
5149     }
5150     return 0
5151 }
5152
5153 proc doshowlocalchanges {} {
5154     global curview viewmainheadid
5155
5156     if {$viewmainheadid($curview) eq {}} return
5157     if {[commitinview $viewmainheadid($curview) $curview]} {
5158         dodiffindex
5159     } else {
5160         interestedin $viewmainheadid($curview) dodiffindex
5161     }
5162 }
5163
5164 proc dohidelocalchanges {} {
5165     global nullid nullid2 lserial curview
5166
5167     if {[commitinview $nullid $curview]} {
5168         removefakerow $nullid
5169     }
5170     if {[commitinview $nullid2 $curview]} {
5171         removefakerow $nullid2
5172     }
5173     incr lserial
5174 }
5175
5176 # spawn off a process to do git diff-index --cached HEAD
5177 proc dodiffindex {} {
5178     global lserial showlocalchanges vfilelimit curview
5179     global hasworktree
5180
5181     if {!$showlocalchanges || !$hasworktree} return
5182     incr lserial
5183     set cmd "|git diff-index --cached HEAD"
5184     if {$vfilelimit($curview) ne {}} {
5185         set cmd [concat $cmd -- $vfilelimit($curview)]
5186     }
5187     set fd [open $cmd r]
5188     fconfigure $fd -blocking 0
5189     set i [reg_instance $fd]
5190     filerun $fd [list readdiffindex $fd $lserial $i]
5191 }
5192
5193 proc readdiffindex {fd serial inst} {
5194     global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5195     global vfilelimit
5196
5197     set isdiff 1
5198     if {[gets $fd line] < 0} {
5199         if {![eof $fd]} {
5200             return 1
5201         }
5202         set isdiff 0
5203     }
5204     # we only need to see one line and we don't really care what it says...
5205     stop_instance $inst
5206
5207     if {$serial != $lserial} {
5208         return 0
5209     }
5210
5211     # now see if there are any local changes not checked in to the index
5212     set cmd "|git diff-files"
5213     if {$vfilelimit($curview) ne {}} {
5214         set cmd [concat $cmd -- $vfilelimit($curview)]
5215     }
5216     set fd [open $cmd r]
5217     fconfigure $fd -blocking 0
5218     set i [reg_instance $fd]
5219     filerun $fd [list readdifffiles $fd $serial $i]
5220
5221     if {$isdiff && ![commitinview $nullid2 $curview]} {
5222         # add the line for the changes in the index to the graph
5223         set hl [mc "Local changes checked in to index but not committed"]
5224         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5225         set commitdata($nullid2) "\n    $hl\n"
5226         if {[commitinview $nullid $curview]} {
5227             removefakerow $nullid
5228         }
5229         insertfakerow $nullid2 $viewmainheadid($curview)
5230     } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5231         if {[commitinview $nullid $curview]} {
5232             removefakerow $nullid
5233         }
5234         removefakerow $nullid2
5235     }
5236     return 0
5237 }
5238
5239 proc readdifffiles {fd serial inst} {
5240     global viewmainheadid nullid nullid2 curview
5241     global commitinfo commitdata lserial
5242
5243     set isdiff 1
5244     if {[gets $fd line] < 0} {
5245         if {![eof $fd]} {
5246             return 1
5247         }
5248         set isdiff 0
5249     }
5250     # we only need to see one line and we don't really care what it says...
5251     stop_instance $inst
5252
5253     if {$serial != $lserial} {
5254         return 0
5255     }
5256
5257     if {$isdiff && ![commitinview $nullid $curview]} {
5258         # add the line for the local diff to the graph
5259         set hl [mc "Local uncommitted changes, not checked in to index"]
5260         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5261         set commitdata($nullid) "\n    $hl\n"
5262         if {[commitinview $nullid2 $curview]} {
5263             set p $nullid2
5264         } else {
5265             set p $viewmainheadid($curview)
5266         }
5267         insertfakerow $nullid $p
5268     } elseif {!$isdiff && [commitinview $nullid $curview]} {
5269         removefakerow $nullid
5270     }
5271     return 0
5272 }
5273
5274 proc nextuse {id row} {
5275     global curview children
5276
5277     if {[info exists children($curview,$id)]} {
5278         foreach kid $children($curview,$id) {
5279             if {![commitinview $kid $curview]} {
5280                 return -1
5281             }
5282             if {[rowofcommit $kid] > $row} {
5283                 return [rowofcommit $kid]
5284             }
5285         }
5286     }
5287     if {[commitinview $id $curview]} {
5288         return [rowofcommit $id]
5289     }
5290     return -1
5291 }
5292
5293 proc prevuse {id row} {
5294     global curview children
5295
5296     set ret -1
5297     if {[info exists children($curview,$id)]} {
5298         foreach kid $children($curview,$id) {
5299             if {![commitinview $kid $curview]} break
5300             if {[rowofcommit $kid] < $row} {
5301                 set ret [rowofcommit $kid]
5302             }
5303         }
5304     }
5305     return $ret
5306 }
5307
5308 proc make_idlist {row} {
5309     global displayorder parentlist uparrowlen downarrowlen mingaplen
5310     global commitidx curview children
5311
5312     set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5313     if {$r < 0} {
5314         set r 0
5315     }
5316     set ra [expr {$row - $downarrowlen}]
5317     if {$ra < 0} {
5318         set ra 0
5319     }
5320     set rb [expr {$row + $uparrowlen}]
5321     if {$rb > $commitidx($curview)} {
5322         set rb $commitidx($curview)
5323     }
5324     make_disporder $r [expr {$rb + 1}]
5325     set ids {}
5326     for {} {$r < $ra} {incr r} {
5327         set nextid [lindex $displayorder [expr {$r + 1}]]
5328         foreach p [lindex $parentlist $r] {
5329             if {$p eq $nextid} continue
5330             set rn [nextuse $p $r]
5331             if {$rn >= $row &&
5332                 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5333                 lappend ids [list [ordertoken $p] $p]
5334             }
5335         }
5336     }
5337     for {} {$r < $row} {incr r} {
5338         set nextid [lindex $displayorder [expr {$r + 1}]]
5339         foreach p [lindex $parentlist $r] {
5340             if {$p eq $nextid} continue
5341             set rn [nextuse $p $r]
5342             if {$rn < 0 || $rn >= $row} {
5343                 lappend ids [list [ordertoken $p] $p]
5344             }
5345         }
5346     }
5347     set id [lindex $displayorder $row]
5348     lappend ids [list [ordertoken $id] $id]
5349     while {$r < $rb} {
5350         foreach p [lindex $parentlist $r] {
5351             set firstkid [lindex $children($curview,$p) 0]
5352             if {[rowofcommit $firstkid] < $row} {
5353                 lappend ids [list [ordertoken $p] $p]
5354             }
5355         }
5356         incr r
5357         set id [lindex $displayorder $r]
5358         if {$id ne {}} {
5359             set firstkid [lindex $children($curview,$id) 0]
5360             if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5361                 lappend ids [list [ordertoken $id] $id]
5362             }
5363         }
5364     }
5365     set idlist {}
5366     foreach idx [lsort -unique $ids] {
5367         lappend idlist [lindex $idx 1]
5368     }
5369     return $idlist
5370 }
5371
5372 proc rowsequal {a b} {
5373     while {[set i [lsearch -exact $a {}]] >= 0} {
5374         set a [lreplace $a $i $i]
5375     }
5376     while {[set i [lsearch -exact $b {}]] >= 0} {
5377         set b [lreplace $b $i $i]
5378     }
5379     return [expr {$a eq $b}]
5380 }
5381
5382 proc makeupline {id row rend col} {
5383     global rowidlist uparrowlen downarrowlen mingaplen
5384
5385     for {set r $rend} {1} {set r $rstart} {
5386         set rstart [prevuse $id $r]
5387         if {$rstart < 0} return
5388         if {$rstart < $row} break
5389     }
5390     if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5391         set rstart [expr {$rend - $uparrowlen - 1}]
5392     }
5393     for {set r $rstart} {[incr r] <= $row} {} {
5394         set idlist [lindex $rowidlist $r]
5395         if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5396             set col [idcol $idlist $id $col]
5397             lset rowidlist $r [linsert $idlist $col $id]
5398             changedrow $r
5399         }
5400     }
5401 }
5402
5403 proc layoutrows {row endrow} {
5404     global rowidlist rowisopt rowfinal displayorder
5405     global uparrowlen downarrowlen maxwidth mingaplen
5406     global children parentlist
5407     global commitidx viewcomplete curview
5408
5409     make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5410     set idlist {}
5411     if {$row > 0} {
5412         set rm1 [expr {$row - 1}]
5413         foreach id [lindex $rowidlist $rm1] {
5414             if {$id ne {}} {
5415                 lappend idlist $id
5416             }
5417         }
5418         set final [lindex $rowfinal $rm1]
5419     }
5420     for {} {$row < $endrow} {incr row} {
5421         set rm1 [expr {$row - 1}]
5422         if {$rm1 < 0 || $idlist eq {}} {
5423             set idlist [make_idlist $row]
5424             set final 1
5425         } else {
5426             set id [lindex $displayorder $rm1]
5427             set col [lsearch -exact $idlist $id]
5428             set idlist [lreplace $idlist $col $col]
5429             foreach p [lindex $parentlist $rm1] {
5430                 if {[lsearch -exact $idlist $p] < 0} {
5431                     set col [idcol $idlist $p $col]
5432                     set idlist [linsert $idlist $col $p]
5433                     # if not the first child, we have to insert a line going up
5434                     if {$id ne [lindex $children($curview,$p) 0]} {
5435                         makeupline $p $rm1 $row $col
5436                     }
5437                 }
5438             }
5439             set id [lindex $displayorder $row]
5440             if {$row > $downarrowlen} {
5441                 set termrow [expr {$row - $downarrowlen - 1}]
5442                 foreach p [lindex $parentlist $termrow] {
5443                     set i [lsearch -exact $idlist $p]
5444                     if {$i < 0} continue
5445                     set nr [nextuse $p $termrow]
5446                     if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5447                         set idlist [lreplace $idlist $i $i]
5448                     }
5449                 }
5450             }
5451             set col [lsearch -exact $idlist $id]
5452             if {$col < 0} {
5453                 set col [idcol $idlist $id]
5454                 set idlist [linsert $idlist $col $id]
5455                 if {$children($curview,$id) ne {}} {
5456                     makeupline $id $rm1 $row $col
5457                 }
5458             }
5459             set r [expr {$row + $uparrowlen - 1}]
5460             if {$r < $commitidx($curview)} {
5461                 set x $col
5462                 foreach p [lindex $parentlist $r] {
5463                     if {[lsearch -exact $idlist $p] >= 0} continue
5464                     set fk [lindex $children($curview,$p) 0]
5465                     if {[rowofcommit $fk] < $row} {
5466                         set x [idcol $idlist $p $x]
5467                         set idlist [linsert $idlist $x $p]
5468                     }
5469                 }
5470                 if {[incr r] < $commitidx($curview)} {
5471                     set p [lindex $displayorder $r]
5472                     if {[lsearch -exact $idlist $p] < 0} {
5473                         set fk [lindex $children($curview,$p) 0]
5474                         if {$fk ne {} && [rowofcommit $fk] < $row} {
5475                             set x [idcol $idlist $p $x]
5476                             set idlist [linsert $idlist $x $p]
5477                         }
5478                     }
5479                 }
5480             }
5481         }
5482         if {$final && !$viewcomplete($curview) &&
5483             $row + $uparrowlen + $mingaplen + $downarrowlen
5484                 >= $commitidx($curview)} {
5485             set final 0
5486         }
5487         set l [llength $rowidlist]
5488         if {$row == $l} {
5489             lappend rowidlist $idlist
5490             lappend rowisopt 0
5491             lappend rowfinal $final
5492         } elseif {$row < $l} {
5493             if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5494                 lset rowidlist $row $idlist
5495                 changedrow $row
5496             }
5497             lset rowfinal $row $final
5498         } else {
5499             set pad [ntimes [expr {$row - $l}] {}]
5500             set rowidlist [concat $rowidlist $pad]
5501             lappend rowidlist $idlist
5502             set rowfinal [concat $rowfinal $pad]
5503             lappend rowfinal $final
5504             set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5505         }
5506     }
5507     return $row
5508 }
5509
5510 proc changedrow {row} {
5511     global displayorder iddrawn rowisopt need_redisplay
5512
5513     set l [llength $rowisopt]
5514     if {$row < $l} {
5515         lset rowisopt $row 0
5516         if {$row + 1 < $l} {
5517             lset rowisopt [expr {$row + 1}] 0
5518             if {$row + 2 < $l} {
5519                 lset rowisopt [expr {$row + 2}] 0
5520             }
5521         }
5522     }
5523     set id [lindex $displayorder $row]
5524     if {[info exists iddrawn($id)]} {
5525         set need_redisplay 1
5526     }
5527 }
5528
5529 proc insert_pad {row col npad} {
5530     global rowidlist
5531
5532     set pad [ntimes $npad {}]
5533     set idlist [lindex $rowidlist $row]
5534     set bef [lrange $idlist 0 [expr {$col - 1}]]
5535     set aft [lrange $idlist $col end]
5536     set i [lsearch -exact $aft {}]
5537     if {$i > 0} {
5538         set aft [lreplace $aft $i $i]
5539     }
5540     lset rowidlist $row [concat $bef $pad $aft]
5541     changedrow $row
5542 }
5543
5544 proc optimize_rows {row col endrow} {
5545     global rowidlist rowisopt displayorder curview children
5546
5547     if {$row < 1} {
5548         set row 1
5549     }
5550     for {} {$row < $endrow} {incr row; set col 0} {
5551         if {[lindex $rowisopt $row]} continue
5552         set haspad 0
5553         set y0 [expr {$row - 1}]
5554         set ym [expr {$row - 2}]
5555         set idlist [lindex $rowidlist $row]
5556         set previdlist [lindex $rowidlist $y0]
5557         if {$idlist eq {} || $previdlist eq {}} continue
5558         if {$ym >= 0} {
5559             set pprevidlist [lindex $rowidlist $ym]
5560             if {$pprevidlist eq {}} continue
5561         } else {
5562             set pprevidlist {}
5563         }
5564         set x0 -1
5565         set xm -1
5566         for {} {$col < [llength $idlist]} {incr col} {
5567             set id [lindex $idlist $col]
5568             if {[lindex $previdlist $col] eq $id} continue
5569             if {$id eq {}} {
5570                 set haspad 1
5571                 continue
5572             }
5573             set x0 [lsearch -exact $previdlist $id]
5574             if {$x0 < 0} continue
5575             set z [expr {$x0 - $col}]
5576             set isarrow 0
5577             set z0 {}
5578             if {$ym >= 0} {
5579                 set xm [lsearch -exact $pprevidlist $id]
5580                 if {$xm >= 0} {
5581                     set z0 [expr {$xm - $x0}]
5582                 }
5583             }
5584             if {$z0 eq {}} {
5585                 # if row y0 is the first child of $id then it's not an arrow
5586                 if {[lindex $children($curview,$id) 0] ne
5587                     [lindex $displayorder $y0]} {
5588                     set isarrow 1
5589                 }
5590             }
5591             if {!$isarrow && $id ne [lindex $displayorder $row] &&
5592                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5593                 set isarrow 1
5594             }
5595             # Looking at lines from this row to the previous row,
5596             # make them go straight up if they end in an arrow on
5597             # the previous row; otherwise make them go straight up
5598             # or at 45 degrees.
5599             if {$z < -1 || ($z < 0 && $isarrow)} {
5600                 # Line currently goes left too much;
5601                 # insert pads in the previous row, then optimize it
5602                 set npad [expr {-1 - $z + $isarrow}]
5603                 insert_pad $y0 $x0 $npad
5604                 if {$y0 > 0} {
5605                     optimize_rows $y0 $x0 $row
5606                 }
5607                 set previdlist [lindex $rowidlist $y0]
5608                 set x0 [lsearch -exact $previdlist $id]
5609                 set z [expr {$x0 - $col}]
5610                 if {$z0 ne {}} {
5611                     set pprevidlist [lindex $rowidlist $ym]
5612                     set xm [lsearch -exact $pprevidlist $id]
5613                     set z0 [expr {$xm - $x0}]
5614                 }
5615             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5616                 # Line currently goes right too much;
5617                 # insert pads in this line
5618                 set npad [expr {$z - 1 + $isarrow}]
5619                 insert_pad $row $col $npad
5620                 set idlist [lindex $rowidlist $row]
5621                 incr col $npad
5622                 set z [expr {$x0 - $col}]
5623                 set haspad 1
5624             }
5625             if {$z0 eq {} && !$isarrow && $ym >= 0} {
5626                 # this line links to its first child on row $row-2
5627                 set id [lindex $displayorder $ym]
5628                 set xc [lsearch -exact $pprevidlist $id]
5629                 if {$xc >= 0} {
5630                     set z0 [expr {$xc - $x0}]
5631                 }
5632             }
5633             # avoid lines jigging left then immediately right
5634             if {$z0 ne {} && $z < 0 && $z0 > 0} {
5635                 insert_pad $y0 $x0 1
5636                 incr x0
5637                 optimize_rows $y0 $x0 $row
5638                 set previdlist [lindex $rowidlist $y0]
5639             }
5640         }
5641         if {!$haspad} {
5642             # Find the first column that doesn't have a line going right
5643             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5644                 set id [lindex $idlist $col]
5645                 if {$id eq {}} break
5646                 set x0 [lsearch -exact $previdlist $id]
5647                 if {$x0 < 0} {
5648                     # check if this is the link to the first child
5649                     set kid [lindex $displayorder $y0]
5650                     if {[lindex $children($curview,$id) 0] eq $kid} {
5651                         # it is, work out offset to child
5652                         set x0 [lsearch -exact $previdlist $kid]
5653                     }
5654                 }
5655                 if {$x0 <= $col} break
5656             }
5657             # Insert a pad at that column as long as it has a line and
5658             # isn't the last column
5659             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5660                 set idlist [linsert $idlist $col {}]
5661                 lset rowidlist $row $idlist
5662                 changedrow $row
5663             }
5664         }
5665     }
5666 }
5667
5668 proc xc {row col} {
5669     global canvx0 linespc
5670     return [expr {$canvx0 + $col * $linespc}]
5671 }
5672
5673 proc yc {row} {
5674     global canvy0 linespc
5675     return [expr {$canvy0 + $row * $linespc}]
5676 }
5677
5678 proc linewidth {id} {
5679     global thickerline lthickness
5680
5681     set wid $lthickness
5682     if {[info exists thickerline] && $id eq $thickerline} {
5683         set wid [expr {2 * $lthickness}]
5684     }
5685     return $wid
5686 }
5687
5688 proc rowranges {id} {
5689     global curview children uparrowlen downarrowlen
5690     global rowidlist
5691
5692     set kids $children($curview,$id)
5693     if {$kids eq {}} {
5694         return {}
5695     }
5696     set ret {}
5697     lappend kids $id
5698     foreach child $kids {
5699         if {![commitinview $child $curview]} break
5700         set row [rowofcommit $child]
5701         if {![info exists prev]} {
5702             lappend ret [expr {$row + 1}]
5703         } else {
5704             if {$row <= $prevrow} {
5705                 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5706             }
5707             # see if the line extends the whole way from prevrow to row
5708             if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5709                 [lsearch -exact [lindex $rowidlist \
5710                             [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5711                 # it doesn't, see where it ends
5712                 set r [expr {$prevrow + $downarrowlen}]
5713                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5714                     while {[incr r -1] > $prevrow &&
5715                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5716                 } else {
5717                     while {[incr r] <= $row &&
5718                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5719                     incr r -1
5720                 }
5721                 lappend ret $r
5722                 # see where it starts up again
5723                 set r [expr {$row - $uparrowlen}]
5724                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5725                     while {[incr r] < $row &&
5726                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5727                 } else {
5728                     while {[incr r -1] >= $prevrow &&
5729                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5730                     incr r
5731                 }
5732                 lappend ret $r
5733             }
5734         }
5735         if {$child eq $id} {
5736             lappend ret $row
5737         }
5738         set prev $child
5739         set prevrow $row
5740     }
5741     return $ret
5742 }
5743
5744 proc drawlineseg {id row endrow arrowlow} {
5745     global rowidlist displayorder iddrawn linesegs
5746     global canv colormap linespc curview maxlinelen parentlist
5747
5748     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5749     set le [expr {$row + 1}]
5750     set arrowhigh 1
5751     while {1} {
5752         set c [lsearch -exact [lindex $rowidlist $le] $id]
5753         if {$c < 0} {
5754             incr le -1
5755             break
5756         }
5757         lappend cols $c
5758         set x [lindex $displayorder $le]
5759         if {$x eq $id} {
5760             set arrowhigh 0
5761             break
5762         }
5763         if {[info exists iddrawn($x)] || $le == $endrow} {
5764             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5765             if {$c >= 0} {
5766                 lappend cols $c
5767                 set arrowhigh 0
5768             }
5769             break
5770         }
5771         incr le
5772     }
5773     if {$le <= $row} {
5774         return $row
5775     }
5776
5777     set lines {}
5778     set i 0
5779     set joinhigh 0
5780     if {[info exists linesegs($id)]} {
5781         set lines $linesegs($id)
5782         foreach li $lines {
5783             set r0 [lindex $li 0]
5784             if {$r0 > $row} {
5785                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5786                     set joinhigh 1
5787                 }
5788                 break
5789             }
5790             incr i
5791         }
5792     }
5793     set joinlow 0
5794     if {$i > 0} {
5795         set li [lindex $lines [expr {$i-1}]]
5796         set r1 [lindex $li 1]
5797         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5798             set joinlow 1
5799         }
5800     }
5801
5802     set x [lindex $cols [expr {$le - $row}]]
5803     set xp [lindex $cols [expr {$le - 1 - $row}]]
5804     set dir [expr {$xp - $x}]
5805     if {$joinhigh} {
5806         set ith [lindex $lines $i 2]
5807         set coords [$canv coords $ith]
5808         set ah [$canv itemcget $ith -arrow]
5809         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5810         set x2 [lindex $cols [expr {$le + 1 - $row}]]
5811         if {$x2 ne {} && $x - $x2 == $dir} {
5812             set coords [lrange $coords 0 end-2]
5813         }
5814     } else {
5815         set coords [list [xc $le $x] [yc $le]]
5816     }
5817     if {$joinlow} {
5818         set itl [lindex $lines [expr {$i-1}] 2]
5819         set al [$canv itemcget $itl -arrow]
5820         set arrowlow [expr {$al eq "last" || $al eq "both"}]
5821     } elseif {$arrowlow} {
5822         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5823             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5824             set arrowlow 0
5825         }
5826     }
5827     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5828     for {set y $le} {[incr y -1] > $row} {} {
5829         set x $xp
5830         set xp [lindex $cols [expr {$y - 1 - $row}]]
5831         set ndir [expr {$xp - $x}]
5832         if {$dir != $ndir || $xp < 0} {
5833             lappend coords [xc $y $x] [yc $y]
5834         }
5835         set dir $ndir
5836     }
5837     if {!$joinlow} {
5838         if {$xp < 0} {
5839             # join parent line to first child
5840             set ch [lindex $displayorder $row]
5841             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5842             if {$xc < 0} {
5843                 puts "oops: drawlineseg: child $ch not on row $row"
5844             } elseif {$xc != $x} {
5845                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5846                     set d [expr {int(0.5 * $linespc)}]
5847                     set x1 [xc $row $x]
5848                     if {$xc < $x} {
5849                         set x2 [expr {$x1 - $d}]
5850                     } else {
5851                         set x2 [expr {$x1 + $d}]
5852                     }
5853                     set y2 [yc $row]
5854                     set y1 [expr {$y2 + $d}]
5855                     lappend coords $x1 $y1 $x2 $y2
5856                 } elseif {$xc < $x - 1} {
5857                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
5858                 } elseif {$xc > $x + 1} {
5859                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
5860                 }
5861                 set x $xc
5862             }
5863             lappend coords [xc $row $x] [yc $row]
5864         } else {
5865             set xn [xc $row $xp]
5866             set yn [yc $row]
5867             lappend coords $xn $yn
5868         }
5869         if {!$joinhigh} {
5870             assigncolor $id
5871             set t [$canv create line $coords -width [linewidth $id] \
5872                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
5873             $canv lower $t
5874             bindline $t $id
5875             set lines [linsert $lines $i [list $row $le $t]]
5876         } else {
5877             $canv coords $ith $coords
5878             if {$arrow ne $ah} {
5879                 $canv itemconf $ith -arrow $arrow
5880             }
5881             lset lines $i 0 $row
5882         }
5883     } else {
5884         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5885         set ndir [expr {$xo - $xp}]
5886         set clow [$canv coords $itl]
5887         if {$dir == $ndir} {
5888             set clow [lrange $clow 2 end]
5889         }
5890         set coords [concat $coords $clow]
5891         if {!$joinhigh} {
5892             lset lines [expr {$i-1}] 1 $le
5893         } else {
5894             # coalesce two pieces
5895             $canv delete $ith
5896             set b [lindex $lines [expr {$i-1}] 0]
5897             set e [lindex $lines $i 1]
5898             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5899         }
5900         $canv coords $itl $coords
5901         if {$arrow ne $al} {
5902             $canv itemconf $itl -arrow $arrow
5903         }
5904     }
5905
5906     set linesegs($id) $lines
5907     return $le
5908 }
5909
5910 proc drawparentlinks {id row} {
5911     global rowidlist canv colormap curview parentlist
5912     global idpos linespc
5913
5914     set rowids [lindex $rowidlist $row]
5915     set col [lsearch -exact $rowids $id]
5916     if {$col < 0} return
5917     set olds [lindex $parentlist $row]
5918     set row2 [expr {$row + 1}]
5919     set x [xc $row $col]
5920     set y [yc $row]
5921     set y2 [yc $row2]
5922     set d [expr {int(0.5 * $linespc)}]
5923     set ymid [expr {$y + $d}]
5924     set ids [lindex $rowidlist $row2]
5925     # rmx = right-most X coord used
5926     set rmx 0
5927     foreach p $olds {
5928         set i [lsearch -exact $ids $p]
5929         if {$i < 0} {
5930             puts "oops, parent $p of $id not in list"
5931             continue
5932         }
5933         set x2 [xc $row2 $i]
5934         if {$x2 > $rmx} {
5935             set rmx $x2
5936         }
5937         set j [lsearch -exact $rowids $p]
5938         if {$j < 0} {
5939             # drawlineseg will do this one for us
5940             continue
5941         }
5942         assigncolor $p
5943         # should handle duplicated parents here...
5944         set coords [list $x $y]
5945         if {$i != $col} {
5946             # if attaching to a vertical segment, draw a smaller
5947             # slant for visual distinctness
5948             if {$i == $j} {
5949                 if {$i < $col} {
5950                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5951                 } else {
5952                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5953                 }
5954             } elseif {$i < $col && $i < $j} {
5955                 # segment slants towards us already
5956                 lappend coords [xc $row $j] $y
5957             } else {
5958                 if {$i < $col - 1} {
5959                     lappend coords [expr {$x2 + $linespc}] $y
5960                 } elseif {$i > $col + 1} {
5961                     lappend coords [expr {$x2 - $linespc}] $y
5962                 }
5963                 lappend coords $x2 $y2
5964             }
5965         } else {
5966             lappend coords $x2 $y2
5967         }
5968         set t [$canv create line $coords -width [linewidth $p] \
5969                    -fill $colormap($p) -tags lines.$p]
5970         $canv lower $t
5971         bindline $t $p
5972     }
5973     if {$rmx > [lindex $idpos($id) 1]} {
5974         lset idpos($id) 1 $rmx
5975         redrawtags $id
5976     }
5977 }
5978
5979 proc drawlines {id} {
5980     global canv
5981
5982     $canv itemconf lines.$id -width [linewidth $id]
5983 }
5984
5985 proc drawcmittext {id row col} {
5986     global linespc canv canv2 canv3 fgcolor curview
5987     global cmitlisted commitinfo rowidlist parentlist
5988     global rowtextx idpos idtags idheads idotherrefs
5989     global linehtag linentag linedtag selectedline
5990     global canvxmax boldids boldnameids fgcolor markedid
5991     global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5992     global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
5993     global circleoutlinecolor
5994
5995     # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5996     set listed $cmitlisted($curview,$id)
5997     if {$id eq $nullid} {
5998         set ofill $workingfilescirclecolor
5999     } elseif {$id eq $nullid2} {
6000         set ofill $indexcirclecolor
6001     } elseif {$id eq $mainheadid} {
6002         set ofill $mainheadcirclecolor
6003     } else {
6004         set ofill [lindex $circlecolors $listed]
6005     }
6006     set x [xc $row $col]
6007     set y [yc $row]
6008     set orad [expr {$linespc / 3}]
6009     if {$listed <= 2} {
6010         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6011                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6012                    -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6013     } elseif {$listed == 3} {
6014         # triangle pointing left for left-side commits
6015         set t [$canv create polygon \
6016                    [expr {$x - $orad}] $y \
6017                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6018                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6019                    -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6020     } else {
6021         # triangle pointing right for right-side commits
6022         set t [$canv create polygon \
6023                    [expr {$x + $orad - 1}] $y \
6024                    [expr {$x - $orad}] [expr {$y - $orad}] \
6025                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6026                    -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6027     }
6028     set circleitem($row) $t
6029     $canv raise $t
6030     $canv bind $t <1> {selcanvline {} %x %y}
6031     set rmx [llength [lindex $rowidlist $row]]
6032     set olds [lindex $parentlist $row]
6033     if {$olds ne {}} {
6034         set nextids [lindex $rowidlist [expr {$row + 1}]]
6035         foreach p $olds {
6036             set i [lsearch -exact $nextids $p]
6037             if {$i > $rmx} {
6038                 set rmx $i
6039             }
6040         }
6041     }
6042     set xt [xc $row $rmx]
6043     set rowtextx($row) $xt
6044     set idpos($id) [list $x $xt $y]
6045     if {[info exists idtags($id)] || [info exists idheads($id)]
6046         || [info exists idotherrefs($id)]} {
6047         set xt [drawtags $id $x $xt $y]
6048     }
6049     if {[lindex $commitinfo($id) 6] > 0} {
6050         set xt [drawnotesign $xt $y]
6051     }
6052     set headline [lindex $commitinfo($id) 0]
6053     set name [lindex $commitinfo($id) 1]
6054     set date [lindex $commitinfo($id) 2]
6055     set date [formatdate $date]
6056     set font mainfont
6057     set nfont mainfont
6058     set isbold [ishighlighted $id]
6059     if {$isbold > 0} {
6060         lappend boldids $id
6061         set font mainfontbold
6062         if {$isbold > 1} {
6063             lappend boldnameids $id
6064             set nfont mainfontbold
6065         }
6066     }
6067     set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6068                            -text $headline -font $font -tags text]
6069     $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6070     set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6071                            -text $name -font $nfont -tags text]
6072     set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6073                            -text $date -font mainfont -tags text]
6074     if {$selectedline == $row} {
6075         make_secsel $id
6076     }
6077     if {[info exists markedid] && $markedid eq $id} {
6078         make_idmark $id
6079     }
6080     set xr [expr {$xt + [font measure $font $headline]}]
6081     if {$xr > $canvxmax} {
6082         set canvxmax $xr
6083         setcanvscroll
6084     }
6085 }
6086
6087 proc drawcmitrow {row} {
6088     global displayorder rowidlist nrows_drawn
6089     global iddrawn markingmatches
6090     global commitinfo numcommits
6091     global filehighlight fhighlights findpattern nhighlights
6092     global hlview vhighlights
6093     global highlight_related rhighlights
6094
6095     if {$row >= $numcommits} return
6096
6097     set id [lindex $displayorder $row]
6098     if {[info exists hlview] && ![info exists vhighlights($id)]} {
6099         askvhighlight $row $id
6100     }
6101     if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
6102         askfilehighlight $row $id
6103     }
6104     if {$findpattern ne {} && ![info exists nhighlights($id)]} {
6105         askfindhighlight $row $id
6106     }
6107     if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
6108         askrelhighlight $row $id
6109     }
6110     if {![info exists iddrawn($id)]} {
6111         set col [lsearch -exact [lindex $rowidlist $row] $id]
6112         if {$col < 0} {
6113             puts "oops, row $row id $id not in list"
6114             return
6115         }
6116         if {![info exists commitinfo($id)]} {
6117             getcommit $id
6118         }
6119         assigncolor $id
6120         drawcmittext $id $row $col
6121         set iddrawn($id) 1
6122         incr nrows_drawn
6123     }
6124     if {$markingmatches} {
6125         markrowmatches $row $id
6126     }
6127 }
6128
6129 proc drawcommits {row {endrow {}}} {
6130     global numcommits iddrawn displayorder curview need_redisplay
6131     global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6132
6133     if {$row < 0} {
6134         set row 0
6135     }
6136     if {$endrow eq {}} {
6137         set endrow $row
6138     }
6139     if {$endrow >= $numcommits} {
6140         set endrow [expr {$numcommits - 1}]
6141     }
6142
6143     set rl1 [expr {$row - $downarrowlen - 3}]
6144     if {$rl1 < 0} {
6145         set rl1 0
6146     }
6147     set ro1 [expr {$row - 3}]
6148     if {$ro1 < 0} {
6149         set ro1 0
6150     }
6151     set r2 [expr {$endrow + $uparrowlen + 3}]
6152     if {$r2 > $numcommits} {
6153         set r2 $numcommits
6154     }
6155     for {set r $rl1} {$r < $r2} {incr r} {
6156         if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6157             if {$rl1 < $r} {
6158                 layoutrows $rl1 $r
6159             }
6160             set rl1 [expr {$r + 1}]
6161         }
6162     }
6163     if {$rl1 < $r} {
6164         layoutrows $rl1 $r
6165     }
6166     optimize_rows $ro1 0 $r2
6167     if {$need_redisplay || $nrows_drawn > 2000} {
6168         clear_display
6169     }
6170
6171     # make the lines join to already-drawn rows either side
6172     set r [expr {$row - 1}]
6173     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6174         set r $row
6175     }
6176     set er [expr {$endrow + 1}]
6177     if {$er >= $numcommits ||
6178         ![info exists iddrawn([lindex $displayorder $er])]} {
6179         set er $endrow
6180     }
6181     for {} {$r <= $er} {incr r} {
6182         set id [lindex $displayorder $r]
6183         set wasdrawn [info exists iddrawn($id)]
6184         drawcmitrow $r
6185         if {$r == $er} break
6186         set nextid [lindex $displayorder [expr {$r + 1}]]
6187         if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6188         drawparentlinks $id $r
6189
6190         set rowids [lindex $rowidlist $r]
6191         foreach lid $rowids {
6192             if {$lid eq {}} continue
6193             if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6194             if {$lid eq $id} {
6195                 # see if this is the first child of any of its parents
6196                 foreach p [lindex $parentlist $r] {
6197                     if {[lsearch -exact $rowids $p] < 0} {
6198                         # make this line extend up to the child
6199                         set lineend($p) [drawlineseg $p $r $er 0]
6200                     }
6201                 }
6202             } else {
6203                 set lineend($lid) [drawlineseg $lid $r $er 1]
6204             }
6205         }
6206     }
6207 }
6208
6209 proc undolayout {row} {
6210     global uparrowlen mingaplen downarrowlen
6211     global rowidlist rowisopt rowfinal need_redisplay
6212
6213     set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6214     if {$r < 0} {
6215         set r 0
6216     }
6217     if {[llength $rowidlist] > $r} {
6218         incr r -1
6219         set rowidlist [lrange $rowidlist 0 $r]
6220         set rowfinal [lrange $rowfinal 0 $r]
6221         set rowisopt [lrange $rowisopt 0 $r]
6222         set need_redisplay 1
6223         run drawvisible
6224     }
6225 }
6226
6227 proc drawvisible {} {
6228     global canv linespc curview vrowmod selectedline targetrow targetid
6229     global need_redisplay cscroll numcommits
6230
6231     set fs [$canv yview]
6232     set ymax [lindex [$canv cget -scrollregion] 3]
6233     if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6234     set f0 [lindex $fs 0]
6235     set f1 [lindex $fs 1]
6236     set y0 [expr {int($f0 * $ymax)}]
6237     set y1 [expr {int($f1 * $ymax)}]
6238
6239     if {[info exists targetid]} {
6240         if {[commitinview $targetid $curview]} {
6241             set r [rowofcommit $targetid]
6242             if {$r != $targetrow} {
6243                 # Fix up the scrollregion and change the scrolling position
6244                 # now that our target row has moved.
6245                 set diff [expr {($r - $targetrow) * $linespc}]
6246                 set targetrow $r
6247                 setcanvscroll
6248                 set ymax [lindex [$canv cget -scrollregion] 3]
6249                 incr y0 $diff
6250                 incr y1 $diff
6251                 set f0 [expr {$y0 / $ymax}]
6252                 set f1 [expr {$y1 / $ymax}]
6253                 allcanvs yview moveto $f0
6254                 $cscroll set $f0 $f1
6255                 set need_redisplay 1
6256             }
6257         } else {
6258             unset targetid
6259         }
6260     }
6261
6262     set row [expr {int(($y0 - 3) / $linespc) - 1}]
6263     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6264     if {$endrow >= $vrowmod($curview)} {
6265         update_arcrows $curview
6266     }
6267     if {$selectedline ne {} &&
6268         $row <= $selectedline && $selectedline <= $endrow} {
6269         set targetrow $selectedline
6270     } elseif {[info exists targetid]} {
6271         set targetrow [expr {int(($row + $endrow) / 2)}]
6272     }
6273     if {[info exists targetrow]} {
6274         if {$targetrow >= $numcommits} {
6275             set targetrow [expr {$numcommits - 1}]
6276         }
6277         set targetid [commitonrow $targetrow]
6278     }
6279     drawcommits $row $endrow
6280 }
6281
6282 proc clear_display {} {
6283     global iddrawn linesegs need_redisplay nrows_drawn
6284     global vhighlights fhighlights nhighlights rhighlights
6285     global linehtag linentag linedtag boldids boldnameids
6286
6287     allcanvs delete all
6288     catch {unset iddrawn}
6289     catch {unset linesegs}
6290     catch {unset linehtag}
6291     catch {unset linentag}
6292     catch {unset linedtag}
6293     set boldids {}
6294     set boldnameids {}
6295     catch {unset vhighlights}
6296     catch {unset fhighlights}
6297     catch {unset nhighlights}
6298     catch {unset rhighlights}
6299     set need_redisplay 0
6300     set nrows_drawn 0
6301 }
6302
6303 proc findcrossings {id} {
6304     global rowidlist parentlist numcommits displayorder
6305
6306     set cross {}
6307     set ccross {}
6308     foreach {s e} [rowranges $id] {
6309         if {$e >= $numcommits} {
6310             set e [expr {$numcommits - 1}]
6311         }
6312         if {$e <= $s} continue
6313         for {set row $e} {[incr row -1] >= $s} {} {
6314             set x [lsearch -exact [lindex $rowidlist $row] $id]
6315             if {$x < 0} break
6316             set olds [lindex $parentlist $row]
6317             set kid [lindex $displayorder $row]
6318             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6319             if {$kidx < 0} continue
6320             set nextrow [lindex $rowidlist [expr {$row + 1}]]
6321             foreach p $olds {
6322                 set px [lsearch -exact $nextrow $p]
6323                 if {$px < 0} continue
6324                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6325                     if {[lsearch -exact $ccross $p] >= 0} continue
6326                     if {$x == $px + ($kidx < $px? -1: 1)} {
6327                         lappend ccross $p
6328                     } elseif {[lsearch -exact $cross $p] < 0} {
6329                         lappend cross $p
6330                     }
6331                 }
6332             }
6333         }
6334     }
6335     return [concat $ccross {{}} $cross]
6336 }
6337
6338 proc assigncolor {id} {
6339     global colormap colors nextcolor
6340     global parents children children curview
6341
6342     if {[info exists colormap($id)]} return
6343     set ncolors [llength $colors]
6344     if {[info exists children($curview,$id)]} {
6345         set kids $children($curview,$id)
6346     } else {
6347         set kids {}
6348     }
6349     if {[llength $kids] == 1} {
6350         set child [lindex $kids 0]
6351         if {[info exists colormap($child)]
6352             && [llength $parents($curview,$child)] == 1} {
6353             set colormap($id) $colormap($child)
6354             return
6355         }
6356     }
6357     set badcolors {}
6358     set origbad {}
6359     foreach x [findcrossings $id] {
6360         if {$x eq {}} {
6361             # delimiter between corner crossings and other crossings
6362             if {[llength $badcolors] >= $ncolors - 1} break
6363             set origbad $badcolors
6364         }
6365         if {[info exists colormap($x)]
6366             && [lsearch -exact $badcolors $colormap($x)] < 0} {
6367             lappend badcolors $colormap($x)
6368         }
6369     }
6370     if {[llength $badcolors] >= $ncolors} {
6371         set badcolors $origbad
6372     }
6373     set origbad $badcolors
6374     if {[llength $badcolors] < $ncolors - 1} {
6375         foreach child $kids {
6376             if {[info exists colormap($child)]
6377                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6378                 lappend badcolors $colormap($child)
6379             }
6380             foreach p $parents($curview,$child) {
6381                 if {[info exists colormap($p)]
6382                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
6383                     lappend badcolors $colormap($p)
6384                 }
6385             }
6386         }
6387         if {[llength $badcolors] >= $ncolors} {
6388             set badcolors $origbad
6389         }
6390     }
6391     for {set i 0} {$i <= $ncolors} {incr i} {
6392         set c [lindex $colors $nextcolor]
6393         if {[incr nextcolor] >= $ncolors} {
6394             set nextcolor 0
6395         }
6396         if {[lsearch -exact $badcolors $c]} break
6397     }
6398     set colormap($id) $c
6399 }
6400
6401 proc bindline {t id} {
6402     global canv
6403
6404     $canv bind $t <Enter> "lineenter %x %y $id"
6405     $canv bind $t <Motion> "linemotion %x %y $id"
6406     $canv bind $t <Leave> "lineleave $id"
6407     $canv bind $t <Button-1> "lineclick %x %y $id 1"
6408 }
6409
6410 proc graph_pane_width {} {
6411     global use_ttk
6412
6413     if {$use_ttk} {
6414         set g [.tf.histframe.pwclist sashpos 0]
6415     } else {
6416         set g [.tf.histframe.pwclist sash coord 0]
6417     }
6418     return [lindex $g 0]
6419 }
6420
6421 proc totalwidth {l font extra} {
6422     set tot 0
6423     foreach str $l {
6424         set tot [expr {$tot + [font measure $font $str] + $extra}]
6425     }
6426     return $tot
6427 }
6428
6429 proc drawtags {id x xt y1} {
6430     global idtags idheads idotherrefs mainhead
6431     global linespc lthickness
6432     global canv rowtextx curview fgcolor bgcolor ctxbut
6433     global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6434     global tagbgcolor tagfgcolor tagoutlinecolor
6435     global reflinecolor
6436
6437     set marks {}
6438     set ntags 0
6439     set nheads 0
6440     set singletag 0
6441     set maxtags 3
6442     set maxtagpct 25
6443     set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6444     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6445     set extra [expr {$delta + $lthickness + $linespc}]
6446
6447     if {[info exists idtags($id)]} {
6448         set marks $idtags($id)
6449         set ntags [llength $marks]
6450         if {$ntags > $maxtags ||
6451             [totalwidth $marks mainfont $extra] > $maxwidth} {
6452             # show just a single "n tags..." tag
6453             set singletag 1
6454             if {$ntags == 1} {
6455                 set marks [list "tag..."]
6456             } else {
6457                 set marks [list [format "%d tags..." $ntags]]
6458             }
6459             set ntags 1
6460         }
6461     }
6462     if {[info exists idheads($id)]} {
6463         set marks [concat $marks $idheads($id)]
6464         set nheads [llength $idheads($id)]
6465     }
6466     if {[info exists idotherrefs($id)]} {
6467         set marks [concat $marks $idotherrefs($id)]
6468     }
6469     if {$marks eq {}} {
6470         return $xt
6471     }
6472
6473     set yt [expr {$y1 - 0.5 * $linespc}]
6474     set yb [expr {$yt + $linespc - 1}]
6475     set xvals {}
6476     set wvals {}
6477     set i -1
6478     foreach tag $marks {
6479         incr i
6480         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6481             set wid [font measure mainfontbold $tag]
6482         } else {
6483             set wid [font measure mainfont $tag]
6484         }
6485         lappend xvals $xt
6486         lappend wvals $wid
6487         set xt [expr {$xt + $wid + $extra}]
6488     }
6489     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6490                -width $lthickness -fill $reflinecolor -tags tag.$id]
6491     $canv lower $t
6492     foreach tag $marks x $xvals wid $wvals {
6493         set tag_quoted [string map {% %%} $tag]
6494         set xl [expr {$x + $delta}]
6495         set xr [expr {$x + $delta + $wid + $lthickness}]
6496         set font mainfont
6497         if {[incr ntags -1] >= 0} {
6498             # draw a tag
6499             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6500                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6501                        -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6502                        -tags tag.$id]
6503             if {$singletag} {
6504                 set tagclick [list showtags $id 1]
6505             } else {
6506                 set tagclick [list showtag $tag_quoted 1]
6507             }
6508             $canv bind $t <1> $tagclick
6509             set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6510         } else {
6511             # draw a head or other ref
6512             if {[incr nheads -1] >= 0} {
6513                 set col $headbgcolor
6514                 if {$tag eq $mainhead} {
6515                     set font mainfontbold
6516                 }
6517             } else {
6518                 set col "#ddddff"
6519             }
6520             set xl [expr {$xl - $delta/2}]
6521             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6522                 -width 1 -outline black -fill $col -tags tag.$id
6523             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6524                 set rwid [font measure mainfont $remoteprefix]
6525                 set xi [expr {$x + 1}]
6526                 set yti [expr {$yt + 1}]
6527                 set xri [expr {$x + $rwid}]
6528                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6529                         -width 0 -fill $remotebgcolor -tags tag.$id
6530             }
6531         }
6532         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6533                    -font $font -tags [list tag.$id text]]
6534         if {$ntags >= 0} {
6535             $canv bind $t <1> $tagclick
6536         } elseif {$nheads >= 0} {
6537             $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6538         }
6539     }
6540     return $xt
6541 }
6542
6543 proc drawnotesign {xt y} {
6544     global linespc canv fgcolor
6545
6546     set orad [expr {$linespc / 3}]
6547     set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6548                [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6549                -fill yellow -outline $fgcolor -width 1 -tags circle]
6550     set xt [expr {$xt + $orad * 3}]
6551     return $xt
6552 }
6553
6554 proc xcoord {i level ln} {
6555     global canvx0 xspc1 xspc2
6556
6557     set x [expr {$canvx0 + $i * $xspc1($ln)}]
6558     if {$i > 0 && $i == $level} {
6559         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6560     } elseif {$i > $level} {
6561         set x [expr {$x + $xspc2 - $xspc1($ln)}]
6562     }
6563     return $x
6564 }
6565
6566 proc show_status {msg} {
6567     global canv fgcolor
6568
6569     clear_display
6570     $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6571         -tags text -fill $fgcolor
6572 }
6573
6574 # Don't change the text pane cursor if it is currently the hand cursor,
6575 # showing that we are over a sha1 ID link.
6576 proc settextcursor {c} {
6577     global ctext curtextcursor
6578
6579     if {[$ctext cget -cursor] == $curtextcursor} {
6580         $ctext config -cursor $c
6581     }
6582     set curtextcursor $c
6583 }
6584
6585 proc nowbusy {what {name {}}} {
6586     global isbusy busyname statusw
6587
6588     if {[array names isbusy] eq {}} {
6589         . config -cursor watch
6590         settextcursor watch
6591     }
6592     set isbusy($what) 1
6593     set busyname($what) $name
6594     if {$name ne {}} {
6595         $statusw conf -text $name
6596     }
6597 }
6598
6599 proc notbusy {what} {
6600     global isbusy maincursor textcursor busyname statusw
6601
6602     catch {
6603         unset isbusy($what)
6604         if {$busyname($what) ne {} &&
6605             [$statusw cget -text] eq $busyname($what)} {
6606             $statusw conf -text {}
6607         }
6608     }
6609     if {[array names isbusy] eq {}} {
6610         . config -cursor $maincursor
6611         settextcursor $textcursor
6612     }
6613 }
6614
6615 proc findmatches {f} {
6616     global findtype findstring
6617     if {$findtype == [mc "Regexp"]} {
6618         set matches [regexp -indices -all -inline $findstring $f]
6619     } else {
6620         set fs $findstring
6621         if {$findtype == [mc "IgnCase"]} {
6622             set f [string tolower $f]
6623             set fs [string tolower $fs]
6624         }
6625         set matches {}
6626         set i 0
6627         set l [string length $fs]
6628         while {[set j [string first $fs $f $i]] >= 0} {
6629             lappend matches [list $j [expr {$j+$l-1}]]
6630             set i [expr {$j + $l}]
6631         }
6632     }
6633     return $matches
6634 }
6635
6636 proc dofind {{dirn 1} {wrap 1}} {
6637     global findstring findstartline findcurline selectedline numcommits
6638     global gdttype filehighlight fh_serial find_dirn findallowwrap
6639
6640     if {[info exists find_dirn]} {
6641         if {$find_dirn == $dirn} return
6642         stopfinding
6643     }
6644     focus .
6645     if {$findstring eq {} || $numcommits == 0} return
6646     if {$selectedline eq {}} {
6647         set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6648     } else {
6649         set findstartline $selectedline
6650     }
6651     set findcurline $findstartline
6652     nowbusy finding [mc "Searching"]
6653     if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6654         after cancel do_file_hl $fh_serial
6655         do_file_hl $fh_serial
6656     }
6657     set find_dirn $dirn
6658     set findallowwrap $wrap
6659     run findmore
6660 }
6661
6662 proc stopfinding {} {
6663     global find_dirn findcurline fprogcoord
6664
6665     if {[info exists find_dirn]} {
6666         unset find_dirn
6667         unset findcurline
6668         notbusy finding
6669         set fprogcoord 0
6670         adjustprogress
6671     }
6672     stopblaming
6673 }
6674
6675 proc findmore {} {
6676     global commitdata commitinfo numcommits findpattern findloc
6677     global findstartline findcurline findallowwrap
6678     global find_dirn gdttype fhighlights fprogcoord
6679     global curview varcorder vrownum varccommits vrowmod
6680
6681     if {![info exists find_dirn]} {
6682         return 0
6683     }
6684     set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6685     set l $findcurline
6686     set moretodo 0
6687     if {$find_dirn > 0} {
6688         incr l
6689         if {$l >= $numcommits} {
6690             set l 0
6691         }
6692         if {$l <= $findstartline} {
6693             set lim [expr {$findstartline + 1}]
6694         } else {
6695             set lim $numcommits
6696             set moretodo $findallowwrap
6697         }
6698     } else {
6699         if {$l == 0} {
6700             set l $numcommits
6701         }
6702         incr l -1
6703         if {$l >= $findstartline} {
6704             set lim [expr {$findstartline - 1}]
6705         } else {
6706             set lim -1
6707             set moretodo $findallowwrap
6708         }
6709     }
6710     set n [expr {($lim - $l) * $find_dirn}]
6711     if {$n > 500} {
6712         set n 500
6713         set moretodo 1
6714     }
6715     if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6716         update_arcrows $curview
6717     }
6718     set found 0
6719     set domore 1
6720     set ai [bsearch $vrownum($curview) $l]
6721     set a [lindex $varcorder($curview) $ai]
6722     set arow [lindex $vrownum($curview) $ai]
6723     set ids [lindex $varccommits($curview,$a)]
6724     set arowend [expr {$arow + [llength $ids]}]
6725     if {$gdttype eq [mc "containing:"]} {
6726         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6727             if {$l < $arow || $l >= $arowend} {
6728                 incr ai $find_dirn
6729                 set a [lindex $varcorder($curview) $ai]
6730                 set arow [lindex $vrownum($curview) $ai]
6731                 set ids [lindex $varccommits($curview,$a)]
6732                 set arowend [expr {$arow + [llength $ids]}]
6733             }
6734             set id [lindex $ids [expr {$l - $arow}]]
6735             # shouldn't happen unless git log doesn't give all the commits...
6736             if {![info exists commitdata($id)] ||
6737                 ![doesmatch $commitdata($id)]} {
6738                 continue
6739             }
6740             if {![info exists commitinfo($id)]} {
6741                 getcommit $id
6742             }
6743             set info $commitinfo($id)
6744             foreach f $info ty $fldtypes {
6745                 if {$ty eq ""} continue
6746                 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6747                     [doesmatch $f]} {
6748                     set found 1
6749                     break
6750                 }
6751             }
6752             if {$found} break
6753         }
6754     } else {
6755         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6756             if {$l < $arow || $l >= $arowend} {
6757                 incr ai $find_dirn
6758                 set a [lindex $varcorder($curview) $ai]
6759                 set arow [lindex $vrownum($curview) $ai]
6760                 set ids [lindex $varccommits($curview,$a)]
6761                 set arowend [expr {$arow + [llength $ids]}]
6762             }
6763             set id [lindex $ids [expr {$l - $arow}]]
6764             if {![info exists fhighlights($id)]} {
6765                 # this sets fhighlights($id) to -1
6766                 askfilehighlight $l $id
6767             }
6768             if {$fhighlights($id) > 0} {
6769                 set found $domore
6770                 break
6771             }
6772             if {$fhighlights($id) < 0} {
6773                 if {$domore} {
6774                     set domore 0
6775                     set findcurline [expr {$l - $find_dirn}]
6776                 }
6777             }
6778         }
6779     }
6780     if {$found || ($domore && !$moretodo)} {
6781         unset findcurline
6782         unset find_dirn
6783         notbusy finding
6784         set fprogcoord 0
6785         adjustprogress
6786         if {$found} {
6787             findselectline $l
6788         } else {
6789             bell
6790         }
6791         return 0
6792     }
6793     if {!$domore} {
6794         flushhighlights
6795     } else {
6796         set findcurline [expr {$l - $find_dirn}]
6797     }
6798     set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6799     if {$n < 0} {
6800         incr n $numcommits
6801     }
6802     set fprogcoord [expr {$n * 1.0 / $numcommits}]
6803     adjustprogress
6804     return $domore
6805 }
6806
6807 proc findselectline {l} {
6808     global findloc commentend ctext findcurline markingmatches gdttype
6809
6810     set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6811     set findcurline $l
6812     selectline $l 1
6813     if {$markingmatches &&
6814         ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6815         # highlight the matches in the comments
6816         set f [$ctext get 1.0 $commentend]
6817         set matches [findmatches $f]
6818         foreach match $matches {
6819             set start [lindex $match 0]
6820             set end [expr {[lindex $match 1] + 1}]
6821             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6822         }
6823     }
6824     drawvisible
6825 }
6826
6827 # mark the bits of a headline or author that match a find string
6828 proc markmatches {canv l str tag matches font row} {
6829     global selectedline
6830
6831     set bbox [$canv bbox $tag]
6832     set x0 [lindex $bbox 0]
6833     set y0 [lindex $bbox 1]
6834     set y1 [lindex $bbox 3]
6835     foreach match $matches {
6836         set start [lindex $match 0]
6837         set end [lindex $match 1]
6838         if {$start > $end} continue
6839         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6840         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6841         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6842                    [expr {$x0+$xlen+2}] $y1 \
6843                    -outline {} -tags [list match$l matches] -fill yellow]
6844         $canv lower $t
6845         if {$row == $selectedline} {
6846             $canv raise $t secsel
6847         }
6848     }
6849 }
6850
6851 proc unmarkmatches {} {
6852     global markingmatches
6853
6854     allcanvs delete matches
6855     set markingmatches 0
6856     stopfinding
6857 }
6858
6859 proc selcanvline {w x y} {
6860     global canv canvy0 ctext linespc
6861     global rowtextx
6862     set ymax [lindex [$canv cget -scrollregion] 3]
6863     if {$ymax == {}} return
6864     set yfrac [lindex [$canv yview] 0]
6865     set y [expr {$y + $yfrac * $ymax}]
6866     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6867     if {$l < 0} {
6868         set l 0
6869     }
6870     if {$w eq $canv} {
6871         set xmax [lindex [$canv cget -scrollregion] 2]
6872         set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6873         if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6874     }
6875     unmarkmatches
6876     selectline $l 1
6877 }
6878
6879 proc commit_descriptor {p} {
6880     global commitinfo
6881     if {![info exists commitinfo($p)]} {
6882         getcommit $p
6883     }
6884     set l "..."
6885     if {[llength $commitinfo($p)] > 1} {
6886         set l [lindex $commitinfo($p) 0]
6887     }
6888     return "$p ($l)\n"
6889 }
6890
6891 # append some text to the ctext widget, and make any SHA1 ID
6892 # that we know about be a clickable link.
6893 proc appendwithlinks {text tags} {
6894     global ctext linknum curview
6895
6896     set start [$ctext index "end - 1c"]
6897     $ctext insert end $text $tags
6898     set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
6899     foreach l $links {
6900         set s [lindex $l 0]
6901         set e [lindex $l 1]
6902         set linkid [string range $text $s $e]
6903         incr e
6904         $ctext tag delete link$linknum
6905         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6906         setlink $linkid link$linknum
6907         incr linknum
6908     }
6909 }
6910
6911 proc setlink {id lk} {
6912     global curview ctext pendinglinks
6913     global linkfgcolor
6914
6915     if {[string range $id 0 1] eq "-g"} {
6916       set id [string range $id 2 end]
6917     }
6918
6919     set known 0
6920     if {[string length $id] < 40} {
6921         set matches [longid $id]
6922         if {[llength $matches] > 0} {
6923             if {[llength $matches] > 1} return
6924             set known 1
6925             set id [lindex $matches 0]
6926         }
6927     } else {
6928         set known [commitinview $id $curview]
6929     }
6930     if {$known} {
6931         $ctext tag conf $lk -foreground $linkfgcolor -underline 1
6932         $ctext tag bind $lk <1> [list selbyid $id]
6933         $ctext tag bind $lk <Enter> {linkcursor %W 1}
6934         $ctext tag bind $lk <Leave> {linkcursor %W -1}
6935     } else {
6936         lappend pendinglinks($id) $lk
6937         interestedin $id {makelink %P}
6938     }
6939 }
6940
6941 proc appendshortlink {id {pre {}} {post {}}} {
6942     global ctext linknum
6943
6944     $ctext insert end $pre
6945     $ctext tag delete link$linknum
6946     $ctext insert end [string range $id 0 7] link$linknum
6947     $ctext insert end $post
6948     setlink $id link$linknum
6949     incr linknum
6950 }
6951
6952 proc makelink {id} {
6953     global pendinglinks
6954
6955     if {![info exists pendinglinks($id)]} return
6956     foreach lk $pendinglinks($id) {
6957         setlink $id $lk
6958     }
6959     unset pendinglinks($id)
6960 }
6961
6962 proc linkcursor {w inc} {
6963     global linkentercount curtextcursor
6964
6965     if {[incr linkentercount $inc] > 0} {
6966         $w configure -cursor hand2
6967     } else {
6968         $w configure -cursor $curtextcursor
6969         if {$linkentercount < 0} {
6970             set linkentercount 0
6971         }
6972     }
6973 }
6974
6975 proc viewnextline {dir} {
6976     global canv linespc
6977
6978     $canv delete hover
6979     set ymax [lindex [$canv cget -scrollregion] 3]
6980     set wnow [$canv yview]
6981     set wtop [expr {[lindex $wnow 0] * $ymax}]
6982     set newtop [expr {$wtop + $dir * $linespc}]
6983     if {$newtop < 0} {
6984         set newtop 0
6985     } elseif {$newtop > $ymax} {
6986         set newtop $ymax
6987     }
6988     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6989 }
6990
6991 # add a list of tag or branch names at position pos
6992 # returns the number of names inserted
6993 proc appendrefs {pos ids var} {
6994     global ctext linknum curview $var maxrefs mainheadid
6995
6996     if {[catch {$ctext index $pos}]} {
6997         return 0
6998     }
6999     $ctext conf -state normal
7000     $ctext delete $pos "$pos lineend"
7001     set tags {}
7002     foreach id $ids {
7003         foreach tag [set $var\($id\)] {
7004             lappend tags [list $tag $id]
7005         }
7006     }
7007
7008     set sep {}
7009     set tags [lsort -index 0 -decreasing $tags]
7010     set nutags 0
7011
7012     if {[llength $tags] > $maxrefs} {
7013         # If we are displaying heads, and there are too many,
7014         # see if there are some important heads to display.
7015         # Currently this means "master" and the current head.
7016         set itags {}
7017         if {$var eq "idheads"} {
7018             set utags {}
7019             foreach ti $tags {
7020                 set hname [lindex $ti 0]
7021                 set id [lindex $ti 1]
7022                 if {($hname eq "master" || $id eq $mainheadid) &&
7023                     [llength $itags] < $maxrefs} {
7024                     lappend itags $ti
7025                 } else {
7026                     lappend utags $ti
7027                 }
7028             }
7029             set tags $utags
7030         }
7031         if {$itags ne {}} {
7032             set str [mc "and many more"]
7033             set sep " "
7034         } else {
7035             set str [mc "many"]
7036         }
7037         $ctext insert $pos "$str ([llength $tags])"
7038         set nutags [llength $tags]
7039         set tags $itags
7040     }
7041
7042     foreach ti $tags {
7043         set id [lindex $ti 1]
7044         set lk link$linknum
7045         incr linknum
7046         $ctext tag delete $lk
7047         $ctext insert $pos $sep
7048         $ctext insert $pos [lindex $ti 0] $lk
7049         setlink $id $lk
7050         set sep ", "
7051     }
7052     $ctext tag add wwrap "$pos linestart" "$pos lineend"
7053     $ctext conf -state disabled
7054     return [expr {[llength $tags] + $nutags}]
7055 }
7056
7057 # called when we have finished computing the nearby tags
7058 proc dispneartags {delay} {
7059     global selectedline currentid showneartags tagphase
7060
7061     if {$selectedline eq {} || !$showneartags} return
7062     after cancel dispnexttag
7063     if {$delay} {
7064         after 200 dispnexttag
7065         set tagphase -1
7066     } else {
7067         after idle dispnexttag
7068         set tagphase 0
7069     }
7070 }
7071
7072 proc dispnexttag {} {
7073     global selectedline currentid showneartags tagphase ctext
7074
7075     if {$selectedline eq {} || !$showneartags} return
7076     switch -- $tagphase {
7077         0 {
7078             set dtags [desctags $currentid]
7079             if {$dtags ne {}} {
7080                 appendrefs precedes $dtags idtags
7081             }
7082         }
7083         1 {
7084             set atags [anctags $currentid]
7085             if {$atags ne {}} {
7086                 appendrefs follows $atags idtags
7087             }
7088         }
7089         2 {
7090             set dheads [descheads $currentid]
7091             if {$dheads ne {}} {
7092                 if {[appendrefs branch $dheads idheads] > 1
7093                     && [$ctext get "branch -3c"] eq "h"} {
7094                     # turn "Branch" into "Branches"
7095                     $ctext conf -state normal
7096                     $ctext insert "branch -2c" "es"
7097                     $ctext conf -state disabled
7098                 }
7099             }
7100         }
7101     }
7102     if {[incr tagphase] <= 2} {
7103         after idle dispnexttag
7104     }
7105 }
7106
7107 proc make_secsel {id} {
7108     global linehtag linentag linedtag canv canv2 canv3
7109
7110     if {![info exists linehtag($id)]} return
7111     $canv delete secsel
7112     set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7113                -tags secsel -fill [$canv cget -selectbackground]]
7114     $canv lower $t
7115     $canv2 delete secsel
7116     set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7117                -tags secsel -fill [$canv2 cget -selectbackground]]
7118     $canv2 lower $t
7119     $canv3 delete secsel
7120     set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7121                -tags secsel -fill [$canv3 cget -selectbackground]]
7122     $canv3 lower $t
7123 }
7124
7125 proc make_idmark {id} {
7126     global linehtag canv fgcolor
7127
7128     if {![info exists linehtag($id)]} return
7129     $canv delete markid
7130     set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7131                -tags markid -outline $fgcolor]
7132     $canv raise $t
7133 }
7134
7135 proc selectline {l isnew {desired_loc {}}} {
7136     global canv ctext commitinfo selectedline
7137     global canvy0 linespc parents children curview
7138     global currentid sha1entry
7139     global commentend idtags linknum
7140     global mergemax numcommits pending_select
7141     global cmitmode showneartags allcommits
7142     global targetrow targetid lastscrollrows
7143     global autoselect autosellen jump_to_here
7144     global vinlinediff
7145
7146     catch {unset pending_select}
7147     $canv delete hover
7148     normalline
7149     unsel_reflist
7150     stopfinding
7151     if {$l < 0 || $l >= $numcommits} return
7152     set id [commitonrow $l]
7153     set targetid $id
7154     set targetrow $l
7155     set selectedline $l
7156     set currentid $id
7157     if {$lastscrollrows < $numcommits} {
7158         setcanvscroll
7159     }
7160
7161     set y [expr {$canvy0 + $l * $linespc}]
7162     set ymax [lindex [$canv cget -scrollregion] 3]
7163     set ytop [expr {$y - $linespc - 1}]
7164     set ybot [expr {$y + $linespc + 1}]
7165     set wnow [$canv yview]
7166     set wtop [expr {[lindex $wnow 0] * $ymax}]
7167     set wbot [expr {[lindex $wnow 1] * $ymax}]
7168     set wh [expr {$wbot - $wtop}]
7169     set newtop $wtop
7170     if {$ytop < $wtop} {
7171         if {$ybot < $wtop} {
7172             set newtop [expr {$y - $wh / 2.0}]
7173         } else {
7174             set newtop $ytop
7175             if {$newtop > $wtop - $linespc} {
7176                 set newtop [expr {$wtop - $linespc}]
7177             }
7178         }
7179     } elseif {$ybot > $wbot} {
7180         if {$ytop > $wbot} {
7181             set newtop [expr {$y - $wh / 2.0}]
7182         } else {
7183             set newtop [expr {$ybot - $wh}]
7184             if {$newtop < $wtop + $linespc} {
7185                 set newtop [expr {$wtop + $linespc}]
7186             }
7187         }
7188     }
7189     if {$newtop != $wtop} {
7190         if {$newtop < 0} {
7191             set newtop 0
7192         }
7193         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7194         drawvisible
7195     }
7196
7197     make_secsel $id
7198
7199     if {$isnew} {
7200         addtohistory [list selbyid $id 0] savecmitpos
7201     }
7202
7203     $sha1entry delete 0 end
7204     $sha1entry insert 0 $id
7205     if {$autoselect} {
7206         $sha1entry selection range 0 $autosellen
7207     }
7208     rhighlight_sel $id
7209
7210     $ctext conf -state normal
7211     clear_ctext
7212     set linknum 0
7213     if {![info exists commitinfo($id)]} {
7214         getcommit $id
7215     }
7216     set info $commitinfo($id)
7217     set date [formatdate [lindex $info 2]]
7218     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7219     set date [formatdate [lindex $info 4]]
7220     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7221     if {[info exists idtags($id)]} {
7222         $ctext insert end [mc "Tags:"]
7223         foreach tag $idtags($id) {
7224             $ctext insert end " $tag"
7225         }
7226         $ctext insert end "\n"
7227     }
7228
7229     set headers {}
7230     set olds $parents($curview,$id)
7231     if {[llength $olds] > 1} {
7232         set np 0
7233         foreach p $olds {
7234             if {$np >= $mergemax} {
7235                 set tag mmax
7236             } else {
7237                 set tag m$np
7238             }
7239             $ctext insert end "[mc "Parent"]: " $tag
7240             appendwithlinks [commit_descriptor $p] {}
7241             incr np
7242         }
7243     } else {
7244         foreach p $olds {
7245             append headers "[mc "Parent"]: [commit_descriptor $p]"
7246         }
7247     }
7248
7249     foreach c $children($curview,$id) {
7250         append headers "[mc "Child"]:  [commit_descriptor $c]"
7251     }
7252
7253     # make anything that looks like a SHA1 ID be a clickable link
7254     appendwithlinks $headers {}
7255     if {$showneartags} {
7256         if {![info exists allcommits]} {
7257             getallcommits
7258         }
7259         $ctext insert end "[mc "Branch"]: "
7260         $ctext mark set branch "end -1c"
7261         $ctext mark gravity branch left
7262         $ctext insert end "\n[mc "Follows"]: "
7263         $ctext mark set follows "end -1c"
7264         $ctext mark gravity follows left
7265         $ctext insert end "\n[mc "Precedes"]: "
7266         $ctext mark set precedes "end -1c"
7267         $ctext mark gravity precedes left
7268         $ctext insert end "\n"
7269         dispneartags 1
7270     }
7271     $ctext insert end "\n"
7272     set comment [lindex $info 5]
7273     if {[string first "\r" $comment] >= 0} {
7274         set comment [string map {"\r" "\n    "} $comment]
7275     }
7276     appendwithlinks $comment {comment}
7277
7278     $ctext tag remove found 1.0 end
7279     $ctext conf -state disabled
7280     set commentend [$ctext index "end - 1c"]
7281
7282     set jump_to_here $desired_loc
7283     init_flist [mc "Comments"]
7284     if {$cmitmode eq "tree"} {
7285         gettree $id
7286     } elseif {$vinlinediff($curview) == 1} {
7287         showinlinediff $id
7288     } elseif {[llength $olds] <= 1} {
7289         startdiff $id
7290     } else {
7291         mergediff $id
7292     }
7293 }
7294
7295 proc selfirstline {} {
7296     unmarkmatches
7297     selectline 0 1
7298 }
7299
7300 proc sellastline {} {
7301     global numcommits
7302     unmarkmatches
7303     set l [expr {$numcommits - 1}]
7304     selectline $l 1
7305 }
7306
7307 proc selnextline {dir} {
7308     global selectedline
7309     focus .
7310     if {$selectedline eq {}} return
7311     set l [expr {$selectedline + $dir}]
7312     unmarkmatches
7313     selectline $l 1
7314 }
7315
7316 proc selnextpage {dir} {
7317     global canv linespc selectedline numcommits
7318
7319     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7320     if {$lpp < 1} {
7321         set lpp 1
7322     }
7323     allcanvs yview scroll [expr {$dir * $lpp}] units
7324     drawvisible
7325     if {$selectedline eq {}} return
7326     set l [expr {$selectedline + $dir * $lpp}]
7327     if {$l < 0} {
7328         set l 0
7329     } elseif {$l >= $numcommits} {
7330         set l [expr $numcommits - 1]
7331     }
7332     unmarkmatches
7333     selectline $l 1
7334 }
7335
7336 proc unselectline {} {
7337     global selectedline currentid
7338
7339     set selectedline {}
7340     catch {unset currentid}
7341     allcanvs delete secsel
7342     rhighlight_none
7343 }
7344
7345 proc reselectline {} {
7346     global selectedline
7347
7348     if {$selectedline ne {}} {
7349         selectline $selectedline 0
7350     }
7351 }
7352
7353 proc addtohistory {cmd {saveproc {}}} {
7354     global history historyindex curview
7355
7356     unset_posvars
7357     save_position
7358     set elt [list $curview $cmd $saveproc {}]
7359     if {$historyindex > 0
7360         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7361         return
7362     }
7363
7364     if {$historyindex < [llength $history]} {
7365         set history [lreplace $history $historyindex end $elt]
7366     } else {
7367         lappend history $elt
7368     }
7369     incr historyindex
7370     if {$historyindex > 1} {
7371         .tf.bar.leftbut conf -state normal
7372     } else {
7373         .tf.bar.leftbut conf -state disabled
7374     }
7375     .tf.bar.rightbut conf -state disabled
7376 }
7377
7378 # save the scrolling position of the diff display pane
7379 proc save_position {} {
7380     global historyindex history
7381
7382     if {$historyindex < 1} return
7383     set hi [expr {$historyindex - 1}]
7384     set fn [lindex $history $hi 2]
7385     if {$fn ne {}} {
7386         lset history $hi 3 [eval $fn]
7387     }
7388 }
7389
7390 proc unset_posvars {} {
7391     global last_posvars
7392
7393     if {[info exists last_posvars]} {
7394         foreach {var val} $last_posvars {
7395             global $var
7396             catch {unset $var}
7397         }
7398         unset last_posvars
7399     }
7400 }
7401
7402 proc godo {elt} {
7403     global curview last_posvars
7404
7405     set view [lindex $elt 0]
7406     set cmd [lindex $elt 1]
7407     set pv [lindex $elt 3]
7408     if {$curview != $view} {
7409         showview $view
7410     }
7411     unset_posvars
7412     foreach {var val} $pv {
7413         global $var
7414         set $var $val
7415     }
7416     set last_posvars $pv
7417     eval $cmd
7418 }
7419
7420 proc goback {} {
7421     global history historyindex
7422     focus .
7423
7424     if {$historyindex > 1} {
7425         save_position
7426         incr historyindex -1
7427         godo [lindex $history [expr {$historyindex - 1}]]
7428         .tf.bar.rightbut conf -state normal
7429     }
7430     if {$historyindex <= 1} {
7431         .tf.bar.leftbut conf -state disabled
7432     }
7433 }
7434
7435 proc goforw {} {
7436     global history historyindex
7437     focus .
7438
7439     if {$historyindex < [llength $history]} {
7440         save_position
7441         set cmd [lindex $history $historyindex]
7442         incr historyindex
7443         godo $cmd
7444         .tf.bar.leftbut conf -state normal
7445     }
7446     if {$historyindex >= [llength $history]} {
7447         .tf.bar.rightbut conf -state disabled
7448     }
7449 }
7450
7451 proc gettree {id} {
7452     global treefilelist treeidlist diffids diffmergeid treepending
7453     global nullid nullid2
7454
7455     set diffids $id
7456     catch {unset diffmergeid}
7457     if {![info exists treefilelist($id)]} {
7458         if {![info exists treepending]} {
7459             if {$id eq $nullid} {
7460                 set cmd [list | git ls-files]
7461             } elseif {$id eq $nullid2} {
7462                 set cmd [list | git ls-files --stage -t]
7463             } else {
7464                 set cmd [list | git ls-tree -r $id]
7465             }
7466             if {[catch {set gtf [open $cmd r]}]} {
7467                 return
7468             }
7469             set treepending $id
7470             set treefilelist($id) {}
7471             set treeidlist($id) {}
7472             fconfigure $gtf -blocking 0 -encoding binary
7473             filerun $gtf [list gettreeline $gtf $id]
7474         }
7475     } else {
7476         setfilelist $id
7477     }
7478 }
7479
7480 proc gettreeline {gtf id} {
7481     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7482
7483     set nl 0
7484     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7485         if {$diffids eq $nullid} {
7486             set fname $line
7487         } else {
7488             set i [string first "\t" $line]
7489             if {$i < 0} continue
7490             set fname [string range $line [expr {$i+1}] end]
7491             set line [string range $line 0 [expr {$i-1}]]
7492             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7493             set sha1 [lindex $line 2]
7494             lappend treeidlist($id) $sha1
7495         }
7496         if {[string index $fname 0] eq "\""} {
7497             set fname [lindex $fname 0]
7498         }
7499         set fname [encoding convertfrom $fname]
7500         lappend treefilelist($id) $fname
7501     }
7502     if {![eof $gtf]} {
7503         return [expr {$nl >= 1000? 2: 1}]
7504     }
7505     close $gtf
7506     unset treepending
7507     if {$cmitmode ne "tree"} {
7508         if {![info exists diffmergeid]} {
7509             gettreediffs $diffids
7510         }
7511     } elseif {$id ne $diffids} {
7512         gettree $diffids
7513     } else {
7514         setfilelist $id
7515     }
7516     return 0
7517 }
7518
7519 proc showfile {f} {
7520     global treefilelist treeidlist diffids nullid nullid2
7521     global ctext_file_names ctext_file_lines
7522     global ctext commentend
7523
7524     set i [lsearch -exact $treefilelist($diffids) $f]
7525     if {$i < 0} {
7526         puts "oops, $f not in list for id $diffids"
7527         return
7528     }
7529     if {$diffids eq $nullid} {
7530         if {[catch {set bf [open $f r]} err]} {
7531             puts "oops, can't read $f: $err"
7532             return
7533         }
7534     } else {
7535         set blob [lindex $treeidlist($diffids) $i]
7536         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7537             puts "oops, error reading blob $blob: $err"
7538             return
7539         }
7540     }
7541     fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7542     filerun $bf [list getblobline $bf $diffids]
7543     $ctext config -state normal
7544     clear_ctext $commentend
7545     lappend ctext_file_names $f
7546     lappend ctext_file_lines [lindex [split $commentend "."] 0]
7547     $ctext insert end "\n"
7548     $ctext insert end "$f\n" filesep
7549     $ctext config -state disabled
7550     $ctext yview $commentend
7551     settabs 0
7552 }
7553
7554 proc getblobline {bf id} {
7555     global diffids cmitmode ctext
7556
7557     if {$id ne $diffids || $cmitmode ne "tree"} {
7558         catch {close $bf}
7559         return 0
7560     }
7561     $ctext config -state normal
7562     set nl 0
7563     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7564         $ctext insert end "$line\n"
7565     }
7566     if {[eof $bf]} {
7567         global jump_to_here ctext_file_names commentend
7568
7569         # delete last newline
7570         $ctext delete "end - 2c" "end - 1c"
7571         close $bf
7572         if {$jump_to_here ne {} &&
7573             [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7574             set lnum [expr {[lindex $jump_to_here 1] +
7575                             [lindex [split $commentend .] 0]}]
7576             mark_ctext_line $lnum
7577         }
7578         $ctext config -state disabled
7579         return 0
7580     }
7581     $ctext config -state disabled
7582     return [expr {$nl >= 1000? 2: 1}]
7583 }
7584
7585 proc mark_ctext_line {lnum} {
7586     global ctext markbgcolor
7587
7588     $ctext tag delete omark
7589     $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7590     $ctext tag conf omark -background $markbgcolor
7591     $ctext see $lnum.0
7592 }
7593
7594 proc mergediff {id} {
7595     global diffmergeid
7596     global diffids treediffs
7597     global parents curview
7598
7599     set diffmergeid $id
7600     set diffids $id
7601     set treediffs($id) {}
7602     set np [llength $parents($curview,$id)]
7603     settabs $np
7604     getblobdiffs $id
7605 }
7606
7607 proc startdiff {ids} {
7608     global treediffs diffids treepending diffmergeid nullid nullid2
7609
7610     settabs 1
7611     set diffids $ids
7612     catch {unset diffmergeid}
7613     if {![info exists treediffs($ids)] ||
7614         [lsearch -exact $ids $nullid] >= 0 ||
7615         [lsearch -exact $ids $nullid2] >= 0} {
7616         if {![info exists treepending]} {
7617             gettreediffs $ids
7618         }
7619     } else {
7620         addtocflist $ids
7621     }
7622 }
7623
7624 proc showinlinediff {ids} {
7625     global commitinfo commitdata ctext
7626     global treediffs
7627
7628     set info $commitinfo($ids)
7629     set diff [lindex $info 7]
7630     set difflines [split $diff "\n"]
7631
7632     initblobdiffvars
7633     set treediff {}
7634
7635     set inhdr 0
7636     foreach line $difflines {
7637         if {![string compare -length 5 "diff " $line]} {
7638             set inhdr 1
7639         } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7640             # offset also accounts for the b/ prefix
7641             lappend treediff [string range $line 6 end]
7642             set inhdr 0
7643         }
7644     }
7645
7646     set treediffs($ids) $treediff
7647     add_flist $treediff
7648
7649     $ctext conf -state normal
7650     foreach line $difflines {
7651         parseblobdiffline $ids $line
7652     }
7653     maybe_scroll_ctext 1
7654     $ctext conf -state disabled
7655 }
7656
7657 # If the filename (name) is under any of the passed filter paths
7658 # then return true to include the file in the listing.
7659 proc path_filter {filter name} {
7660     set worktree [gitworktree]
7661     foreach p $filter {
7662         set fq_p [file normalize $p]
7663         set fq_n [file normalize [file join $worktree $name]]
7664         if {[string match [file normalize $fq_p]* $fq_n]} {
7665             return 1
7666         }
7667     }
7668     return 0
7669 }
7670
7671 proc addtocflist {ids} {
7672     global treediffs
7673
7674     add_flist $treediffs($ids)
7675     getblobdiffs $ids
7676 }
7677
7678 proc diffcmd {ids flags} {
7679     global log_showroot nullid nullid2
7680
7681     set i [lsearch -exact $ids $nullid]
7682     set j [lsearch -exact $ids $nullid2]
7683     if {$i >= 0} {
7684         if {[llength $ids] > 1 && $j < 0} {
7685             # comparing working directory with some specific revision
7686             set cmd [concat | git diff-index $flags]
7687             if {$i == 0} {
7688                 lappend cmd -R [lindex $ids 1]
7689             } else {
7690                 lappend cmd [lindex $ids 0]
7691             }
7692         } else {
7693             # comparing working directory with index
7694             set cmd [concat | git diff-files $flags]
7695             if {$j == 1} {
7696                 lappend cmd -R
7697             }
7698         }
7699     } elseif {$j >= 0} {
7700         set cmd [concat | git diff-index --cached $flags]
7701         if {[llength $ids] > 1} {
7702             # comparing index with specific revision
7703             if {$j == 0} {
7704                 lappend cmd -R [lindex $ids 1]
7705             } else {
7706                 lappend cmd [lindex $ids 0]
7707             }
7708         } else {
7709             # comparing index with HEAD
7710             lappend cmd HEAD
7711         }
7712     } else {
7713         if {$log_showroot} {
7714             lappend flags --root
7715         }
7716         set cmd [concat | git diff-tree -r $flags $ids]
7717     }
7718     return $cmd
7719 }
7720
7721 proc gettreediffs {ids} {
7722     global treediff treepending limitdiffs vfilelimit curview
7723
7724     set cmd [diffcmd $ids {--no-commit-id}]
7725     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7726             set cmd [concat $cmd -- $vfilelimit($curview)]
7727     }
7728     if {[catch {set gdtf [open $cmd r]}]} return
7729
7730     set treepending $ids
7731     set treediff {}
7732     fconfigure $gdtf -blocking 0 -encoding binary
7733     filerun $gdtf [list gettreediffline $gdtf $ids]
7734 }
7735
7736 proc gettreediffline {gdtf ids} {
7737     global treediff treediffs treepending diffids diffmergeid
7738     global cmitmode vfilelimit curview limitdiffs perfile_attrs
7739
7740     set nr 0
7741     set sublist {}
7742     set max 1000
7743     if {$perfile_attrs} {
7744         # cache_gitattr is slow, and even slower on win32 where we
7745         # have to invoke it for only about 30 paths at a time
7746         set max 500
7747         if {[tk windowingsystem] == "win32"} {
7748             set max 120
7749         }
7750     }
7751     while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7752         set i [string first "\t" $line]
7753         if {$i >= 0} {
7754             set file [string range $line [expr {$i+1}] end]
7755             if {[string index $file 0] eq "\""} {
7756                 set file [lindex $file 0]
7757             }
7758             set file [encoding convertfrom $file]
7759             if {$file ne [lindex $treediff end]} {
7760                 lappend treediff $file
7761                 lappend sublist $file
7762             }
7763         }
7764     }
7765     if {$perfile_attrs} {
7766         cache_gitattr encoding $sublist
7767     }
7768     if {![eof $gdtf]} {
7769         return [expr {$nr >= $max? 2: 1}]
7770     }
7771     close $gdtf
7772     set treediffs($ids) $treediff
7773     unset treepending
7774     if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7775         gettree $diffids
7776     } elseif {$ids != $diffids} {
7777         if {![info exists diffmergeid]} {
7778             gettreediffs $diffids
7779         }
7780     } else {
7781         addtocflist $ids
7782     }
7783     return 0
7784 }
7785
7786 # empty string or positive integer
7787 proc diffcontextvalidate {v} {
7788     return [regexp {^(|[1-9][0-9]*)$} $v]
7789 }
7790
7791 proc diffcontextchange {n1 n2 op} {
7792     global diffcontextstring diffcontext
7793
7794     if {[string is integer -strict $diffcontextstring]} {
7795         if {$diffcontextstring >= 0} {
7796             set diffcontext $diffcontextstring
7797             reselectline
7798         }
7799     }
7800 }
7801
7802 proc changeignorespace {} {
7803     reselectline
7804 }
7805
7806 proc changeworddiff {name ix op} {
7807     reselectline
7808 }
7809
7810 proc initblobdiffvars {} {
7811     global diffencoding targetline diffnparents
7812     global diffinhdr currdiffsubmod diffseehere
7813     set targetline {}
7814     set diffnparents 0
7815     set diffinhdr 0
7816     set diffencoding [get_path_encoding {}]
7817     set currdiffsubmod ""
7818     set diffseehere -1
7819 }
7820
7821 proc getblobdiffs {ids} {
7822     global blobdifffd diffids env
7823     global treediffs
7824     global diffcontext
7825     global ignorespace
7826     global worddiff
7827     global limitdiffs vfilelimit curview
7828     global git_version
7829
7830     set textconv {}
7831     if {[package vcompare $git_version "1.6.1"] >= 0} {
7832         set textconv "--textconv"
7833     }
7834     set submodule {}
7835     if {[package vcompare $git_version "1.6.6"] >= 0} {
7836         set submodule "--submodule"
7837     }
7838     set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7839     if {$ignorespace} {
7840         append cmd " -w"
7841     }
7842     if {$worddiff ne [mc "Line diff"]} {
7843         append cmd " --word-diff=porcelain"
7844     }
7845     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7846         set cmd [concat $cmd -- $vfilelimit($curview)]
7847     }
7848     if {[catch {set bdf [open $cmd r]} err]} {
7849         error_popup [mc "Error getting diffs: %s" $err]
7850         return
7851     }
7852     fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7853     set blobdifffd($ids) $bdf
7854     initblobdiffvars
7855     filerun $bdf [list getblobdiffline $bdf $diffids]
7856 }
7857
7858 proc savecmitpos {} {
7859     global ctext cmitmode
7860
7861     if {$cmitmode eq "tree"} {
7862         return {}
7863     }
7864     return [list target_scrollpos [$ctext index @0,0]]
7865 }
7866
7867 proc savectextpos {} {
7868     global ctext
7869
7870     return [list target_scrollpos [$ctext index @0,0]]
7871 }
7872
7873 proc maybe_scroll_ctext {ateof} {
7874     global ctext target_scrollpos
7875
7876     if {![info exists target_scrollpos]} return
7877     if {!$ateof} {
7878         set nlines [expr {[winfo height $ctext]
7879                           / [font metrics textfont -linespace]}]
7880         if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7881     }
7882     $ctext yview $target_scrollpos
7883     unset target_scrollpos
7884 }
7885
7886 proc setinlist {var i val} {
7887     global $var
7888
7889     while {[llength [set $var]] < $i} {
7890         lappend $var {}
7891     }
7892     if {[llength [set $var]] == $i} {
7893         lappend $var $val
7894     } else {
7895         lset $var $i $val
7896     }
7897 }
7898
7899 proc makediffhdr {fname ids} {
7900     global ctext curdiffstart treediffs diffencoding
7901     global ctext_file_names jump_to_here targetline diffline
7902
7903     set fname [encoding convertfrom $fname]
7904     set diffencoding [get_path_encoding $fname]
7905     set i [lsearch -exact $treediffs($ids) $fname]
7906     if {$i >= 0} {
7907         setinlist difffilestart $i $curdiffstart
7908     }
7909     lset ctext_file_names end $fname
7910     set l [expr {(78 - [string length $fname]) / 2}]
7911     set pad [string range "----------------------------------------" 1 $l]
7912     $ctext insert $curdiffstart "$pad $fname $pad" filesep
7913     set targetline {}
7914     if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7915         set targetline [lindex $jump_to_here 1]
7916     }
7917     set diffline 0
7918 }
7919
7920 proc blobdiffmaybeseehere {ateof} {
7921     global diffseehere
7922     if {$diffseehere >= 0} {
7923         mark_ctext_line [lindex [split $diffseehere .] 0]
7924     }
7925     maybe_scroll_ctext ateof
7926 }
7927
7928 proc getblobdiffline {bdf ids} {
7929     global diffids blobdifffd
7930     global ctext
7931
7932     set nr 0
7933     $ctext conf -state normal
7934     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7935         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7936             catch {close $bdf}
7937             return 0
7938         }
7939         parseblobdiffline $ids $line
7940     }
7941     $ctext conf -state disabled
7942     blobdiffmaybeseehere [eof $bdf]
7943     if {[eof $bdf]} {
7944         catch {close $bdf}
7945         return 0
7946     }
7947     return [expr {$nr >= 1000? 2: 1}]
7948 }
7949
7950 proc parseblobdiffline {ids line} {
7951     global ctext curdiffstart
7952     global diffnexthead diffnextnote difffilestart
7953     global ctext_file_names ctext_file_lines
7954     global diffinhdr treediffs mergemax diffnparents
7955     global diffencoding jump_to_here targetline diffline currdiffsubmod
7956     global worddiff diffseehere
7957
7958     if {![string compare -length 5 "diff " $line]} {
7959         if {![regexp {^diff (--cc|--git) } $line m type]} {
7960             set line [encoding convertfrom $line]
7961             $ctext insert end "$line\n" hunksep
7962             continue
7963         }
7964         # start of a new file
7965         set diffinhdr 1
7966         $ctext insert end "\n"
7967         set curdiffstart [$ctext index "end - 1c"]
7968         lappend ctext_file_names ""
7969         lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7970         $ctext insert end "\n" filesep
7971
7972         if {$type eq "--cc"} {
7973             # start of a new file in a merge diff
7974             set fname [string range $line 10 end]
7975             if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7976                 lappend treediffs($ids) $fname
7977                 add_flist [list $fname]
7978             }
7979
7980         } else {
7981             set line [string range $line 11 end]
7982             # If the name hasn't changed the length will be odd,
7983             # the middle char will be a space, and the two bits either
7984             # side will be a/name and b/name, or "a/name" and "b/name".
7985             # If the name has changed we'll get "rename from" and
7986             # "rename to" or "copy from" and "copy to" lines following
7987             # this, and we'll use them to get the filenames.
7988             # This complexity is necessary because spaces in the
7989             # filename(s) don't get escaped.
7990             set l [string length $line]
7991             set i [expr {$l / 2}]
7992             if {!(($l & 1) && [string index $line $i] eq " " &&
7993                   [string range $line 2 [expr {$i - 1}]] eq \
7994                       [string range $line [expr {$i + 3}] end])} {
7995                 return
7996             }
7997             # unescape if quoted and chop off the a/ from the front
7998             if {[string index $line 0] eq "\""} {
7999                 set fname [string range [lindex $line 0] 2 end]
8000             } else {
8001                 set fname [string range $line 2 [expr {$i - 1}]]
8002             }
8003         }
8004         makediffhdr $fname $ids
8005
8006     } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8007         set fname [encoding convertfrom [string range $line 16 end]]
8008         $ctext insert end "\n"
8009         set curdiffstart [$ctext index "end - 1c"]
8010         lappend ctext_file_names $fname
8011         lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8012         $ctext insert end "$line\n" filesep
8013         set i [lsearch -exact $treediffs($ids) $fname]
8014         if {$i >= 0} {
8015             setinlist difffilestart $i $curdiffstart
8016         }
8017
8018     } elseif {![string compare -length 2 "@@" $line]} {
8019         regexp {^@@+} $line ats
8020         set line [encoding convertfrom $diffencoding $line]
8021         $ctext insert end "$line\n" hunksep
8022         if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8023             set diffline $nl
8024         }
8025         set diffnparents [expr {[string length $ats] - 1}]
8026         set diffinhdr 0
8027
8028     } elseif {![string compare -length 10 "Submodule " $line]} {
8029         # start of a new submodule
8030         if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8031             set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8032         } else {
8033             set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8034         }
8035         if {$currdiffsubmod != $fname} {
8036             $ctext insert end "\n";     # Add newline after commit message
8037         }
8038         set curdiffstart [$ctext index "end - 1c"]
8039         lappend ctext_file_names ""
8040         if {$currdiffsubmod != $fname} {
8041             lappend ctext_file_lines $fname
8042             makediffhdr $fname $ids
8043             set currdiffsubmod $fname
8044             $ctext insert end "\n$line\n" filesep
8045         } else {
8046             $ctext insert end "$line\n" filesep
8047         }
8048     } elseif {![string compare -length 3 "  >" $line]} {
8049         set $currdiffsubmod ""
8050         set line [encoding convertfrom $diffencoding $line]
8051         $ctext insert end "$line\n" dresult
8052     } elseif {![string compare -length 3 "  <" $line]} {
8053         set $currdiffsubmod ""
8054         set line [encoding convertfrom $diffencoding $line]
8055         $ctext insert end "$line\n" d0
8056     } elseif {$diffinhdr} {
8057         if {![string compare -length 12 "rename from " $line]} {
8058             set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8059             if {[string index $fname 0] eq "\""} {
8060                 set fname [lindex $fname 0]
8061             }
8062             set fname [encoding convertfrom $fname]
8063             set i [lsearch -exact $treediffs($ids) $fname]
8064             if {$i >= 0} {
8065                 setinlist difffilestart $i $curdiffstart
8066             }
8067         } elseif {![string compare -length 10 $line "rename to "] ||
8068                   ![string compare -length 8 $line "copy to "]} {
8069             set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8070             if {[string index $fname 0] eq "\""} {
8071                 set fname [lindex $fname 0]
8072             }
8073             makediffhdr $fname $ids
8074         } elseif {[string compare -length 3 $line "---"] == 0} {
8075             # do nothing
8076             return
8077         } elseif {[string compare -length 3 $line "+++"] == 0} {
8078             set diffinhdr 0
8079             return
8080         }
8081         $ctext insert end "$line\n" filesep
8082
8083     } else {
8084         set line [string map {\x1A ^Z} \
8085                       [encoding convertfrom $diffencoding $line]]
8086         # parse the prefix - one ' ', '-' or '+' for each parent
8087         set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8088         set tag [expr {$diffnparents > 1? "m": "d"}]
8089         set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8090         set words_pre_markup ""
8091         set words_post_markup ""
8092         if {[string trim $prefix " -+"] eq {}} {
8093             # prefix only has " ", "-" and "+" in it: normal diff line
8094             set num [string first "-" $prefix]
8095             if {$dowords} {
8096                 set line [string range $line 1 end]
8097             }
8098             if {$num >= 0} {
8099                 # removed line, first parent with line is $num
8100                 if {$num >= $mergemax} {
8101                     set num "max"
8102                 }
8103                 if {$dowords && $worddiff eq [mc "Markup words"]} {
8104                     $ctext insert end "\[-$line-\]" $tag$num
8105                 } else {
8106                     $ctext insert end "$line" $tag$num
8107                 }
8108                 if {!$dowords} {
8109                     $ctext insert end "\n" $tag$num
8110                 }
8111             } else {
8112                 set tags {}
8113                 if {[string first "+" $prefix] >= 0} {
8114                     # added line
8115                     lappend tags ${tag}result
8116                     if {$diffnparents > 1} {
8117                         set num [string first " " $prefix]
8118                         if {$num >= 0} {
8119                             if {$num >= $mergemax} {
8120                                 set num "max"
8121                             }
8122                             lappend tags m$num
8123                         }
8124                     }
8125                     set words_pre_markup "{+"
8126                     set words_post_markup "+}"
8127                 }
8128                 if {$targetline ne {}} {
8129                     if {$diffline == $targetline} {
8130                         set diffseehere [$ctext index "end - 1 chars"]
8131                         set targetline {}
8132                     } else {
8133                         incr diffline
8134                     }
8135                 }
8136                 if {$dowords && $worddiff eq [mc "Markup words"]} {
8137                     $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8138                 } else {
8139                     $ctext insert end "$line" $tags
8140                 }
8141                 if {!$dowords} {
8142                     $ctext insert end "\n" $tags
8143                 }
8144             }
8145         } elseif {$dowords && $prefix eq "~"} {
8146             $ctext insert end "\n" {}
8147         } else {
8148             # "\ No newline at end of file",
8149             # or something else we don't recognize
8150             $ctext insert end "$line\n" hunksep
8151         }
8152     }
8153 }
8154
8155 proc changediffdisp {} {
8156     global ctext diffelide
8157
8158     $ctext tag conf d0 -elide [lindex $diffelide 0]
8159     $ctext tag conf dresult -elide [lindex $diffelide 1]
8160 }
8161
8162 proc highlightfile {cline} {
8163     global cflist cflist_top
8164
8165     if {![info exists cflist_top]} return
8166
8167     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8168     $cflist tag add highlight $cline.0 "$cline.0 lineend"
8169     $cflist see $cline.0
8170     set cflist_top $cline
8171 }
8172
8173 proc highlightfile_for_scrollpos {topidx} {
8174     global cmitmode difffilestart
8175
8176     if {$cmitmode eq "tree"} return
8177     if {![info exists difffilestart]} return
8178
8179     set top [lindex [split $topidx .] 0]
8180     if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8181         highlightfile 0
8182     } else {
8183         highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8184     }
8185 }
8186
8187 proc prevfile {} {
8188     global difffilestart ctext cmitmode
8189
8190     if {$cmitmode eq "tree"} return
8191     set prev 0.0
8192     set here [$ctext index @0,0]
8193     foreach loc $difffilestart {
8194         if {[$ctext compare $loc >= $here]} {
8195             $ctext yview $prev
8196             return
8197         }
8198         set prev $loc
8199     }
8200     $ctext yview $prev
8201 }
8202
8203 proc nextfile {} {
8204     global difffilestart ctext cmitmode
8205
8206     if {$cmitmode eq "tree"} return
8207     set here [$ctext index @0,0]
8208     foreach loc $difffilestart {
8209         if {[$ctext compare $loc > $here]} {
8210             $ctext yview $loc
8211             return
8212         }
8213     }
8214 }
8215
8216 proc clear_ctext {{first 1.0}} {
8217     global ctext smarktop smarkbot
8218     global ctext_file_names ctext_file_lines
8219     global pendinglinks
8220
8221     set l [lindex [split $first .] 0]
8222     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8223         set smarktop $l
8224     }
8225     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8226         set smarkbot $l
8227     }
8228     $ctext delete $first end
8229     if {$first eq "1.0"} {
8230         catch {unset pendinglinks}
8231     }
8232     set ctext_file_names {}
8233     set ctext_file_lines {}
8234 }
8235
8236 proc settabs {{firstab {}}} {
8237     global firsttabstop tabstop ctext have_tk85
8238
8239     if {$firstab ne {} && $have_tk85} {
8240         set firsttabstop $firstab
8241     }
8242     set w [font measure textfont "0"]
8243     if {$firsttabstop != 0} {
8244         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8245                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8246     } elseif {$have_tk85 || $tabstop != 8} {
8247         $ctext conf -tabs [expr {$tabstop * $w}]
8248     } else {
8249         $ctext conf -tabs {}
8250     }
8251 }
8252
8253 proc incrsearch {name ix op} {
8254     global ctext searchstring searchdirn
8255
8256     if {[catch {$ctext index anchor}]} {
8257         # no anchor set, use start of selection, or of visible area
8258         set sel [$ctext tag ranges sel]
8259         if {$sel ne {}} {
8260             $ctext mark set anchor [lindex $sel 0]
8261         } elseif {$searchdirn eq "-forwards"} {
8262             $ctext mark set anchor @0,0
8263         } else {
8264             $ctext mark set anchor @0,[winfo height $ctext]
8265         }
8266     }
8267     if {$searchstring ne {}} {
8268         set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8269         if {$here ne {}} {
8270             $ctext see $here
8271             set mend "$here + $mlen c"
8272             $ctext tag remove sel 1.0 end
8273             $ctext tag add sel $here $mend
8274             suppress_highlighting_file_for_current_scrollpos
8275             highlightfile_for_scrollpos $here
8276         }
8277     }
8278     rehighlight_search_results
8279 }
8280
8281 proc dosearch {} {
8282     global sstring ctext searchstring searchdirn
8283
8284     focus $sstring
8285     $sstring icursor end
8286     set searchdirn -forwards
8287     if {$searchstring ne {}} {
8288         set sel [$ctext tag ranges sel]
8289         if {$sel ne {}} {
8290             set start "[lindex $sel 0] + 1c"
8291         } elseif {[catch {set start [$ctext index anchor]}]} {
8292             set start "@0,0"
8293         }
8294         set match [$ctext search -count mlen -- $searchstring $start]
8295         $ctext tag remove sel 1.0 end
8296         if {$match eq {}} {
8297             bell
8298             return
8299         }
8300         $ctext see $match
8301         suppress_highlighting_file_for_current_scrollpos
8302         highlightfile_for_scrollpos $match
8303         set mend "$match + $mlen c"
8304         $ctext tag add sel $match $mend
8305         $ctext mark unset anchor
8306         rehighlight_search_results
8307     }
8308 }
8309
8310 proc dosearchback {} {
8311     global sstring ctext searchstring searchdirn
8312
8313     focus $sstring
8314     $sstring icursor end
8315     set searchdirn -backwards
8316     if {$searchstring ne {}} {
8317         set sel [$ctext tag ranges sel]
8318         if {$sel ne {}} {
8319             set start [lindex $sel 0]
8320         } elseif {[catch {set start [$ctext index anchor]}]} {
8321             set start @0,[winfo height $ctext]
8322         }
8323         set match [$ctext search -backwards -count ml -- $searchstring $start]
8324         $ctext tag remove sel 1.0 end
8325         if {$match eq {}} {
8326             bell
8327             return
8328         }
8329         $ctext see $match
8330         suppress_highlighting_file_for_current_scrollpos
8331         highlightfile_for_scrollpos $match
8332         set mend "$match + $ml c"
8333         $ctext tag add sel $match $mend
8334         $ctext mark unset anchor
8335         rehighlight_search_results
8336     }
8337 }
8338
8339 proc rehighlight_search_results {} {
8340     global ctext searchstring
8341
8342     $ctext tag remove found 1.0 end
8343     $ctext tag remove currentsearchhit 1.0 end
8344
8345     if {$searchstring ne {}} {
8346         searchmarkvisible 1
8347     }
8348 }
8349
8350 proc searchmark {first last} {
8351     global ctext searchstring
8352
8353     set sel [$ctext tag ranges sel]
8354
8355     set mend $first.0
8356     while {1} {
8357         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8358         if {$match eq {}} break
8359         set mend "$match + $mlen c"
8360         if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8361             $ctext tag add currentsearchhit $match $mend
8362         } else {
8363             $ctext tag add found $match $mend
8364         }
8365     }
8366 }
8367
8368 proc searchmarkvisible {doall} {
8369     global ctext smarktop smarkbot
8370
8371     set topline [lindex [split [$ctext index @0,0] .] 0]
8372     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8373     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8374         # no overlap with previous
8375         searchmark $topline $botline
8376         set smarktop $topline
8377         set smarkbot $botline
8378     } else {
8379         if {$topline < $smarktop} {
8380             searchmark $topline [expr {$smarktop-1}]
8381             set smarktop $topline
8382         }
8383         if {$botline > $smarkbot} {
8384             searchmark [expr {$smarkbot+1}] $botline
8385             set smarkbot $botline
8386         }
8387     }
8388 }
8389
8390 proc suppress_highlighting_file_for_current_scrollpos {} {
8391     global ctext suppress_highlighting_file_for_this_scrollpos
8392
8393     set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8394 }
8395
8396 proc scrolltext {f0 f1} {
8397     global searchstring cmitmode ctext
8398     global suppress_highlighting_file_for_this_scrollpos
8399
8400     set topidx [$ctext index @0,0]
8401     if {![info exists suppress_highlighting_file_for_this_scrollpos]
8402         || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8403         highlightfile_for_scrollpos $topidx
8404     }
8405
8406     catch {unset suppress_highlighting_file_for_this_scrollpos}
8407
8408     .bleft.bottom.sb set $f0 $f1
8409     if {$searchstring ne {}} {
8410         searchmarkvisible 0
8411     }
8412 }
8413
8414 proc setcoords {} {
8415     global linespc charspc canvx0 canvy0
8416     global xspc1 xspc2 lthickness
8417
8418     set linespc [font metrics mainfont -linespace]
8419     set charspc [font measure mainfont "m"]
8420     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8421     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8422     set lthickness [expr {int($linespc / 9) + 1}]
8423     set xspc1(0) $linespc
8424     set xspc2 $linespc
8425 }
8426
8427 proc redisplay {} {
8428     global canv
8429     global selectedline
8430
8431     set ymax [lindex [$canv cget -scrollregion] 3]
8432     if {$ymax eq {} || $ymax == 0} return
8433     set span [$canv yview]
8434     clear_display
8435     setcanvscroll
8436     allcanvs yview moveto [lindex $span 0]
8437     drawvisible
8438     if {$selectedline ne {}} {
8439         selectline $selectedline 0
8440         allcanvs yview moveto [lindex $span 0]
8441     }
8442 }
8443
8444 proc parsefont {f n} {
8445     global fontattr
8446
8447     set fontattr($f,family) [lindex $n 0]
8448     set s [lindex $n 1]
8449     if {$s eq {} || $s == 0} {
8450         set s 10
8451     } elseif {$s < 0} {
8452         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8453     }
8454     set fontattr($f,size) $s
8455     set fontattr($f,weight) normal
8456     set fontattr($f,slant) roman
8457     foreach style [lrange $n 2 end] {
8458         switch -- $style {
8459             "normal" -
8460             "bold"   {set fontattr($f,weight) $style}
8461             "roman" -
8462             "italic" {set fontattr($f,slant) $style}
8463         }
8464     }
8465 }
8466
8467 proc fontflags {f {isbold 0}} {
8468     global fontattr
8469
8470     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8471                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8472                 -slant $fontattr($f,slant)]
8473 }
8474
8475 proc fontname {f} {
8476     global fontattr
8477
8478     set n [list $fontattr($f,family) $fontattr($f,size)]
8479     if {$fontattr($f,weight) eq "bold"} {
8480         lappend n "bold"
8481     }
8482     if {$fontattr($f,slant) eq "italic"} {
8483         lappend n "italic"
8484     }
8485     return $n
8486 }
8487
8488 proc incrfont {inc} {
8489     global mainfont textfont ctext canv cflist showrefstop
8490     global stopped entries fontattr
8491
8492     unmarkmatches
8493     set s $fontattr(mainfont,size)
8494     incr s $inc
8495     if {$s < 1} {
8496         set s 1
8497     }
8498     set fontattr(mainfont,size) $s
8499     font config mainfont -size $s
8500     font config mainfontbold -size $s
8501     set mainfont [fontname mainfont]
8502     set s $fontattr(textfont,size)
8503     incr s $inc
8504     if {$s < 1} {
8505         set s 1
8506     }
8507     set fontattr(textfont,size) $s
8508     font config textfont -size $s
8509     font config textfontbold -size $s
8510     set textfont [fontname textfont]
8511     setcoords
8512     settabs
8513     redisplay
8514 }
8515
8516 proc clearsha1 {} {
8517     global sha1entry sha1string
8518     if {[string length $sha1string] == 40} {
8519         $sha1entry delete 0 end
8520     }
8521 }
8522
8523 proc sha1change {n1 n2 op} {
8524     global sha1string currentid sha1but
8525     if {$sha1string == {}
8526         || ([info exists currentid] && $sha1string == $currentid)} {
8527         set state disabled
8528     } else {
8529         set state normal
8530     }
8531     if {[$sha1but cget -state] == $state} return
8532     if {$state == "normal"} {
8533         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8534     } else {
8535         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8536     }
8537 }
8538
8539 proc gotocommit {} {
8540     global sha1string tagids headids curview varcid
8541
8542     if {$sha1string == {}
8543         || ([info exists currentid] && $sha1string == $currentid)} return
8544     if {[info exists tagids($sha1string)]} {
8545         set id $tagids($sha1string)
8546     } elseif {[info exists headids($sha1string)]} {
8547         set id $headids($sha1string)
8548     } else {
8549         set id [string tolower $sha1string]
8550         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8551             set matches [longid $id]
8552             if {$matches ne {}} {
8553                 if {[llength $matches] > 1} {
8554                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8555                     return
8556                 }
8557                 set id [lindex $matches 0]
8558             }
8559         } else {
8560             if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8561                 error_popup [mc "Revision %s is not known" $sha1string]
8562                 return
8563             }
8564         }
8565     }
8566     if {[commitinview $id $curview]} {
8567         selectline [rowofcommit $id] 1
8568         return
8569     }
8570     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8571         set msg [mc "SHA1 id %s is not known" $sha1string]
8572     } else {
8573         set msg [mc "Revision %s is not in the current view" $sha1string]
8574     }
8575     error_popup $msg
8576 }
8577
8578 proc lineenter {x y id} {
8579     global hoverx hovery hoverid hovertimer
8580     global commitinfo canv
8581
8582     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8583     set hoverx $x
8584     set hovery $y
8585     set hoverid $id
8586     if {[info exists hovertimer]} {
8587         after cancel $hovertimer
8588     }
8589     set hovertimer [after 500 linehover]
8590     $canv delete hover
8591 }
8592
8593 proc linemotion {x y id} {
8594     global hoverx hovery hoverid hovertimer
8595
8596     if {[info exists hoverid] && $id == $hoverid} {
8597         set hoverx $x
8598         set hovery $y
8599         if {[info exists hovertimer]} {
8600             after cancel $hovertimer
8601         }
8602         set hovertimer [after 500 linehover]
8603     }
8604 }
8605
8606 proc lineleave {id} {
8607     global hoverid hovertimer canv
8608
8609     if {[info exists hoverid] && $id == $hoverid} {
8610         $canv delete hover
8611         if {[info exists hovertimer]} {
8612             after cancel $hovertimer
8613             unset hovertimer
8614         }
8615         unset hoverid
8616     }
8617 }
8618
8619 proc linehover {} {
8620     global hoverx hovery hoverid hovertimer
8621     global canv linespc lthickness
8622     global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8623
8624     global commitinfo
8625
8626     set text [lindex $commitinfo($hoverid) 0]
8627     set ymax [lindex [$canv cget -scrollregion] 3]
8628     if {$ymax == {}} return
8629     set yfrac [lindex [$canv yview] 0]
8630     set x [expr {$hoverx + 2 * $linespc}]
8631     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8632     set x0 [expr {$x - 2 * $lthickness}]
8633     set y0 [expr {$y - 2 * $lthickness}]
8634     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8635     set y1 [expr {$y + $linespc + 2 * $lthickness}]
8636     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8637                -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8638                -width 1 -tags hover]
8639     $canv raise $t
8640     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8641                -font mainfont -fill $linehoverfgcolor]
8642     $canv raise $t
8643 }
8644
8645 proc clickisonarrow {id y} {
8646     global lthickness
8647
8648     set ranges [rowranges $id]
8649     set thresh [expr {2 * $lthickness + 6}]
8650     set n [expr {[llength $ranges] - 1}]
8651     for {set i 1} {$i < $n} {incr i} {
8652         set row [lindex $ranges $i]
8653         if {abs([yc $row] - $y) < $thresh} {
8654             return $i
8655         }
8656     }
8657     return {}
8658 }
8659
8660 proc arrowjump {id n y} {
8661     global canv
8662
8663     # 1 <-> 2, 3 <-> 4, etc...
8664     set n [expr {(($n - 1) ^ 1) + 1}]
8665     set row [lindex [rowranges $id] $n]
8666     set yt [yc $row]
8667     set ymax [lindex [$canv cget -scrollregion] 3]
8668     if {$ymax eq {} || $ymax <= 0} return
8669     set view [$canv yview]
8670     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8671     set yfrac [expr {$yt / $ymax - $yspan / 2}]
8672     if {$yfrac < 0} {
8673         set yfrac 0
8674     }
8675     allcanvs yview moveto $yfrac
8676 }
8677
8678 proc lineclick {x y id isnew} {
8679     global ctext commitinfo children canv thickerline curview
8680
8681     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8682     unmarkmatches
8683     unselectline
8684     normalline
8685     $canv delete hover
8686     # draw this line thicker than normal
8687     set thickerline $id
8688     drawlines $id
8689     if {$isnew} {
8690         set ymax [lindex [$canv cget -scrollregion] 3]
8691         if {$ymax eq {}} return
8692         set yfrac [lindex [$canv yview] 0]
8693         set y [expr {$y + $yfrac * $ymax}]
8694     }
8695     set dirn [clickisonarrow $id $y]
8696     if {$dirn ne {}} {
8697         arrowjump $id $dirn $y
8698         return
8699     }
8700
8701     if {$isnew} {
8702         addtohistory [list lineclick $x $y $id 0] savectextpos
8703     }
8704     # fill the details pane with info about this line
8705     $ctext conf -state normal
8706     clear_ctext
8707     settabs 0
8708     $ctext insert end "[mc "Parent"]:\t"
8709     $ctext insert end $id link0
8710     setlink $id link0
8711     set info $commitinfo($id)
8712     $ctext insert end "\n\t[lindex $info 0]\n"
8713     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8714     set date [formatdate [lindex $info 2]]
8715     $ctext insert end "\t[mc "Date"]:\t$date\n"
8716     set kids $children($curview,$id)
8717     if {$kids ne {}} {
8718         $ctext insert end "\n[mc "Children"]:"
8719         set i 0
8720         foreach child $kids {
8721             incr i
8722             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8723             set info $commitinfo($child)
8724             $ctext insert end "\n\t"
8725             $ctext insert end $child link$i
8726             setlink $child link$i
8727             $ctext insert end "\n\t[lindex $info 0]"
8728             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8729             set date [formatdate [lindex $info 2]]
8730             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8731         }
8732     }
8733     maybe_scroll_ctext 1
8734     $ctext conf -state disabled
8735     init_flist {}
8736 }
8737
8738 proc normalline {} {
8739     global thickerline
8740     if {[info exists thickerline]} {
8741         set id $thickerline
8742         unset thickerline
8743         drawlines $id
8744     }
8745 }
8746
8747 proc selbyid {id {isnew 1}} {
8748     global curview
8749     if {[commitinview $id $curview]} {
8750         selectline [rowofcommit $id] $isnew
8751     }
8752 }
8753
8754 proc mstime {} {
8755     global startmstime
8756     if {![info exists startmstime]} {
8757         set startmstime [clock clicks -milliseconds]
8758     }
8759     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8760 }
8761
8762 proc rowmenu {x y id} {
8763     global rowctxmenu selectedline rowmenuid curview
8764     global nullid nullid2 fakerowmenu mainhead markedid
8765
8766     stopfinding
8767     set rowmenuid $id
8768     if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8769         set state disabled
8770     } else {
8771         set state normal
8772     }
8773     if {[info exists markedid] && $markedid ne $id} {
8774         set mstate normal
8775     } else {
8776         set mstate disabled
8777     }
8778     if {$id ne $nullid && $id ne $nullid2} {
8779         set menu $rowctxmenu
8780         if {$mainhead ne {}} {
8781             $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8782         } else {
8783             $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8784         }
8785         $menu entryconfigure 9 -state $mstate
8786         $menu entryconfigure 10 -state $mstate
8787         $menu entryconfigure 11 -state $mstate
8788     } else {
8789         set menu $fakerowmenu
8790     }
8791     $menu entryconfigure [mca "Diff this -> selected"] -state $state
8792     $menu entryconfigure [mca "Diff selected -> this"] -state $state
8793     $menu entryconfigure [mca "Make patch"] -state $state
8794     $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8795     $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8796     tk_popup $menu $x $y
8797 }
8798
8799 proc markhere {} {
8800     global rowmenuid markedid canv
8801
8802     set markedid $rowmenuid
8803     make_idmark $markedid
8804 }
8805
8806 proc gotomark {} {
8807     global markedid
8808
8809     if {[info exists markedid]} {
8810         selbyid $markedid
8811     }
8812 }
8813
8814 proc replace_by_kids {l r} {
8815     global curview children
8816
8817     set id [commitonrow $r]
8818     set l [lreplace $l 0 0]
8819     foreach kid $children($curview,$id) {
8820         lappend l [rowofcommit $kid]
8821     }
8822     return [lsort -integer -decreasing -unique $l]
8823 }
8824
8825 proc find_common_desc {} {
8826     global markedid rowmenuid curview children
8827
8828     if {![info exists markedid]} return
8829     if {![commitinview $markedid $curview] ||
8830         ![commitinview $rowmenuid $curview]} return
8831     #set t1 [clock clicks -milliseconds]
8832     set l1 [list [rowofcommit $markedid]]
8833     set l2 [list [rowofcommit $rowmenuid]]
8834     while 1 {
8835         set r1 [lindex $l1 0]
8836         set r2 [lindex $l2 0]
8837         if {$r1 eq {} || $r2 eq {}} break
8838         if {$r1 == $r2} {
8839             selectline $r1 1
8840             break
8841         }
8842         if {$r1 > $r2} {
8843             set l1 [replace_by_kids $l1 $r1]
8844         } else {
8845             set l2 [replace_by_kids $l2 $r2]
8846         }
8847     }
8848     #set t2 [clock clicks -milliseconds]
8849     #puts "took [expr {$t2-$t1}]ms"
8850 }
8851
8852 proc compare_commits {} {
8853     global markedid rowmenuid curview children
8854
8855     if {![info exists markedid]} return
8856     if {![commitinview $markedid $curview]} return
8857     addtohistory [list do_cmp_commits $markedid $rowmenuid]
8858     do_cmp_commits $markedid $rowmenuid
8859 }
8860
8861 proc getpatchid {id} {
8862     global patchids
8863
8864     if {![info exists patchids($id)]} {
8865         set cmd [diffcmd [list $id] {-p --root}]
8866         # trim off the initial "|"
8867         set cmd [lrange $cmd 1 end]
8868         if {[catch {
8869             set x [eval exec $cmd | git patch-id]
8870             set patchids($id) [lindex $x 0]
8871         }]} {
8872             set patchids($id) "error"
8873         }
8874     }
8875     return $patchids($id)
8876 }
8877
8878 proc do_cmp_commits {a b} {
8879     global ctext curview parents children patchids commitinfo
8880
8881     $ctext conf -state normal
8882     clear_ctext
8883     init_flist {}
8884     for {set i 0} {$i < 100} {incr i} {
8885         set skipa 0
8886         set skipb 0
8887         if {[llength $parents($curview,$a)] > 1} {
8888             appendshortlink $a [mc "Skipping merge commit "] "\n"
8889             set skipa 1
8890         } else {
8891             set patcha [getpatchid $a]
8892         }
8893         if {[llength $parents($curview,$b)] > 1} {
8894             appendshortlink $b [mc "Skipping merge commit "] "\n"
8895             set skipb 1
8896         } else {
8897             set patchb [getpatchid $b]
8898         }
8899         if {!$skipa && !$skipb} {
8900             set heada [lindex $commitinfo($a) 0]
8901             set headb [lindex $commitinfo($b) 0]
8902             if {$patcha eq "error"} {
8903                 appendshortlink $a [mc "Error getting patch ID for "] \
8904                     [mc " - stopping\n"]
8905                 break
8906             }
8907             if {$patchb eq "error"} {
8908                 appendshortlink $b [mc "Error getting patch ID for "] \
8909                     [mc " - stopping\n"]
8910                 break
8911             }
8912             if {$patcha eq $patchb} {
8913                 if {$heada eq $headb} {
8914                     appendshortlink $a [mc "Commit "]
8915                     appendshortlink $b " == " "  $heada\n"
8916                 } else {
8917                     appendshortlink $a [mc "Commit "] "  $heada\n"
8918                     appendshortlink $b [mc " is the same patch as\n       "] \
8919                         "  $headb\n"
8920                 }
8921                 set skipa 1
8922                 set skipb 1
8923             } else {
8924                 $ctext insert end "\n"
8925                 appendshortlink $a [mc "Commit "] "  $heada\n"
8926                 appendshortlink $b [mc " differs from\n       "] \
8927                     "  $headb\n"
8928                 $ctext insert end [mc "Diff of commits:\n\n"]
8929                 $ctext conf -state disabled
8930                 update
8931                 diffcommits $a $b
8932                 return
8933             }
8934         }
8935         if {$skipa} {
8936             set kids [real_children $curview,$a]
8937             if {[llength $kids] != 1} {
8938                 $ctext insert end "\n"
8939                 appendshortlink $a [mc "Commit "] \
8940                     [mc " has %s children - stopping\n" [llength $kids]]
8941                 break
8942             }
8943             set a [lindex $kids 0]
8944         }
8945         if {$skipb} {
8946             set kids [real_children $curview,$b]
8947             if {[llength $kids] != 1} {
8948                 appendshortlink $b [mc "Commit "] \
8949                     [mc " has %s children - stopping\n" [llength $kids]]
8950                 break
8951             }
8952             set b [lindex $kids 0]
8953         }
8954     }
8955     $ctext conf -state disabled
8956 }
8957
8958 proc diffcommits {a b} {
8959     global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
8960
8961     set tmpdir [gitknewtmpdir]
8962     set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8963     set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8964     if {[catch {
8965         exec git diff-tree -p --pretty $a >$fna
8966         exec git diff-tree -p --pretty $b >$fnb
8967     } err]} {
8968         error_popup [mc "Error writing commit to file: %s" $err]
8969         return
8970     }
8971     if {[catch {
8972         set fd [open "| diff -U$diffcontext $fna $fnb" r]
8973     } err]} {
8974         error_popup [mc "Error diffing commits: %s" $err]
8975         return
8976     }
8977     set diffids [list commits $a $b]
8978     set blobdifffd($diffids) $fd
8979     set diffinhdr 0
8980     set currdiffsubmod ""
8981     filerun $fd [list getblobdiffline $fd $diffids]
8982 }
8983
8984 proc diffvssel {dirn} {
8985     global rowmenuid selectedline
8986
8987     if {$selectedline eq {}} return
8988     if {$dirn} {
8989         set oldid [commitonrow $selectedline]
8990         set newid $rowmenuid
8991     } else {
8992         set oldid $rowmenuid
8993         set newid [commitonrow $selectedline]
8994     }
8995     addtohistory [list doseldiff $oldid $newid] savectextpos
8996     doseldiff $oldid $newid
8997 }
8998
8999 proc diffvsmark {dirn} {
9000     global rowmenuid markedid
9001
9002     if {![info exists markedid]} return
9003     if {$dirn} {
9004         set oldid $markedid
9005         set newid $rowmenuid
9006     } else {
9007         set oldid $rowmenuid
9008         set newid $markedid
9009     }
9010     addtohistory [list doseldiff $oldid $newid] savectextpos
9011     doseldiff $oldid $newid
9012 }
9013
9014 proc doseldiff {oldid newid} {
9015     global ctext
9016     global commitinfo
9017
9018     $ctext conf -state normal
9019     clear_ctext
9020     init_flist [mc "Top"]
9021     $ctext insert end "[mc "From"] "
9022     $ctext insert end $oldid link0
9023     setlink $oldid link0
9024     $ctext insert end "\n     "
9025     $ctext insert end [lindex $commitinfo($oldid) 0]
9026     $ctext insert end "\n\n[mc "To"]   "
9027     $ctext insert end $newid link1
9028     setlink $newid link1
9029     $ctext insert end "\n     "
9030     $ctext insert end [lindex $commitinfo($newid) 0]
9031     $ctext insert end "\n"
9032     $ctext conf -state disabled
9033     $ctext tag remove found 1.0 end
9034     startdiff [list $oldid $newid]
9035 }
9036
9037 proc mkpatch {} {
9038     global rowmenuid currentid commitinfo patchtop patchnum NS
9039
9040     if {![info exists currentid]} return
9041     set oldid $currentid
9042     set oldhead [lindex $commitinfo($oldid) 0]
9043     set newid $rowmenuid
9044     set newhead [lindex $commitinfo($newid) 0]
9045     set top .patch
9046     set patchtop $top
9047     catch {destroy $top}
9048     ttk_toplevel $top
9049     make_transient $top .
9050     ${NS}::label $top.title -text [mc "Generate patch"]
9051     grid $top.title - -pady 10
9052     ${NS}::label $top.from -text [mc "From:"]
9053     ${NS}::entry $top.fromsha1 -width 40
9054     $top.fromsha1 insert 0 $oldid
9055     $top.fromsha1 conf -state readonly
9056     grid $top.from $top.fromsha1 -sticky w
9057     ${NS}::entry $top.fromhead -width 60
9058     $top.fromhead insert 0 $oldhead
9059     $top.fromhead conf -state readonly
9060     grid x $top.fromhead -sticky w
9061     ${NS}::label $top.to -text [mc "To:"]
9062     ${NS}::entry $top.tosha1 -width 40
9063     $top.tosha1 insert 0 $newid
9064     $top.tosha1 conf -state readonly
9065     grid $top.to $top.tosha1 -sticky w
9066     ${NS}::entry $top.tohead -width 60
9067     $top.tohead insert 0 $newhead
9068     $top.tohead conf -state readonly
9069     grid x $top.tohead -sticky w
9070     ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9071     grid $top.rev x -pady 10 -padx 5
9072     ${NS}::label $top.flab -text [mc "Output file:"]
9073     ${NS}::entry $top.fname -width 60
9074     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9075     incr patchnum
9076     grid $top.flab $top.fname -sticky w
9077     ${NS}::frame $top.buts
9078     ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9079     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9080     bind $top <Key-Return> mkpatchgo
9081     bind $top <Key-Escape> mkpatchcan
9082     grid $top.buts.gen $top.buts.can
9083     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9084     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9085     grid $top.buts - -pady 10 -sticky ew
9086     focus $top.fname
9087 }
9088
9089 proc mkpatchrev {} {
9090     global patchtop
9091
9092     set oldid [$patchtop.fromsha1 get]
9093     set oldhead [$patchtop.fromhead get]
9094     set newid [$patchtop.tosha1 get]
9095     set newhead [$patchtop.tohead get]
9096     foreach e [list fromsha1 fromhead tosha1 tohead] \
9097             v [list $newid $newhead $oldid $oldhead] {
9098         $patchtop.$e conf -state normal
9099         $patchtop.$e delete 0 end
9100         $patchtop.$e insert 0 $v
9101         $patchtop.$e conf -state readonly
9102     }
9103 }
9104
9105 proc mkpatchgo {} {
9106     global patchtop nullid nullid2
9107
9108     set oldid [$patchtop.fromsha1 get]
9109     set newid [$patchtop.tosha1 get]
9110     set fname [$patchtop.fname get]
9111     set cmd [diffcmd [list $oldid $newid] -p]
9112     # trim off the initial "|"
9113     set cmd [lrange $cmd 1 end]
9114     lappend cmd >$fname &
9115     if {[catch {eval exec $cmd} err]} {
9116         error_popup "[mc "Error creating patch:"] $err" $patchtop
9117     }
9118     catch {destroy $patchtop}
9119     unset patchtop
9120 }
9121
9122 proc mkpatchcan {} {
9123     global patchtop
9124
9125     catch {destroy $patchtop}
9126     unset patchtop
9127 }
9128
9129 proc mktag {} {
9130     global rowmenuid mktagtop commitinfo NS
9131
9132     set top .maketag
9133     set mktagtop $top
9134     catch {destroy $top}
9135     ttk_toplevel $top
9136     make_transient $top .
9137     ${NS}::label $top.title -text [mc "Create tag"]
9138     grid $top.title - -pady 10
9139     ${NS}::label $top.id -text [mc "ID:"]
9140     ${NS}::entry $top.sha1 -width 40
9141     $top.sha1 insert 0 $rowmenuid
9142     $top.sha1 conf -state readonly
9143     grid $top.id $top.sha1 -sticky w
9144     ${NS}::entry $top.head -width 60
9145     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9146     $top.head conf -state readonly
9147     grid x $top.head -sticky w
9148     ${NS}::label $top.tlab -text [mc "Tag name:"]
9149     ${NS}::entry $top.tag -width 60
9150     grid $top.tlab $top.tag -sticky w
9151     ${NS}::label $top.op -text [mc "Tag message is optional"]
9152     grid $top.op -columnspan 2 -sticky we
9153     ${NS}::label $top.mlab -text [mc "Tag message:"]
9154     ${NS}::entry $top.msg -width 60
9155     grid $top.mlab $top.msg -sticky w
9156     ${NS}::frame $top.buts
9157     ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9158     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9159     bind $top <Key-Return> mktaggo
9160     bind $top <Key-Escape> mktagcan
9161     grid $top.buts.gen $top.buts.can
9162     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9163     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9164     grid $top.buts - -pady 10 -sticky ew
9165     focus $top.tag
9166 }
9167
9168 proc domktag {} {
9169     global mktagtop env tagids idtags
9170
9171     set id [$mktagtop.sha1 get]
9172     set tag [$mktagtop.tag get]
9173     set msg [$mktagtop.msg get]
9174     if {$tag == {}} {
9175         error_popup [mc "No tag name specified"] $mktagtop
9176         return 0
9177     }
9178     if {[info exists tagids($tag)]} {
9179         error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9180         return 0
9181     }
9182     if {[catch {
9183         if {$msg != {}} {
9184             exec git tag -a -m $msg $tag $id
9185         } else {
9186             exec git tag $tag $id
9187         }
9188     } err]} {
9189         error_popup "[mc "Error creating tag:"] $err" $mktagtop
9190         return 0
9191     }
9192
9193     set tagids($tag) $id
9194     lappend idtags($id) $tag
9195     redrawtags $id
9196     addedtag $id
9197     dispneartags 0
9198     run refill_reflist
9199     return 1
9200 }
9201
9202 proc redrawtags {id} {
9203     global canv linehtag idpos currentid curview cmitlisted markedid
9204     global canvxmax iddrawn circleitem mainheadid circlecolors
9205     global mainheadcirclecolor
9206
9207     if {![commitinview $id $curview]} return
9208     if {![info exists iddrawn($id)]} return
9209     set row [rowofcommit $id]
9210     if {$id eq $mainheadid} {
9211         set ofill $mainheadcirclecolor
9212     } else {
9213         set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9214     }
9215     $canv itemconf $circleitem($row) -fill $ofill
9216     $canv delete tag.$id
9217     set xt [eval drawtags $id $idpos($id)]
9218     $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9219     set text [$canv itemcget $linehtag($id) -text]
9220     set font [$canv itemcget $linehtag($id) -font]
9221     set xr [expr {$xt + [font measure $font $text]}]
9222     if {$xr > $canvxmax} {
9223         set canvxmax $xr
9224         setcanvscroll
9225     }
9226     if {[info exists currentid] && $currentid == $id} {
9227         make_secsel $id
9228     }
9229     if {[info exists markedid] && $markedid eq $id} {
9230         make_idmark $id
9231     }
9232 }
9233
9234 proc mktagcan {} {
9235     global mktagtop
9236
9237     catch {destroy $mktagtop}
9238     unset mktagtop
9239 }
9240
9241 proc mktaggo {} {
9242     if {![domktag]} return
9243     mktagcan
9244 }
9245
9246 proc writecommit {} {
9247     global rowmenuid wrcomtop commitinfo wrcomcmd NS
9248
9249     set top .writecommit
9250     set wrcomtop $top
9251     catch {destroy $top}
9252     ttk_toplevel $top
9253     make_transient $top .
9254     ${NS}::label $top.title -text [mc "Write commit to file"]
9255     grid $top.title - -pady 10
9256     ${NS}::label $top.id -text [mc "ID:"]
9257     ${NS}::entry $top.sha1 -width 40
9258     $top.sha1 insert 0 $rowmenuid
9259     $top.sha1 conf -state readonly
9260     grid $top.id $top.sha1 -sticky w
9261     ${NS}::entry $top.head -width 60
9262     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9263     $top.head conf -state readonly
9264     grid x $top.head -sticky w
9265     ${NS}::label $top.clab -text [mc "Command:"]
9266     ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9267     grid $top.clab $top.cmd -sticky w -pady 10
9268     ${NS}::label $top.flab -text [mc "Output file:"]
9269     ${NS}::entry $top.fname -width 60
9270     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9271     grid $top.flab $top.fname -sticky w
9272     ${NS}::frame $top.buts
9273     ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9274     ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9275     bind $top <Key-Return> wrcomgo
9276     bind $top <Key-Escape> wrcomcan
9277     grid $top.buts.gen $top.buts.can
9278     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9279     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9280     grid $top.buts - -pady 10 -sticky ew
9281     focus $top.fname
9282 }
9283
9284 proc wrcomgo {} {
9285     global wrcomtop
9286
9287     set id [$wrcomtop.sha1 get]
9288     set cmd "echo $id | [$wrcomtop.cmd get]"
9289     set fname [$wrcomtop.fname get]
9290     if {[catch {exec sh -c $cmd >$fname &} err]} {
9291         error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9292     }
9293     catch {destroy $wrcomtop}
9294     unset wrcomtop
9295 }
9296
9297 proc wrcomcan {} {
9298     global wrcomtop
9299
9300     catch {destroy $wrcomtop}
9301     unset wrcomtop
9302 }
9303
9304 proc mkbranch {} {
9305     global rowmenuid mkbrtop NS
9306
9307     set top .makebranch
9308     catch {destroy $top}
9309     ttk_toplevel $top
9310     make_transient $top .
9311     ${NS}::label $top.title -text [mc "Create new branch"]
9312     grid $top.title - -pady 10
9313     ${NS}::label $top.id -text [mc "ID:"]
9314     ${NS}::entry $top.sha1 -width 40
9315     $top.sha1 insert 0 $rowmenuid
9316     $top.sha1 conf -state readonly
9317     grid $top.id $top.sha1 -sticky w
9318     ${NS}::label $top.nlab -text [mc "Name:"]
9319     ${NS}::entry $top.name -width 40
9320     grid $top.nlab $top.name -sticky w
9321     ${NS}::frame $top.buts
9322     ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9323     ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9324     bind $top <Key-Return> [list mkbrgo $top]
9325     bind $top <Key-Escape> "catch {destroy $top}"
9326     grid $top.buts.go $top.buts.can
9327     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9328     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9329     grid $top.buts - -pady 10 -sticky ew
9330     focus $top.name
9331 }
9332
9333 proc mkbrgo {top} {
9334     global headids idheads
9335
9336     set name [$top.name get]
9337     set id [$top.sha1 get]
9338     set cmdargs {}
9339     set old_id {}
9340     if {$name eq {}} {
9341         error_popup [mc "Please specify a name for the new branch"] $top
9342         return
9343     }
9344     if {[info exists headids($name)]} {
9345         if {![confirm_popup [mc \
9346                 "Branch '%s' already exists. Overwrite?" $name] $top]} {
9347             return
9348         }
9349         set old_id $headids($name)
9350         lappend cmdargs -f
9351     }
9352     catch {destroy $top}
9353     lappend cmdargs $name $id
9354     nowbusy newbranch
9355     update
9356     if {[catch {
9357         eval exec git branch $cmdargs
9358     } err]} {
9359         notbusy newbranch
9360         error_popup $err
9361     } else {
9362         notbusy newbranch
9363         if {$old_id ne {}} {
9364             movehead $id $name
9365             movedhead $id $name
9366             redrawtags $old_id
9367             redrawtags $id
9368         } else {
9369             set headids($name) $id
9370             lappend idheads($id) $name
9371             addedhead $id $name
9372             redrawtags $id
9373         }
9374         dispneartags 0
9375         run refill_reflist
9376     }
9377 }
9378
9379 proc exec_citool {tool_args {baseid {}}} {
9380     global commitinfo env
9381
9382     set save_env [array get env GIT_AUTHOR_*]
9383
9384     if {$baseid ne {}} {
9385         if {![info exists commitinfo($baseid)]} {
9386             getcommit $baseid
9387         }
9388         set author [lindex $commitinfo($baseid) 1]
9389         set date [lindex $commitinfo($baseid) 2]
9390         if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9391                     $author author name email]
9392             && $date ne {}} {
9393             set env(GIT_AUTHOR_NAME) $name
9394             set env(GIT_AUTHOR_EMAIL) $email
9395             set env(GIT_AUTHOR_DATE) $date
9396         }
9397     }
9398
9399     eval exec git citool $tool_args &
9400
9401     array unset env GIT_AUTHOR_*
9402     array set env $save_env
9403 }
9404
9405 proc cherrypick {} {
9406     global rowmenuid curview
9407     global mainhead mainheadid
9408     global gitdir
9409
9410     set oldhead [exec git rev-parse HEAD]
9411     set dheads [descheads $rowmenuid]
9412     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9413         set ok [confirm_popup [mc "Commit %s is already\
9414                 included in branch %s -- really re-apply it?" \
9415                                    [string range $rowmenuid 0 7] $mainhead]]
9416         if {!$ok} return
9417     }
9418     nowbusy cherrypick [mc "Cherry-picking"]
9419     update
9420     # Unfortunately git-cherry-pick writes stuff to stderr even when
9421     # no error occurs, and exec takes that as an indication of error...
9422     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9423         notbusy cherrypick
9424         if {[regexp -line \
9425                  {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9426                  $err msg fname]} {
9427             error_popup [mc "Cherry-pick failed because of local changes\
9428                         to file '%s'.\nPlease commit, reset or stash\
9429                         your changes and try again." $fname]
9430         } elseif {[regexp -line \
9431                        {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9432                        $err]} {
9433             if {[confirm_popup [mc "Cherry-pick failed because of merge\
9434                         conflict.\nDo you wish to run git citool to\
9435                         resolve it?"]]} {
9436                 # Force citool to read MERGE_MSG
9437                 file delete [file join $gitdir "GITGUI_MSG"]
9438                 exec_citool {} $rowmenuid
9439             }
9440         } else {
9441             error_popup $err
9442         }
9443         run updatecommits
9444         return
9445     }
9446     set newhead [exec git rev-parse HEAD]
9447     if {$newhead eq $oldhead} {
9448         notbusy cherrypick
9449         error_popup [mc "No changes committed"]
9450         return
9451     }
9452     addnewchild $newhead $oldhead
9453     if {[commitinview $oldhead $curview]} {
9454         # XXX this isn't right if we have a path limit...
9455         insertrow $newhead $oldhead $curview
9456         if {$mainhead ne {}} {
9457             movehead $newhead $mainhead
9458             movedhead $newhead $mainhead
9459         }
9460         set mainheadid $newhead
9461         redrawtags $oldhead
9462         redrawtags $newhead
9463         selbyid $newhead
9464     }
9465     notbusy cherrypick
9466 }
9467
9468 proc revert {} {
9469     global rowmenuid curview
9470     global mainhead mainheadid
9471     global gitdir
9472
9473     set oldhead [exec git rev-parse HEAD]
9474     set dheads [descheads $rowmenuid]
9475     if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9476        set ok [confirm_popup [mc "Commit %s is not\
9477            included in branch %s -- really revert it?" \
9478                       [string range $rowmenuid 0 7] $mainhead]]
9479        if {!$ok} return
9480     }
9481     nowbusy revert [mc "Reverting"]
9482     update
9483
9484     if [catch {exec git revert --no-edit $rowmenuid} err] {
9485         notbusy revert
9486         if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9487                 $err match files] {
9488             regsub {\n( |\t)+} $files "\n" files
9489             error_popup [mc "Revert failed because of local changes to\
9490                 the following files:%s Please commit, reset or stash \
9491                 your changes and try again." $files]
9492         } elseif [regexp {error: could not revert} $err] {
9493             if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9494                 Do you wish to run git citool to resolve it?"]] {
9495                 # Force citool to read MERGE_MSG
9496                 file delete [file join $gitdir "GITGUI_MSG"]
9497                 exec_citool {} $rowmenuid
9498             }
9499         } else { error_popup $err }
9500         run updatecommits
9501         return
9502     }
9503
9504     set newhead [exec git rev-parse HEAD]
9505     if { $newhead eq $oldhead } {
9506         notbusy revert
9507         error_popup [mc "No changes committed"]
9508         return
9509     }
9510
9511     addnewchild $newhead $oldhead
9512
9513     if [commitinview $oldhead $curview] {
9514         # XXX this isn't right if we have a path limit...
9515         insertrow $newhead $oldhead $curview
9516         if {$mainhead ne {}} {
9517             movehead $newhead $mainhead
9518             movedhead $newhead $mainhead
9519         }
9520         set mainheadid $newhead
9521         redrawtags $oldhead
9522         redrawtags $newhead
9523         selbyid $newhead
9524     }
9525
9526     notbusy revert
9527 }
9528
9529 proc resethead {} {
9530     global mainhead rowmenuid confirm_ok resettype NS
9531
9532     set confirm_ok 0
9533     set w ".confirmreset"
9534     ttk_toplevel $w
9535     make_transient $w .
9536     wm title $w [mc "Confirm reset"]
9537     ${NS}::label $w.m -text \
9538         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9539     pack $w.m -side top -fill x -padx 20 -pady 20
9540     ${NS}::labelframe $w.f -text [mc "Reset type:"]
9541     set resettype mixed
9542     ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9543         -text [mc "Soft: Leave working tree and index untouched"]
9544     grid $w.f.soft -sticky w
9545     ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9546         -text [mc "Mixed: Leave working tree untouched, reset index"]
9547     grid $w.f.mixed -sticky w
9548     ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9549         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9550     grid $w.f.hard -sticky w
9551     pack $w.f -side top -fill x -padx 4
9552     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9553     pack $w.ok -side left -fill x -padx 20 -pady 20
9554     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9555     bind $w <Key-Escape> [list destroy $w]
9556     pack $w.cancel -side right -fill x -padx 20 -pady 20
9557     bind $w <Visibility> "grab $w; focus $w"
9558     tkwait window $w
9559     if {!$confirm_ok} return
9560     if {[catch {set fd [open \
9561             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9562         error_popup $err
9563     } else {
9564         dohidelocalchanges
9565         filerun $fd [list readresetstat $fd]
9566         nowbusy reset [mc "Resetting"]
9567         selbyid $rowmenuid
9568     }
9569 }
9570
9571 proc readresetstat {fd} {
9572     global mainhead mainheadid showlocalchanges rprogcoord
9573
9574     if {[gets $fd line] >= 0} {
9575         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9576             set rprogcoord [expr {1.0 * $m / $n}]
9577             adjustprogress
9578         }
9579         return 1
9580     }
9581     set rprogcoord 0
9582     adjustprogress
9583     notbusy reset
9584     if {[catch {close $fd} err]} {
9585         error_popup $err
9586     }
9587     set oldhead $mainheadid
9588     set newhead [exec git rev-parse HEAD]
9589     if {$newhead ne $oldhead} {
9590         movehead $newhead $mainhead
9591         movedhead $newhead $mainhead
9592         set mainheadid $newhead
9593         redrawtags $oldhead
9594         redrawtags $newhead
9595     }
9596     if {$showlocalchanges} {
9597         doshowlocalchanges
9598     }
9599     return 0
9600 }
9601
9602 # context menu for a head
9603 proc headmenu {x y id head} {
9604     global headmenuid headmenuhead headctxmenu mainhead
9605
9606     stopfinding
9607     set headmenuid $id
9608     set headmenuhead $head
9609     set state normal
9610     if {[string match "remotes/*" $head]} {
9611         set state disabled
9612     }
9613     if {$head eq $mainhead} {
9614         set state disabled
9615     }
9616     $headctxmenu entryconfigure 0 -state $state
9617     $headctxmenu entryconfigure 1 -state $state
9618     tk_popup $headctxmenu $x $y
9619 }
9620
9621 proc cobranch {} {
9622     global headmenuid headmenuhead headids
9623     global showlocalchanges
9624
9625     # check the tree is clean first??
9626     nowbusy checkout [mc "Checking out"]
9627     update
9628     dohidelocalchanges
9629     if {[catch {
9630         set fd [open [list | git checkout $headmenuhead 2>@1] r]
9631     } err]} {
9632         notbusy checkout
9633         error_popup $err
9634         if {$showlocalchanges} {
9635             dodiffindex
9636         }
9637     } else {
9638         filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9639     }
9640 }
9641
9642 proc readcheckoutstat {fd newhead newheadid} {
9643     global mainhead mainheadid headids showlocalchanges progresscoords
9644     global viewmainheadid curview
9645
9646     if {[gets $fd line] >= 0} {
9647         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9648             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9649             adjustprogress
9650         }
9651         return 1
9652     }
9653     set progresscoords {0 0}
9654     adjustprogress
9655     notbusy checkout
9656     if {[catch {close $fd} err]} {
9657         error_popup $err
9658     }
9659     set oldmainid $mainheadid
9660     set mainhead $newhead
9661     set mainheadid $newheadid
9662     set viewmainheadid($curview) $newheadid
9663     redrawtags $oldmainid
9664     redrawtags $newheadid
9665     selbyid $newheadid
9666     if {$showlocalchanges} {
9667         dodiffindex
9668     }
9669 }
9670
9671 proc rmbranch {} {
9672     global headmenuid headmenuhead mainhead
9673     global idheads
9674
9675     set head $headmenuhead
9676     set id $headmenuid
9677     # this check shouldn't be needed any more...
9678     if {$head eq $mainhead} {
9679         error_popup [mc "Cannot delete the currently checked-out branch"]
9680         return
9681     }
9682     set dheads [descheads $id]
9683     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9684         # the stuff on this branch isn't on any other branch
9685         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9686                         branch.\nReally delete branch %s?" $head $head]]} return
9687     }
9688     nowbusy rmbranch
9689     update
9690     if {[catch {exec git branch -D $head} err]} {
9691         notbusy rmbranch
9692         error_popup $err
9693         return
9694     }
9695     removehead $id $head
9696     removedhead $id $head
9697     redrawtags $id
9698     notbusy rmbranch
9699     dispneartags 0
9700     run refill_reflist
9701 }
9702
9703 # Display a list of tags and heads
9704 proc showrefs {} {
9705     global showrefstop bgcolor fgcolor selectbgcolor NS
9706     global bglist fglist reflistfilter reflist maincursor
9707
9708     set top .showrefs
9709     set showrefstop $top
9710     if {[winfo exists $top]} {
9711         raise $top
9712         refill_reflist
9713         return
9714     }
9715     ttk_toplevel $top
9716     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9717     make_transient $top .
9718     text $top.list -background $bgcolor -foreground $fgcolor \
9719         -selectbackground $selectbgcolor -font mainfont \
9720         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9721         -width 30 -height 20 -cursor $maincursor \
9722         -spacing1 1 -spacing3 1 -state disabled
9723     $top.list tag configure highlight -background $selectbgcolor
9724     lappend bglist $top.list
9725     lappend fglist $top.list
9726     ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9727     ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9728     grid $top.list $top.ysb -sticky nsew
9729     grid $top.xsb x -sticky ew
9730     ${NS}::frame $top.f
9731     ${NS}::label $top.f.l -text "[mc "Filter"]: "
9732     ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9733     set reflistfilter "*"
9734     trace add variable reflistfilter write reflistfilter_change
9735     pack $top.f.e -side right -fill x -expand 1
9736     pack $top.f.l -side left
9737     grid $top.f - -sticky ew -pady 2
9738     ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9739     bind $top <Key-Escape> [list destroy $top]
9740     grid $top.close -
9741     grid columnconfigure $top 0 -weight 1
9742     grid rowconfigure $top 0 -weight 1
9743     bind $top.list <1> {break}
9744     bind $top.list <B1-Motion> {break}
9745     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9746     set reflist {}
9747     refill_reflist
9748 }
9749
9750 proc sel_reflist {w x y} {
9751     global showrefstop reflist headids tagids otherrefids
9752
9753     if {![winfo exists $showrefstop]} return
9754     set l [lindex [split [$w index "@$x,$y"] "."] 0]
9755     set ref [lindex $reflist [expr {$l-1}]]
9756     set n [lindex $ref 0]
9757     switch -- [lindex $ref 1] {
9758         "H" {selbyid $headids($n)}
9759         "T" {selbyid $tagids($n)}
9760         "o" {selbyid $otherrefids($n)}
9761     }
9762     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9763 }
9764
9765 proc unsel_reflist {} {
9766     global showrefstop
9767
9768     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9769     $showrefstop.list tag remove highlight 0.0 end
9770 }
9771
9772 proc reflistfilter_change {n1 n2 op} {
9773     global reflistfilter
9774
9775     after cancel refill_reflist
9776     after 200 refill_reflist
9777 }
9778
9779 proc refill_reflist {} {
9780     global reflist reflistfilter showrefstop headids tagids otherrefids
9781     global curview
9782
9783     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9784     set refs {}
9785     foreach n [array names headids] {
9786         if {[string match $reflistfilter $n]} {
9787             if {[commitinview $headids($n) $curview]} {
9788                 lappend refs [list $n H]
9789             } else {
9790                 interestedin $headids($n) {run refill_reflist}
9791             }
9792         }
9793     }
9794     foreach n [array names tagids] {
9795         if {[string match $reflistfilter $n]} {
9796             if {[commitinview $tagids($n) $curview]} {
9797                 lappend refs [list $n T]
9798             } else {
9799                 interestedin $tagids($n) {run refill_reflist}
9800             }
9801         }
9802     }
9803     foreach n [array names otherrefids] {
9804         if {[string match $reflistfilter $n]} {
9805             if {[commitinview $otherrefids($n) $curview]} {
9806                 lappend refs [list $n o]
9807             } else {
9808                 interestedin $otherrefids($n) {run refill_reflist}
9809             }
9810         }
9811     }
9812     set refs [lsort -index 0 $refs]
9813     if {$refs eq $reflist} return
9814
9815     # Update the contents of $showrefstop.list according to the
9816     # differences between $reflist (old) and $refs (new)
9817     $showrefstop.list conf -state normal
9818     $showrefstop.list insert end "\n"
9819     set i 0
9820     set j 0
9821     while {$i < [llength $reflist] || $j < [llength $refs]} {
9822         if {$i < [llength $reflist]} {
9823             if {$j < [llength $refs]} {
9824                 set cmp [string compare [lindex $reflist $i 0] \
9825                              [lindex $refs $j 0]]
9826                 if {$cmp == 0} {
9827                     set cmp [string compare [lindex $reflist $i 1] \
9828                                  [lindex $refs $j 1]]
9829                 }
9830             } else {
9831                 set cmp -1
9832             }
9833         } else {
9834             set cmp 1
9835         }
9836         switch -- $cmp {
9837             -1 {
9838                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9839                 incr i
9840             }
9841             0 {
9842                 incr i
9843                 incr j
9844             }
9845             1 {
9846                 set l [expr {$j + 1}]
9847                 $showrefstop.list image create $l.0 -align baseline \
9848                     -image reficon-[lindex $refs $j 1] -padx 2
9849                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9850                 incr j
9851             }
9852         }
9853     }
9854     set reflist $refs
9855     # delete last newline
9856     $showrefstop.list delete end-2c end-1c
9857     $showrefstop.list conf -state disabled
9858 }
9859
9860 # Stuff for finding nearby tags
9861 proc getallcommits {} {
9862     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9863     global idheads idtags idotherrefs allparents tagobjid
9864     global gitdir
9865
9866     if {![info exists allcommits]} {
9867         set nextarc 0
9868         set allcommits 0
9869         set seeds {}
9870         set allcwait 0
9871         set cachedarcs 0
9872         set allccache [file join $gitdir "gitk.cache"]
9873         if {![catch {
9874             set f [open $allccache r]
9875             set allcwait 1
9876             getcache $f
9877         }]} return
9878     }
9879
9880     if {$allcwait} {
9881         return
9882     }
9883     set cmd [list | git rev-list --parents]
9884     set allcupdate [expr {$seeds ne {}}]
9885     if {!$allcupdate} {
9886         set ids "--all"
9887     } else {
9888         set refs [concat [array names idheads] [array names idtags] \
9889                       [array names idotherrefs]]
9890         set ids {}
9891         set tagobjs {}
9892         foreach name [array names tagobjid] {
9893             lappend tagobjs $tagobjid($name)
9894         }
9895         foreach id [lsort -unique $refs] {
9896             if {![info exists allparents($id)] &&
9897                 [lsearch -exact $tagobjs $id] < 0} {
9898                 lappend ids $id
9899             }
9900         }
9901         if {$ids ne {}} {
9902             foreach id $seeds {
9903                 lappend ids "^$id"
9904             }
9905         }
9906     }
9907     if {$ids ne {}} {
9908         set fd [open [concat $cmd $ids] r]
9909         fconfigure $fd -blocking 0
9910         incr allcommits
9911         nowbusy allcommits
9912         filerun $fd [list getallclines $fd]
9913     } else {
9914         dispneartags 0
9915     }
9916 }
9917
9918 # Since most commits have 1 parent and 1 child, we group strings of
9919 # such commits into "arcs" joining branch/merge points (BMPs), which
9920 # are commits that either don't have 1 parent or don't have 1 child.
9921 #
9922 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9923 # arcout(id) - outgoing arcs for BMP
9924 # arcids(a) - list of IDs on arc including end but not start
9925 # arcstart(a) - BMP ID at start of arc
9926 # arcend(a) - BMP ID at end of arc
9927 # growing(a) - arc a is still growing
9928 # arctags(a) - IDs out of arcids (excluding end) that have tags
9929 # archeads(a) - IDs out of arcids (excluding end) that have heads
9930 # The start of an arc is at the descendent end, so "incoming" means
9931 # coming from descendents, and "outgoing" means going towards ancestors.
9932
9933 proc getallclines {fd} {
9934     global allparents allchildren idtags idheads nextarc
9935     global arcnos arcids arctags arcout arcend arcstart archeads growing
9936     global seeds allcommits cachedarcs allcupdate
9937
9938     set nid 0
9939     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9940         set id [lindex $line 0]
9941         if {[info exists allparents($id)]} {
9942             # seen it already
9943             continue
9944         }
9945         set cachedarcs 0
9946         set olds [lrange $line 1 end]
9947         set allparents($id) $olds
9948         if {![info exists allchildren($id)]} {
9949             set allchildren($id) {}
9950             set arcnos($id) {}
9951             lappend seeds $id
9952         } else {
9953             set a $arcnos($id)
9954             if {[llength $olds] == 1 && [llength $a] == 1} {
9955                 lappend arcids($a) $id
9956                 if {[info exists idtags($id)]} {
9957                     lappend arctags($a) $id
9958                 }
9959                 if {[info exists idheads($id)]} {
9960                     lappend archeads($a) $id
9961                 }
9962                 if {[info exists allparents($olds)]} {
9963                     # seen parent already
9964                     if {![info exists arcout($olds)]} {
9965                         splitarc $olds
9966                     }
9967                     lappend arcids($a) $olds
9968                     set arcend($a) $olds
9969                     unset growing($a)
9970                 }
9971                 lappend allchildren($olds) $id
9972                 lappend arcnos($olds) $a
9973                 continue
9974             }
9975         }
9976         foreach a $arcnos($id) {
9977             lappend arcids($a) $id
9978             set arcend($a) $id
9979             unset growing($a)
9980         }
9981
9982         set ao {}
9983         foreach p $olds {
9984             lappend allchildren($p) $id
9985             set a [incr nextarc]
9986             set arcstart($a) $id
9987             set archeads($a) {}
9988             set arctags($a) {}
9989             set archeads($a) {}
9990             set arcids($a) {}
9991             lappend ao $a
9992             set growing($a) 1
9993             if {[info exists allparents($p)]} {
9994                 # seen it already, may need to make a new branch
9995                 if {![info exists arcout($p)]} {
9996                     splitarc $p
9997                 }
9998                 lappend arcids($a) $p
9999                 set arcend($a) $p
10000                 unset growing($a)
10001             }
10002             lappend arcnos($p) $a
10003         }
10004         set arcout($id) $ao
10005     }
10006     if {$nid > 0} {
10007         global cached_dheads cached_dtags cached_atags
10008         catch {unset cached_dheads}
10009         catch {unset cached_dtags}
10010         catch {unset cached_atags}
10011     }
10012     if {![eof $fd]} {
10013         return [expr {$nid >= 1000? 2: 1}]
10014     }
10015     set cacheok 1
10016     if {[catch {
10017         fconfigure $fd -blocking 1
10018         close $fd
10019     } err]} {
10020         # got an error reading the list of commits
10021         # if we were updating, try rereading the whole thing again
10022         if {$allcupdate} {
10023             incr allcommits -1
10024             dropcache $err
10025             return
10026         }
10027         error_popup "[mc "Error reading commit topology information;\
10028                 branch and preceding/following tag information\
10029                 will be incomplete."]\n($err)"
10030         set cacheok 0
10031     }
10032     if {[incr allcommits -1] == 0} {
10033         notbusy allcommits
10034         if {$cacheok} {
10035             run savecache
10036         }
10037     }
10038     dispneartags 0
10039     return 0
10040 }
10041
10042 proc recalcarc {a} {
10043     global arctags archeads arcids idtags idheads
10044
10045     set at {}
10046     set ah {}
10047     foreach id [lrange $arcids($a) 0 end-1] {
10048         if {[info exists idtags($id)]} {
10049             lappend at $id
10050         }
10051         if {[info exists idheads($id)]} {
10052             lappend ah $id
10053         }
10054     }
10055     set arctags($a) $at
10056     set archeads($a) $ah
10057 }
10058
10059 proc splitarc {p} {
10060     global arcnos arcids nextarc arctags archeads idtags idheads
10061     global arcstart arcend arcout allparents growing
10062
10063     set a $arcnos($p)
10064     if {[llength $a] != 1} {
10065         puts "oops splitarc called but [llength $a] arcs already"
10066         return
10067     }
10068     set a [lindex $a 0]
10069     set i [lsearch -exact $arcids($a) $p]
10070     if {$i < 0} {
10071         puts "oops splitarc $p not in arc $a"
10072         return
10073     }
10074     set na [incr nextarc]
10075     if {[info exists arcend($a)]} {
10076         set arcend($na) $arcend($a)
10077     } else {
10078         set l [lindex $allparents([lindex $arcids($a) end]) 0]
10079         set j [lsearch -exact $arcnos($l) $a]
10080         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10081     }
10082     set tail [lrange $arcids($a) [expr {$i+1}] end]
10083     set arcids($a) [lrange $arcids($a) 0 $i]
10084     set arcend($a) $p
10085     set arcstart($na) $p
10086     set arcout($p) $na
10087     set arcids($na) $tail
10088     if {[info exists growing($a)]} {
10089         set growing($na) 1
10090         unset growing($a)
10091     }
10092
10093     foreach id $tail {
10094         if {[llength $arcnos($id)] == 1} {
10095             set arcnos($id) $na
10096         } else {
10097             set j [lsearch -exact $arcnos($id) $a]
10098             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10099         }
10100     }
10101
10102     # reconstruct tags and heads lists
10103     if {$arctags($a) ne {} || $archeads($a) ne {}} {
10104         recalcarc $a
10105         recalcarc $na
10106     } else {
10107         set arctags($na) {}
10108         set archeads($na) {}
10109     }
10110 }
10111
10112 # Update things for a new commit added that is a child of one
10113 # existing commit.  Used when cherry-picking.
10114 proc addnewchild {id p} {
10115     global allparents allchildren idtags nextarc
10116     global arcnos arcids arctags arcout arcend arcstart archeads growing
10117     global seeds allcommits
10118
10119     if {![info exists allcommits] || ![info exists arcnos($p)]} return
10120     set allparents($id) [list $p]
10121     set allchildren($id) {}
10122     set arcnos($id) {}
10123     lappend seeds $id
10124     lappend allchildren($p) $id
10125     set a [incr nextarc]
10126     set arcstart($a) $id
10127     set archeads($a) {}
10128     set arctags($a) {}
10129     set arcids($a) [list $p]
10130     set arcend($a) $p
10131     if {![info exists arcout($p)]} {
10132         splitarc $p
10133     }
10134     lappend arcnos($p) $a
10135     set arcout($id) [list $a]
10136 }
10137
10138 # This implements a cache for the topology information.
10139 # The cache saves, for each arc, the start and end of the arc,
10140 # the ids on the arc, and the outgoing arcs from the end.
10141 proc readcache {f} {
10142     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10143     global idtags idheads allparents cachedarcs possible_seeds seeds growing
10144     global allcwait
10145
10146     set a $nextarc
10147     set lim $cachedarcs
10148     if {$lim - $a > 500} {
10149         set lim [expr {$a + 500}]
10150     }
10151     if {[catch {
10152         if {$a == $lim} {
10153             # finish reading the cache and setting up arctags, etc.
10154             set line [gets $f]
10155             if {$line ne "1"} {error "bad final version"}
10156             close $f
10157             foreach id [array names idtags] {
10158                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10159                     [llength $allparents($id)] == 1} {
10160                     set a [lindex $arcnos($id) 0]
10161                     if {$arctags($a) eq {}} {
10162                         recalcarc $a
10163                     }
10164                 }
10165             }
10166             foreach id [array names idheads] {
10167                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10168                     [llength $allparents($id)] == 1} {
10169                     set a [lindex $arcnos($id) 0]
10170                     if {$archeads($a) eq {}} {
10171                         recalcarc $a
10172                     }
10173                 }
10174             }
10175             foreach id [lsort -unique $possible_seeds] {
10176                 if {$arcnos($id) eq {}} {
10177                     lappend seeds $id
10178                 }
10179             }
10180             set allcwait 0
10181         } else {
10182             while {[incr a] <= $lim} {
10183                 set line [gets $f]
10184                 if {[llength $line] != 3} {error "bad line"}
10185                 set s [lindex $line 0]
10186                 set arcstart($a) $s
10187                 lappend arcout($s) $a
10188                 if {![info exists arcnos($s)]} {
10189                     lappend possible_seeds $s
10190                     set arcnos($s) {}
10191                 }
10192                 set e [lindex $line 1]
10193                 if {$e eq {}} {
10194                     set growing($a) 1
10195                 } else {
10196                     set arcend($a) $e
10197                     if {![info exists arcout($e)]} {
10198                         set arcout($e) {}
10199                     }
10200                 }
10201                 set arcids($a) [lindex $line 2]
10202                 foreach id $arcids($a) {
10203                     lappend allparents($s) $id
10204                     set s $id
10205                     lappend arcnos($id) $a
10206                 }
10207                 if {![info exists allparents($s)]} {
10208                     set allparents($s) {}
10209                 }
10210                 set arctags($a) {}
10211                 set archeads($a) {}
10212             }
10213             set nextarc [expr {$a - 1}]
10214         }
10215     } err]} {
10216         dropcache $err
10217         return 0
10218     }
10219     if {!$allcwait} {
10220         getallcommits
10221     }
10222     return $allcwait
10223 }
10224
10225 proc getcache {f} {
10226     global nextarc cachedarcs possible_seeds
10227
10228     if {[catch {
10229         set line [gets $f]
10230         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10231         # make sure it's an integer
10232         set cachedarcs [expr {int([lindex $line 1])}]
10233         if {$cachedarcs < 0} {error "bad number of arcs"}
10234         set nextarc 0
10235         set possible_seeds {}
10236         run readcache $f
10237     } err]} {
10238         dropcache $err
10239     }
10240     return 0
10241 }
10242
10243 proc dropcache {err} {
10244     global allcwait nextarc cachedarcs seeds
10245
10246     #puts "dropping cache ($err)"
10247     foreach v {arcnos arcout arcids arcstart arcend growing \
10248                    arctags archeads allparents allchildren} {
10249         global $v
10250         catch {unset $v}
10251     }
10252     set allcwait 0
10253     set nextarc 0
10254     set cachedarcs 0
10255     set seeds {}
10256     getallcommits
10257 }
10258
10259 proc writecache {f} {
10260     global cachearc cachedarcs allccache
10261     global arcstart arcend arcnos arcids arcout
10262
10263     set a $cachearc
10264     set lim $cachedarcs
10265     if {$lim - $a > 1000} {
10266         set lim [expr {$a + 1000}]
10267     }
10268     if {[catch {
10269         while {[incr a] <= $lim} {
10270             if {[info exists arcend($a)]} {
10271                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10272             } else {
10273                 puts $f [list $arcstart($a) {} $arcids($a)]
10274             }
10275         }
10276     } err]} {
10277         catch {close $f}
10278         catch {file delete $allccache}
10279         #puts "writing cache failed ($err)"
10280         return 0
10281     }
10282     set cachearc [expr {$a - 1}]
10283     if {$a > $cachedarcs} {
10284         puts $f "1"
10285         close $f
10286         return 0
10287     }
10288     return 1
10289 }
10290
10291 proc savecache {} {
10292     global nextarc cachedarcs cachearc allccache
10293
10294     if {$nextarc == $cachedarcs} return
10295     set cachearc 0
10296     set cachedarcs $nextarc
10297     catch {
10298         set f [open $allccache w]
10299         puts $f [list 1 $cachedarcs]
10300         run writecache $f
10301     }
10302 }
10303
10304 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10305 # or 0 if neither is true.
10306 proc anc_or_desc {a b} {
10307     global arcout arcstart arcend arcnos cached_isanc
10308
10309     if {$arcnos($a) eq $arcnos($b)} {
10310         # Both are on the same arc(s); either both are the same BMP,
10311         # or if one is not a BMP, the other is also not a BMP or is
10312         # the BMP at end of the arc (and it only has 1 incoming arc).
10313         # Or both can be BMPs with no incoming arcs.
10314         if {$a eq $b || $arcnos($a) eq {}} {
10315             return 0
10316         }
10317         # assert {[llength $arcnos($a)] == 1}
10318         set arc [lindex $arcnos($a) 0]
10319         set i [lsearch -exact $arcids($arc) $a]
10320         set j [lsearch -exact $arcids($arc) $b]
10321         if {$i < 0 || $i > $j} {
10322             return 1
10323         } else {
10324             return -1
10325         }
10326     }
10327
10328     if {![info exists arcout($a)]} {
10329         set arc [lindex $arcnos($a) 0]
10330         if {[info exists arcend($arc)]} {
10331             set aend $arcend($arc)
10332         } else {
10333             set aend {}
10334         }
10335         set a $arcstart($arc)
10336     } else {
10337         set aend $a
10338     }
10339     if {![info exists arcout($b)]} {
10340         set arc [lindex $arcnos($b) 0]
10341         if {[info exists arcend($arc)]} {
10342             set bend $arcend($arc)
10343         } else {
10344             set bend {}
10345         }
10346         set b $arcstart($arc)
10347     } else {
10348         set bend $b
10349     }
10350     if {$a eq $bend} {
10351         return 1
10352     }
10353     if {$b eq $aend} {
10354         return -1
10355     }
10356     if {[info exists cached_isanc($a,$bend)]} {
10357         if {$cached_isanc($a,$bend)} {
10358             return 1
10359         }
10360     }
10361     if {[info exists cached_isanc($b,$aend)]} {
10362         if {$cached_isanc($b,$aend)} {
10363             return -1
10364         }
10365         if {[info exists cached_isanc($a,$bend)]} {
10366             return 0
10367         }
10368     }
10369
10370     set todo [list $a $b]
10371     set anc($a) a
10372     set anc($b) b
10373     for {set i 0} {$i < [llength $todo]} {incr i} {
10374         set x [lindex $todo $i]
10375         if {$anc($x) eq {}} {
10376             continue
10377         }
10378         foreach arc $arcnos($x) {
10379             set xd $arcstart($arc)
10380             if {$xd eq $bend} {
10381                 set cached_isanc($a,$bend) 1
10382                 set cached_isanc($b,$aend) 0
10383                 return 1
10384             } elseif {$xd eq $aend} {
10385                 set cached_isanc($b,$aend) 1
10386                 set cached_isanc($a,$bend) 0
10387                 return -1
10388             }
10389             if {![info exists anc($xd)]} {
10390                 set anc($xd) $anc($x)
10391                 lappend todo $xd
10392             } elseif {$anc($xd) ne $anc($x)} {
10393                 set anc($xd) {}
10394             }
10395         }
10396     }
10397     set cached_isanc($a,$bend) 0
10398     set cached_isanc($b,$aend) 0
10399     return 0
10400 }
10401
10402 # This identifies whether $desc has an ancestor that is
10403 # a growing tip of the graph and which is not an ancestor of $anc
10404 # and returns 0 if so and 1 if not.
10405 # If we subsequently discover a tag on such a growing tip, and that
10406 # turns out to be a descendent of $anc (which it could, since we
10407 # don't necessarily see children before parents), then $desc
10408 # isn't a good choice to display as a descendent tag of
10409 # $anc (since it is the descendent of another tag which is
10410 # a descendent of $anc).  Similarly, $anc isn't a good choice to
10411 # display as a ancestor tag of $desc.
10412 #
10413 proc is_certain {desc anc} {
10414     global arcnos arcout arcstart arcend growing problems
10415
10416     set certain {}
10417     if {[llength $arcnos($anc)] == 1} {
10418         # tags on the same arc are certain
10419         if {$arcnos($desc) eq $arcnos($anc)} {
10420             return 1
10421         }
10422         if {![info exists arcout($anc)]} {
10423             # if $anc is partway along an arc, use the start of the arc instead
10424             set a [lindex $arcnos($anc) 0]
10425             set anc $arcstart($a)
10426         }
10427     }
10428     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10429         set x $desc
10430     } else {
10431         set a [lindex $arcnos($desc) 0]
10432         set x $arcend($a)
10433     }
10434     if {$x == $anc} {
10435         return 1
10436     }
10437     set anclist [list $x]
10438     set dl($x) 1
10439     set nnh 1
10440     set ngrowanc 0
10441     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10442         set x [lindex $anclist $i]
10443         if {$dl($x)} {
10444             incr nnh -1
10445         }
10446         set done($x) 1
10447         foreach a $arcout($x) {
10448             if {[info exists growing($a)]} {
10449                 if {![info exists growanc($x)] && $dl($x)} {
10450                     set growanc($x) 1
10451                     incr ngrowanc
10452                 }
10453             } else {
10454                 set y $arcend($a)
10455                 if {[info exists dl($y)]} {
10456                     if {$dl($y)} {
10457                         if {!$dl($x)} {
10458                             set dl($y) 0
10459                             if {![info exists done($y)]} {
10460                                 incr nnh -1
10461                             }
10462                             if {[info exists growanc($x)]} {
10463                                 incr ngrowanc -1
10464                             }
10465                             set xl [list $y]
10466                             for {set k 0} {$k < [llength $xl]} {incr k} {
10467                                 set z [lindex $xl $k]
10468                                 foreach c $arcout($z) {
10469                                     if {[info exists arcend($c)]} {
10470                                         set v $arcend($c)
10471                                         if {[info exists dl($v)] && $dl($v)} {
10472                                             set dl($v) 0
10473                                             if {![info exists done($v)]} {
10474                                                 incr nnh -1
10475                                             }
10476                                             if {[info exists growanc($v)]} {
10477                                                 incr ngrowanc -1
10478                                             }
10479                                             lappend xl $v
10480                                         }
10481                                     }
10482                                 }
10483                             }
10484                         }
10485                     }
10486                 } elseif {$y eq $anc || !$dl($x)} {
10487                     set dl($y) 0
10488                     lappend anclist $y
10489                 } else {
10490                     set dl($y) 1
10491                     lappend anclist $y
10492                     incr nnh
10493                 }
10494             }
10495         }
10496     }
10497     foreach x [array names growanc] {
10498         if {$dl($x)} {
10499             return 0
10500         }
10501         return 0
10502     }
10503     return 1
10504 }
10505
10506 proc validate_arctags {a} {
10507     global arctags idtags
10508
10509     set i -1
10510     set na $arctags($a)
10511     foreach id $arctags($a) {
10512         incr i
10513         if {![info exists idtags($id)]} {
10514             set na [lreplace $na $i $i]
10515             incr i -1
10516         }
10517     }
10518     set arctags($a) $na
10519 }
10520
10521 proc validate_archeads {a} {
10522     global archeads idheads
10523
10524     set i -1
10525     set na $archeads($a)
10526     foreach id $archeads($a) {
10527         incr i
10528         if {![info exists idheads($id)]} {
10529             set na [lreplace $na $i $i]
10530             incr i -1
10531         }
10532     }
10533     set archeads($a) $na
10534 }
10535
10536 # Return the list of IDs that have tags that are descendents of id,
10537 # ignoring IDs that are descendents of IDs already reported.
10538 proc desctags {id} {
10539     global arcnos arcstart arcids arctags idtags allparents
10540     global growing cached_dtags
10541
10542     if {![info exists allparents($id)]} {
10543         return {}
10544     }
10545     set t1 [clock clicks -milliseconds]
10546     set argid $id
10547     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10548         # part-way along an arc; check that arc first
10549         set a [lindex $arcnos($id) 0]
10550         if {$arctags($a) ne {}} {
10551             validate_arctags $a
10552             set i [lsearch -exact $arcids($a) $id]
10553             set tid {}
10554             foreach t $arctags($a) {
10555                 set j [lsearch -exact $arcids($a) $t]
10556                 if {$j >= $i} break
10557                 set tid $t
10558             }
10559             if {$tid ne {}} {
10560                 return $tid
10561             }
10562         }
10563         set id $arcstart($a)
10564         if {[info exists idtags($id)]} {
10565             return $id
10566         }
10567     }
10568     if {[info exists cached_dtags($id)]} {
10569         return $cached_dtags($id)
10570     }
10571
10572     set origid $id
10573     set todo [list $id]
10574     set queued($id) 1
10575     set nc 1
10576     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10577         set id [lindex $todo $i]
10578         set done($id) 1
10579         set ta [info exists hastaggedancestor($id)]
10580         if {!$ta} {
10581             incr nc -1
10582         }
10583         # ignore tags on starting node
10584         if {!$ta && $i > 0} {
10585             if {[info exists idtags($id)]} {
10586                 set tagloc($id) $id
10587                 set ta 1
10588             } elseif {[info exists cached_dtags($id)]} {
10589                 set tagloc($id) $cached_dtags($id)
10590                 set ta 1
10591             }
10592         }
10593         foreach a $arcnos($id) {
10594             set d $arcstart($a)
10595             if {!$ta && $arctags($a) ne {}} {
10596                 validate_arctags $a
10597                 if {$arctags($a) ne {}} {
10598                     lappend tagloc($id) [lindex $arctags($a) end]
10599                 }
10600             }
10601             if {$ta || $arctags($a) ne {}} {
10602                 set tomark [list $d]
10603                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10604                     set dd [lindex $tomark $j]
10605                     if {![info exists hastaggedancestor($dd)]} {
10606                         if {[info exists done($dd)]} {
10607                             foreach b $arcnos($dd) {
10608                                 lappend tomark $arcstart($b)
10609                             }
10610                             if {[info exists tagloc($dd)]} {
10611                                 unset tagloc($dd)
10612                             }
10613                         } elseif {[info exists queued($dd)]} {
10614                             incr nc -1
10615                         }
10616                         set hastaggedancestor($dd) 1
10617                     }
10618                 }
10619             }
10620             if {![info exists queued($d)]} {
10621                 lappend todo $d
10622                 set queued($d) 1
10623                 if {![info exists hastaggedancestor($d)]} {
10624                     incr nc
10625                 }
10626             }
10627         }
10628     }
10629     set tags {}
10630     foreach id [array names tagloc] {
10631         if {![info exists hastaggedancestor($id)]} {
10632             foreach t $tagloc($id) {
10633                 if {[lsearch -exact $tags $t] < 0} {
10634                     lappend tags $t
10635                 }
10636             }
10637         }
10638     }
10639     set t2 [clock clicks -milliseconds]
10640     set loopix $i
10641
10642     # remove tags that are descendents of other tags
10643     for {set i 0} {$i < [llength $tags]} {incr i} {
10644         set a [lindex $tags $i]
10645         for {set j 0} {$j < $i} {incr j} {
10646             set b [lindex $tags $j]
10647             set r [anc_or_desc $a $b]
10648             if {$r == 1} {
10649                 set tags [lreplace $tags $j $j]
10650                 incr j -1
10651                 incr i -1
10652             } elseif {$r == -1} {
10653                 set tags [lreplace $tags $i $i]
10654                 incr i -1
10655                 break
10656             }
10657         }
10658     }
10659
10660     if {[array names growing] ne {}} {
10661         # graph isn't finished, need to check if any tag could get
10662         # eclipsed by another tag coming later.  Simply ignore any
10663         # tags that could later get eclipsed.
10664         set ctags {}
10665         foreach t $tags {
10666             if {[is_certain $t $origid]} {
10667                 lappend ctags $t
10668             }
10669         }
10670         if {$tags eq $ctags} {
10671             set cached_dtags($origid) $tags
10672         } else {
10673             set tags $ctags
10674         }
10675     } else {
10676         set cached_dtags($origid) $tags
10677     }
10678     set t3 [clock clicks -milliseconds]
10679     if {0 && $t3 - $t1 >= 100} {
10680         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10681             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10682     }
10683     return $tags
10684 }
10685
10686 proc anctags {id} {
10687     global arcnos arcids arcout arcend arctags idtags allparents
10688     global growing cached_atags
10689
10690     if {![info exists allparents($id)]} {
10691         return {}
10692     }
10693     set t1 [clock clicks -milliseconds]
10694     set argid $id
10695     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10696         # part-way along an arc; check that arc first
10697         set a [lindex $arcnos($id) 0]
10698         if {$arctags($a) ne {}} {
10699             validate_arctags $a
10700             set i [lsearch -exact $arcids($a) $id]
10701             foreach t $arctags($a) {
10702                 set j [lsearch -exact $arcids($a) $t]
10703                 if {$j > $i} {
10704                     return $t
10705                 }
10706             }
10707         }
10708         if {![info exists arcend($a)]} {
10709             return {}
10710         }
10711         set id $arcend($a)
10712         if {[info exists idtags($id)]} {
10713             return $id
10714         }
10715     }
10716     if {[info exists cached_atags($id)]} {
10717         return $cached_atags($id)
10718     }
10719
10720     set origid $id
10721     set todo [list $id]
10722     set queued($id) 1
10723     set taglist {}
10724     set nc 1
10725     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10726         set id [lindex $todo $i]
10727         set done($id) 1
10728         set td [info exists hastaggeddescendent($id)]
10729         if {!$td} {
10730             incr nc -1
10731         }
10732         # ignore tags on starting node
10733         if {!$td && $i > 0} {
10734             if {[info exists idtags($id)]} {
10735                 set tagloc($id) $id
10736                 set td 1
10737             } elseif {[info exists cached_atags($id)]} {
10738                 set tagloc($id) $cached_atags($id)
10739                 set td 1
10740             }
10741         }
10742         foreach a $arcout($id) {
10743             if {!$td && $arctags($a) ne {}} {
10744                 validate_arctags $a
10745                 if {$arctags($a) ne {}} {
10746                     lappend tagloc($id) [lindex $arctags($a) 0]
10747                 }
10748             }
10749             if {![info exists arcend($a)]} continue
10750             set d $arcend($a)
10751             if {$td || $arctags($a) ne {}} {
10752                 set tomark [list $d]
10753                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10754                     set dd [lindex $tomark $j]
10755                     if {![info exists hastaggeddescendent($dd)]} {
10756                         if {[info exists done($dd)]} {
10757                             foreach b $arcout($dd) {
10758                                 if {[info exists arcend($b)]} {
10759                                     lappend tomark $arcend($b)
10760                                 }
10761                             }
10762                             if {[info exists tagloc($dd)]} {
10763                                 unset tagloc($dd)
10764                             }
10765                         } elseif {[info exists queued($dd)]} {
10766                             incr nc -1
10767                         }
10768                         set hastaggeddescendent($dd) 1
10769                     }
10770                 }
10771             }
10772             if {![info exists queued($d)]} {
10773                 lappend todo $d
10774                 set queued($d) 1
10775                 if {![info exists hastaggeddescendent($d)]} {
10776                     incr nc
10777                 }
10778             }
10779         }
10780     }
10781     set t2 [clock clicks -milliseconds]
10782     set loopix $i
10783     set tags {}
10784     foreach id [array names tagloc] {
10785         if {![info exists hastaggeddescendent($id)]} {
10786             foreach t $tagloc($id) {
10787                 if {[lsearch -exact $tags $t] < 0} {
10788                     lappend tags $t
10789                 }
10790             }
10791         }
10792     }
10793
10794     # remove tags that are ancestors of other tags
10795     for {set i 0} {$i < [llength $tags]} {incr i} {
10796         set a [lindex $tags $i]
10797         for {set j 0} {$j < $i} {incr j} {
10798             set b [lindex $tags $j]
10799             set r [anc_or_desc $a $b]
10800             if {$r == -1} {
10801                 set tags [lreplace $tags $j $j]
10802                 incr j -1
10803                 incr i -1
10804             } elseif {$r == 1} {
10805                 set tags [lreplace $tags $i $i]
10806                 incr i -1
10807                 break
10808             }
10809         }
10810     }
10811
10812     if {[array names growing] ne {}} {
10813         # graph isn't finished, need to check if any tag could get
10814         # eclipsed by another tag coming later.  Simply ignore any
10815         # tags that could later get eclipsed.
10816         set ctags {}
10817         foreach t $tags {
10818             if {[is_certain $origid $t]} {
10819                 lappend ctags $t
10820             }
10821         }
10822         if {$tags eq $ctags} {
10823             set cached_atags($origid) $tags
10824         } else {
10825             set tags $ctags
10826         }
10827     } else {
10828         set cached_atags($origid) $tags
10829     }
10830     set t3 [clock clicks -milliseconds]
10831     if {0 && $t3 - $t1 >= 100} {
10832         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10833             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10834     }
10835     return $tags
10836 }
10837
10838 # Return the list of IDs that have heads that are descendents of id,
10839 # including id itself if it has a head.
10840 proc descheads {id} {
10841     global arcnos arcstart arcids archeads idheads cached_dheads
10842     global allparents arcout
10843
10844     if {![info exists allparents($id)]} {
10845         return {}
10846     }
10847     set aret {}
10848     if {![info exists arcout($id)]} {
10849         # part-way along an arc; check it first
10850         set a [lindex $arcnos($id) 0]
10851         if {$archeads($a) ne {}} {
10852             validate_archeads $a
10853             set i [lsearch -exact $arcids($a) $id]
10854             foreach t $archeads($a) {
10855                 set j [lsearch -exact $arcids($a) $t]
10856                 if {$j > $i} break
10857                 lappend aret $t
10858             }
10859         }
10860         set id $arcstart($a)
10861     }
10862     set origid $id
10863     set todo [list $id]
10864     set seen($id) 1
10865     set ret {}
10866     for {set i 0} {$i < [llength $todo]} {incr i} {
10867         set id [lindex $todo $i]
10868         if {[info exists cached_dheads($id)]} {
10869             set ret [concat $ret $cached_dheads($id)]
10870         } else {
10871             if {[info exists idheads($id)]} {
10872                 lappend ret $id
10873             }
10874             foreach a $arcnos($id) {
10875                 if {$archeads($a) ne {}} {
10876                     validate_archeads $a
10877                     if {$archeads($a) ne {}} {
10878                         set ret [concat $ret $archeads($a)]
10879                     }
10880                 }
10881                 set d $arcstart($a)
10882                 if {![info exists seen($d)]} {
10883                     lappend todo $d
10884                     set seen($d) 1
10885                 }
10886             }
10887         }
10888     }
10889     set ret [lsort -unique $ret]
10890     set cached_dheads($origid) $ret
10891     return [concat $ret $aret]
10892 }
10893
10894 proc addedtag {id} {
10895     global arcnos arcout cached_dtags cached_atags
10896
10897     if {![info exists arcnos($id)]} return
10898     if {![info exists arcout($id)]} {
10899         recalcarc [lindex $arcnos($id) 0]
10900     }
10901     catch {unset cached_dtags}
10902     catch {unset cached_atags}
10903 }
10904
10905 proc addedhead {hid head} {
10906     global arcnos arcout cached_dheads
10907
10908     if {![info exists arcnos($hid)]} return
10909     if {![info exists arcout($hid)]} {
10910         recalcarc [lindex $arcnos($hid) 0]
10911     }
10912     catch {unset cached_dheads}
10913 }
10914
10915 proc removedhead {hid head} {
10916     global cached_dheads
10917
10918     catch {unset cached_dheads}
10919 }
10920
10921 proc movedhead {hid head} {
10922     global arcnos arcout cached_dheads
10923
10924     if {![info exists arcnos($hid)]} return
10925     if {![info exists arcout($hid)]} {
10926         recalcarc [lindex $arcnos($hid) 0]
10927     }
10928     catch {unset cached_dheads}
10929 }
10930
10931 proc changedrefs {} {
10932     global cached_dheads cached_dtags cached_atags cached_tagcontent
10933     global arctags archeads arcnos arcout idheads idtags
10934
10935     foreach id [concat [array names idheads] [array names idtags]] {
10936         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10937             set a [lindex $arcnos($id) 0]
10938             if {![info exists donearc($a)]} {
10939                 recalcarc $a
10940                 set donearc($a) 1
10941             }
10942         }
10943     }
10944     catch {unset cached_tagcontent}
10945     catch {unset cached_dtags}
10946     catch {unset cached_atags}
10947     catch {unset cached_dheads}
10948 }
10949
10950 proc rereadrefs {} {
10951     global idtags idheads idotherrefs mainheadid
10952
10953     set refids [concat [array names idtags] \
10954                     [array names idheads] [array names idotherrefs]]
10955     foreach id $refids {
10956         if {![info exists ref($id)]} {
10957             set ref($id) [listrefs $id]
10958         }
10959     }
10960     set oldmainhead $mainheadid
10961     readrefs
10962     changedrefs
10963     set refids [lsort -unique [concat $refids [array names idtags] \
10964                         [array names idheads] [array names idotherrefs]]]
10965     foreach id $refids {
10966         set v [listrefs $id]
10967         if {![info exists ref($id)] || $ref($id) != $v} {
10968             redrawtags $id
10969         }
10970     }
10971     if {$oldmainhead ne $mainheadid} {
10972         redrawtags $oldmainhead
10973         redrawtags $mainheadid
10974     }
10975     run refill_reflist
10976 }
10977
10978 proc listrefs {id} {
10979     global idtags idheads idotherrefs
10980
10981     set x {}
10982     if {[info exists idtags($id)]} {
10983         set x $idtags($id)
10984     }
10985     set y {}
10986     if {[info exists idheads($id)]} {
10987         set y $idheads($id)
10988     }
10989     set z {}
10990     if {[info exists idotherrefs($id)]} {
10991         set z $idotherrefs($id)
10992     }
10993     return [list $x $y $z]
10994 }
10995
10996 proc add_tag_ctext {tag} {
10997     global ctext cached_tagcontent tagids
10998
10999     if {![info exists cached_tagcontent($tag)]} {
11000         catch {
11001             set cached_tagcontent($tag) [exec git cat-file -p $tag]
11002         }
11003     }
11004     $ctext insert end "[mc "Tag"]: $tag\n" bold
11005     if {[info exists cached_tagcontent($tag)]} {
11006         set text $cached_tagcontent($tag)
11007     } else {
11008         set text "[mc "Id"]:  $tagids($tag)"
11009     }
11010     appendwithlinks $text {}
11011 }
11012
11013 proc showtag {tag isnew} {
11014     global ctext cached_tagcontent tagids linknum tagobjid
11015
11016     if {$isnew} {
11017         addtohistory [list showtag $tag 0] savectextpos
11018     }
11019     $ctext conf -state normal
11020     clear_ctext
11021     settabs 0
11022     set linknum 0
11023     add_tag_ctext $tag
11024     maybe_scroll_ctext 1
11025     $ctext conf -state disabled
11026     init_flist {}
11027 }
11028
11029 proc showtags {id isnew} {
11030     global idtags ctext linknum
11031
11032     if {$isnew} {
11033         addtohistory [list showtags $id 0] savectextpos
11034     }
11035     $ctext conf -state normal
11036     clear_ctext
11037     settabs 0
11038     set linknum 0
11039     set sep {}
11040     foreach tag $idtags($id) {
11041         $ctext insert end $sep
11042         add_tag_ctext $tag
11043         set sep "\n\n"
11044     }
11045     maybe_scroll_ctext 1
11046     $ctext conf -state disabled
11047     init_flist {}
11048 }
11049
11050 proc doquit {} {
11051     global stopped
11052     global gitktmpdir
11053
11054     set stopped 100
11055     savestuff .
11056     destroy .
11057
11058     if {[info exists gitktmpdir]} {
11059         catch {file delete -force $gitktmpdir}
11060     }
11061 }
11062
11063 proc mkfontdisp {font top which} {
11064     global fontattr fontpref $font NS use_ttk
11065
11066     set fontpref($font) [set $font]
11067     ${NS}::button $top.${font}but -text $which \
11068         -command [list choosefont $font $which]
11069     ${NS}::label $top.$font -relief flat -font $font \
11070         -text $fontattr($font,family) -justify left
11071     grid x $top.${font}but $top.$font -sticky w
11072 }
11073
11074 proc choosefont {font which} {
11075     global fontparam fontlist fonttop fontattr
11076     global prefstop NS
11077
11078     set fontparam(which) $which
11079     set fontparam(font) $font
11080     set fontparam(family) [font actual $font -family]
11081     set fontparam(size) $fontattr($font,size)
11082     set fontparam(weight) $fontattr($font,weight)
11083     set fontparam(slant) $fontattr($font,slant)
11084     set top .gitkfont
11085     set fonttop $top
11086     if {![winfo exists $top]} {
11087         font create sample
11088         eval font config sample [font actual $font]
11089         ttk_toplevel $top
11090         make_transient $top $prefstop
11091         wm title $top [mc "Gitk font chooser"]
11092         ${NS}::label $top.l -textvariable fontparam(which)
11093         pack $top.l -side top
11094         set fontlist [lsort [font families]]
11095         ${NS}::frame $top.f
11096         listbox $top.f.fam -listvariable fontlist \
11097             -yscrollcommand [list $top.f.sb set]
11098         bind $top.f.fam <<ListboxSelect>> selfontfam
11099         ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11100         pack $top.f.sb -side right -fill y
11101         pack $top.f.fam -side left -fill both -expand 1
11102         pack $top.f -side top -fill both -expand 1
11103         ${NS}::frame $top.g
11104         spinbox $top.g.size -from 4 -to 40 -width 4 \
11105             -textvariable fontparam(size) \
11106             -validatecommand {string is integer -strict %s}
11107         checkbutton $top.g.bold -padx 5 \
11108             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11109             -variable fontparam(weight) -onvalue bold -offvalue normal
11110         checkbutton $top.g.ital -padx 5 \
11111             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
11112             -variable fontparam(slant) -onvalue italic -offvalue roman
11113         pack $top.g.size $top.g.bold $top.g.ital -side left
11114         pack $top.g -side top
11115         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11116             -background white
11117         $top.c create text 100 25 -anchor center -text $which -font sample \
11118             -fill black -tags text
11119         bind $top.c <Configure> [list centertext $top.c]
11120         pack $top.c -side top -fill x
11121         ${NS}::frame $top.buts
11122         ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11123         ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11124         bind $top <Key-Return> fontok
11125         bind $top <Key-Escape> fontcan
11126         grid $top.buts.ok $top.buts.can
11127         grid columnconfigure $top.buts 0 -weight 1 -uniform a
11128         grid columnconfigure $top.buts 1 -weight 1 -uniform a
11129         pack $top.buts -side bottom -fill x
11130         trace add variable fontparam write chg_fontparam
11131     } else {
11132         raise $top
11133         $top.c itemconf text -text $which
11134     }
11135     set i [lsearch -exact $fontlist $fontparam(family)]
11136     if {$i >= 0} {
11137         $top.f.fam selection set $i
11138         $top.f.fam see $i
11139     }
11140 }
11141
11142 proc centertext {w} {
11143     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11144 }
11145
11146 proc fontok {} {
11147     global fontparam fontpref prefstop
11148
11149     set f $fontparam(font)
11150     set fontpref($f) [list $fontparam(family) $fontparam(size)]
11151     if {$fontparam(weight) eq "bold"} {
11152         lappend fontpref($f) "bold"
11153     }
11154     if {$fontparam(slant) eq "italic"} {
11155         lappend fontpref($f) "italic"
11156     }
11157     set w $prefstop.notebook.fonts.$f
11158     $w conf -text $fontparam(family) -font $fontpref($f)
11159
11160     fontcan
11161 }
11162
11163 proc fontcan {} {
11164     global fonttop fontparam
11165
11166     if {[info exists fonttop]} {
11167         catch {destroy $fonttop}
11168         catch {font delete sample}
11169         unset fonttop
11170         unset fontparam
11171     }
11172 }
11173
11174 if {[package vsatisfies [package provide Tk] 8.6]} {
11175     # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11176     # function to make use of it.
11177     proc choosefont {font which} {
11178         tk fontchooser configure -title $which -font $font \
11179             -command [list on_choosefont $font $which]
11180         tk fontchooser show
11181     }
11182     proc on_choosefont {font which newfont} {
11183         global fontparam
11184         puts stderr "$font $newfont"
11185         array set f [font actual $newfont]
11186         set fontparam(which) $which
11187         set fontparam(font) $font
11188         set fontparam(family) $f(-family)
11189         set fontparam(size) $f(-size)
11190         set fontparam(weight) $f(-weight)
11191         set fontparam(slant) $f(-slant)
11192         fontok
11193     }
11194 }
11195
11196 proc selfontfam {} {
11197     global fonttop fontparam
11198
11199     set i [$fonttop.f.fam curselection]
11200     if {$i ne {}} {
11201         set fontparam(family) [$fonttop.f.fam get $i]
11202     }
11203 }
11204
11205 proc chg_fontparam {v sub op} {
11206     global fontparam
11207
11208     font config sample -$sub $fontparam($sub)
11209 }
11210
11211 # Create a property sheet tab page
11212 proc create_prefs_page {w} {
11213     global NS
11214     set parent [join [lrange [split $w .] 0 end-1] .]
11215     if {[winfo class $parent] eq "TNotebook"} {
11216         ${NS}::frame $w
11217     } else {
11218         ${NS}::labelframe $w
11219     }
11220 }
11221
11222 proc prefspage_general {notebook} {
11223     global NS maxwidth maxgraphpct showneartags showlocalchanges
11224     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11225     global hideremotes want_ttk have_ttk maxrefs
11226
11227     set page [create_prefs_page $notebook.general]
11228
11229     ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11230     grid $page.ldisp - -sticky w -pady 10
11231     ${NS}::label $page.spacer -text " "
11232     ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11233     spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11234     grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11235     ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11236     spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11237     grid x $page.maxpctl $page.maxpct -sticky w
11238     ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11239         -variable showlocalchanges
11240     grid x $page.showlocal -sticky w
11241     ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11242         -variable autoselect
11243     spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11244     grid x $page.autoselect $page.autosellen -sticky w
11245     ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11246         -variable hideremotes
11247     grid x $page.hideremotes -sticky w
11248
11249     ${NS}::label $page.ddisp -text [mc "Diff display options"]
11250     grid $page.ddisp - -sticky w -pady 10
11251     ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11252     spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11253     grid x $page.tabstopl $page.tabstop -sticky w
11254     ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11255         -variable showneartags
11256     grid x $page.ntag -sticky w
11257     ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11258     spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11259     grid x $page.maxrefsl $page.maxrefs -sticky w
11260     ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11261         -variable limitdiffs
11262     grid x $page.ldiff -sticky w
11263     ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11264         -variable perfile_attrs
11265     grid x $page.lattr -sticky w
11266
11267     ${NS}::entry $page.extdifft -textvariable extdifftool
11268     ${NS}::frame $page.extdifff
11269     ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11270     ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11271     pack $page.extdifff.l $page.extdifff.b -side left
11272     pack configure $page.extdifff.l -padx 10
11273     grid x $page.extdifff $page.extdifft -sticky ew
11274
11275     ${NS}::label $page.lgen -text [mc "General options"]
11276     grid $page.lgen - -sticky w -pady 10
11277     ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11278         -text [mc "Use themed widgets"]
11279     if {$have_ttk} {
11280         ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11281     } else {
11282         ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11283     }
11284     grid x $page.want_ttk $page.ttk_note -sticky w
11285     return $page
11286 }
11287
11288 proc prefspage_colors {notebook} {
11289     global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11290
11291     set page [create_prefs_page $notebook.colors]
11292
11293     ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11294     grid $page.cdisp - -sticky w -pady 10
11295     label $page.ui -padx 40 -relief sunk -background $uicolor
11296     ${NS}::button $page.uibut -text [mc "Interface"] \
11297        -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11298     grid x $page.uibut $page.ui -sticky w
11299     label $page.bg -padx 40 -relief sunk -background $bgcolor
11300     ${NS}::button $page.bgbut -text [mc "Background"] \
11301         -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11302     grid x $page.bgbut $page.bg -sticky w
11303     label $page.fg -padx 40 -relief sunk -background $fgcolor
11304     ${NS}::button $page.fgbut -text [mc "Foreground"] \
11305         -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11306     grid x $page.fgbut $page.fg -sticky w
11307     label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11308     ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11309         -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11310                       [list $ctext tag conf d0 -foreground]]
11311     grid x $page.diffoldbut $page.diffold -sticky w
11312     label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11313     ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11314         -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11315                       [list $ctext tag conf dresult -foreground]]
11316     grid x $page.diffnewbut $page.diffnew -sticky w
11317     label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11318     ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11319         -command [list choosecolor diffcolors 2 $page.hunksep \
11320                       [mc "diff hunk header"] \
11321                       [list $ctext tag conf hunksep -foreground]]
11322     grid x $page.hunksepbut $page.hunksep -sticky w
11323     label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11324     ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11325         -command [list choosecolor markbgcolor {} $page.markbgsep \
11326                       [mc "marked line background"] \
11327                       [list $ctext tag conf omark -background]]
11328     grid x $page.markbgbut $page.markbgsep -sticky w
11329     label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11330     ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11331         -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11332     grid x $page.selbgbut $page.selbgsep -sticky w
11333     return $page
11334 }
11335
11336 proc prefspage_fonts {notebook} {
11337     global NS
11338     set page [create_prefs_page $notebook.fonts]
11339     ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11340     grid $page.cfont - -sticky w -pady 10
11341     mkfontdisp mainfont $page [mc "Main font"]
11342     mkfontdisp textfont $page [mc "Diff display font"]
11343     mkfontdisp uifont $page [mc "User interface font"]
11344     return $page
11345 }
11346
11347 proc doprefs {} {
11348     global maxwidth maxgraphpct use_ttk NS
11349     global oldprefs prefstop showneartags showlocalchanges
11350     global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11351     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11352     global hideremotes want_ttk have_ttk
11353
11354     set top .gitkprefs
11355     set prefstop $top
11356     if {[winfo exists $top]} {
11357         raise $top
11358         return
11359     }
11360     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11361                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11362         set oldprefs($v) [set $v]
11363     }
11364     ttk_toplevel $top
11365     wm title $top [mc "Gitk preferences"]
11366     make_transient $top .
11367
11368     if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11369         set notebook [ttk::notebook $top.notebook]
11370     } else {
11371         set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11372     }
11373
11374     lappend pages [prefspage_general $notebook] [mc "General"]
11375     lappend pages [prefspage_colors $notebook] [mc "Colors"]
11376     lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11377     set col 0
11378     foreach {page title} $pages {
11379         if {$use_notebook} {
11380             $notebook add $page -text $title
11381         } else {
11382             set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11383                          -text $title -command [list raise $page]]
11384             $page configure -text $title
11385             grid $btn -row 0 -column [incr col] -sticky w
11386             grid $page -row 1 -column 0 -sticky news -columnspan 100
11387         }
11388     }
11389
11390     if {!$use_notebook} {
11391         grid columnconfigure $notebook 0 -weight 1
11392         grid rowconfigure $notebook 1 -weight 1
11393         raise [lindex $pages 0]
11394     }
11395
11396     grid $notebook -sticky news -padx 2 -pady 2
11397     grid rowconfigure $top 0 -weight 1
11398     grid columnconfigure $top 0 -weight 1
11399
11400     ${NS}::frame $top.buts
11401     ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11402     ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11403     bind $top <Key-Return> prefsok
11404     bind $top <Key-Escape> prefscan
11405     grid $top.buts.ok $top.buts.can
11406     grid columnconfigure $top.buts 0 -weight 1 -uniform a
11407     grid columnconfigure $top.buts 1 -weight 1 -uniform a
11408     grid $top.buts - - -pady 10 -sticky ew
11409     grid columnconfigure $top 2 -weight 1
11410     bind $top <Visibility> [list focus $top.buts.ok]
11411 }
11412
11413 proc choose_extdiff {} {
11414     global extdifftool
11415
11416     set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11417     if {$prog ne {}} {
11418         set extdifftool $prog
11419     }
11420 }
11421
11422 proc choosecolor {v vi w x cmd} {
11423     global $v
11424
11425     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11426                -title [mc "Gitk: choose color for %s" $x]]
11427     if {$c eq {}} return
11428     $w conf -background $c
11429     lset $v $vi $c
11430     eval $cmd $c
11431 }
11432
11433 proc setselbg {c} {
11434     global bglist cflist
11435     foreach w $bglist {
11436         $w configure -selectbackground $c
11437     }
11438     $cflist tag configure highlight \
11439         -background [$cflist cget -selectbackground]
11440     allcanvs itemconf secsel -fill $c
11441 }
11442
11443 # This sets the background color and the color scheme for the whole UI.
11444 # For some reason, tk_setPalette chooses a nasty dark red for selectColor
11445 # if we don't specify one ourselves, which makes the checkbuttons and
11446 # radiobuttons look bad.  This chooses white for selectColor if the
11447 # background color is light, or black if it is dark.
11448 proc setui {c} {
11449     if {[tk windowingsystem] eq "win32"} { return }
11450     set bg [winfo rgb . $c]
11451     set selc black
11452     if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11453         set selc white
11454     }
11455     tk_setPalette background $c selectColor $selc
11456 }
11457
11458 proc setbg {c} {
11459     global bglist
11460
11461     foreach w $bglist {
11462         $w conf -background $c
11463     }
11464 }
11465
11466 proc setfg {c} {
11467     global fglist canv
11468
11469     foreach w $fglist {
11470         $w conf -foreground $c
11471     }
11472     allcanvs itemconf text -fill $c
11473     $canv itemconf circle -outline $c
11474     $canv itemconf markid -outline $c
11475 }
11476
11477 proc prefscan {} {
11478     global oldprefs prefstop
11479
11480     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11481                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11482         global $v
11483         set $v $oldprefs($v)
11484     }
11485     catch {destroy $prefstop}
11486     unset prefstop
11487     fontcan
11488 }
11489
11490 proc prefsok {} {
11491     global maxwidth maxgraphpct
11492     global oldprefs prefstop showneartags showlocalchanges
11493     global fontpref mainfont textfont uifont
11494     global limitdiffs treediffs perfile_attrs
11495     global hideremotes
11496
11497     catch {destroy $prefstop}
11498     unset prefstop
11499     fontcan
11500     set fontchanged 0
11501     if {$mainfont ne $fontpref(mainfont)} {
11502         set mainfont $fontpref(mainfont)
11503         parsefont mainfont $mainfont
11504         eval font configure mainfont [fontflags mainfont]
11505         eval font configure mainfontbold [fontflags mainfont 1]
11506         setcoords
11507         set fontchanged 1
11508     }
11509     if {$textfont ne $fontpref(textfont)} {
11510         set textfont $fontpref(textfont)
11511         parsefont textfont $textfont
11512         eval font configure textfont [fontflags textfont]
11513         eval font configure textfontbold [fontflags textfont 1]
11514     }
11515     if {$uifont ne $fontpref(uifont)} {
11516         set uifont $fontpref(uifont)
11517         parsefont uifont $uifont
11518         eval font configure uifont [fontflags uifont]
11519     }
11520     settabs
11521     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11522         if {$showlocalchanges} {
11523             doshowlocalchanges
11524         } else {
11525             dohidelocalchanges
11526         }
11527     }
11528     if {$limitdiffs != $oldprefs(limitdiffs) ||
11529         ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11530         # treediffs elements are limited by path;
11531         # won't have encodings cached if perfile_attrs was just turned on
11532         catch {unset treediffs}
11533     }
11534     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11535         || $maxgraphpct != $oldprefs(maxgraphpct)} {
11536         redisplay
11537     } elseif {$showneartags != $oldprefs(showneartags) ||
11538           $limitdiffs != $oldprefs(limitdiffs)} {
11539         reselectline
11540     }
11541     if {$hideremotes != $oldprefs(hideremotes)} {
11542         rereadrefs
11543     }
11544 }
11545
11546 proc formatdate {d} {
11547     global datetimeformat
11548     if {$d ne {}} {
11549         set d [clock format [lindex $d 0] -format $datetimeformat]
11550     }
11551     return $d
11552 }
11553
11554 # This list of encoding names and aliases is distilled from
11555 # http://www.iana.org/assignments/character-sets.
11556 # Not all of them are supported by Tcl.
11557 set encoding_aliases {
11558     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11559       ISO646-US US-ASCII us IBM367 cp367 csASCII }
11560     { ISO-10646-UTF-1 csISO10646UTF1 }
11561     { ISO_646.basic:1983 ref csISO646basic1983 }
11562     { INVARIANT csINVARIANT }
11563     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11564     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11565     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11566     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11567     { NATS-DANO iso-ir-9-1 csNATSDANO }
11568     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11569     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11570     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11571     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11572     { ISO-2022-KR csISO2022KR }
11573     { EUC-KR csEUCKR }
11574     { ISO-2022-JP csISO2022JP }
11575     { ISO-2022-JP-2 csISO2022JP2 }
11576     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11577       csISO13JISC6220jp }
11578     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11579     { IT iso-ir-15 ISO646-IT csISO15Italian }
11580     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11581     { ES iso-ir-17 ISO646-ES csISO17Spanish }
11582     { greek7-old iso-ir-18 csISO18Greek7Old }
11583     { latin-greek iso-ir-19 csISO19LatinGreek }
11584     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11585     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11586     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11587     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11588     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11589     { BS_viewdata iso-ir-47 csISO47BSViewdata }
11590     { INIS iso-ir-49 csISO49INIS }
11591     { INIS-8 iso-ir-50 csISO50INIS8 }
11592     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11593     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11594     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11595     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11596     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11597     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11598       csISO60Norwegian1 }
11599     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11600     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11601     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11602     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11603     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11604     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11605     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11606     { greek7 iso-ir-88 csISO88Greek7 }
11607     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11608     { iso-ir-90 csISO90 }
11609     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11610     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11611       csISO92JISC62991984b }
11612     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11613     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11614     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11615       csISO95JIS62291984handadd }
11616     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11617     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11618     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11619     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11620       CP819 csISOLatin1 }
11621     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11622     { T.61-7bit iso-ir-102 csISO102T617bit }
11623     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11624     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11625     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11626     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11627     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11628     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11629     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11630     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11631       arabic csISOLatinArabic }
11632     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11633     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11634     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11635       greek greek8 csISOLatinGreek }
11636     { T.101-G2 iso-ir-128 csISO128T101G2 }
11637     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11638       csISOLatinHebrew }
11639     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11640     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11641     { CSN_369103 iso-ir-139 csISO139CSN369103 }
11642     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11643     { ISO_6937-2-add iso-ir-142 csISOTextComm }
11644     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11645     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11646       csISOLatinCyrillic }
11647     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11648     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11649     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11650     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11651     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11652     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11653     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11654     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11655     { ISO_10367-box iso-ir-155 csISO10367Box }
11656     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11657     { latin-lap lap iso-ir-158 csISO158Lap }
11658     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11659     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11660     { us-dk csUSDK }
11661     { dk-us csDKUS }
11662     { JIS_X0201 X0201 csHalfWidthKatakana }
11663     { KSC5636 ISO646-KR csKSC5636 }
11664     { ISO-10646-UCS-2 csUnicode }
11665     { ISO-10646-UCS-4 csUCS4 }
11666     { DEC-MCS dec csDECMCS }
11667     { hp-roman8 roman8 r8 csHPRoman8 }
11668     { macintosh mac csMacintosh }
11669     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11670       csIBM037 }
11671     { IBM038 EBCDIC-INT cp038 csIBM038 }
11672     { IBM273 CP273 csIBM273 }
11673     { IBM274 EBCDIC-BE CP274 csIBM274 }
11674     { IBM275 EBCDIC-BR cp275 csIBM275 }
11675     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11676     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11677     { IBM280 CP280 ebcdic-cp-it csIBM280 }
11678     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11679     { IBM284 CP284 ebcdic-cp-es csIBM284 }
11680     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11681     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11682     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11683     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11684     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11685     { IBM424 cp424 ebcdic-cp-he csIBM424 }
11686     { IBM437 cp437 437 csPC8CodePage437 }
11687     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11688     { IBM775 cp775 csPC775Baltic }
11689     { IBM850 cp850 850 csPC850Multilingual }
11690     { IBM851 cp851 851 csIBM851 }
11691     { IBM852 cp852 852 csPCp852 }
11692     { IBM855 cp855 855 csIBM855 }
11693     { IBM857 cp857 857 csIBM857 }
11694     { IBM860 cp860 860 csIBM860 }
11695     { IBM861 cp861 861 cp-is csIBM861 }
11696     { IBM862 cp862 862 csPC862LatinHebrew }
11697     { IBM863 cp863 863 csIBM863 }
11698     { IBM864 cp864 csIBM864 }
11699     { IBM865 cp865 865 csIBM865 }
11700     { IBM866 cp866 866 csIBM866 }
11701     { IBM868 CP868 cp-ar csIBM868 }
11702     { IBM869 cp869 869 cp-gr csIBM869 }
11703     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11704     { IBM871 CP871 ebcdic-cp-is csIBM871 }
11705     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11706     { IBM891 cp891 csIBM891 }
11707     { IBM903 cp903 csIBM903 }
11708     { IBM904 cp904 904 csIBBM904 }
11709     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11710     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11711     { IBM1026 CP1026 csIBM1026 }
11712     { EBCDIC-AT-DE csIBMEBCDICATDE }
11713     { EBCDIC-AT-DE-A csEBCDICATDEA }
11714     { EBCDIC-CA-FR csEBCDICCAFR }
11715     { EBCDIC-DK-NO csEBCDICDKNO }
11716     { EBCDIC-DK-NO-A csEBCDICDKNOA }
11717     { EBCDIC-FI-SE csEBCDICFISE }
11718     { EBCDIC-FI-SE-A csEBCDICFISEA }
11719     { EBCDIC-FR csEBCDICFR }
11720     { EBCDIC-IT csEBCDICIT }
11721     { EBCDIC-PT csEBCDICPT }
11722     { EBCDIC-ES csEBCDICES }
11723     { EBCDIC-ES-A csEBCDICESA }
11724     { EBCDIC-ES-S csEBCDICESS }
11725     { EBCDIC-UK csEBCDICUK }
11726     { EBCDIC-US csEBCDICUS }
11727     { UNKNOWN-8BIT csUnknown8BiT }
11728     { MNEMONIC csMnemonic }
11729     { MNEM csMnem }
11730     { VISCII csVISCII }
11731     { VIQR csVIQR }
11732     { KOI8-R csKOI8R }
11733     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11734     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11735     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11736     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11737     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11738     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11739     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11740     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11741     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11742     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11743     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11744     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11745     { IBM1047 IBM-1047 }
11746     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11747     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11748     { UNICODE-1-1 csUnicode11 }
11749     { CESU-8 csCESU-8 }
11750     { BOCU-1 csBOCU-1 }
11751     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11752     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11753       l8 }
11754     { ISO-8859-15 ISO_8859-15 Latin-9 }
11755     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11756     { GBK CP936 MS936 windows-936 }
11757     { JIS_Encoding csJISEncoding }
11758     { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11759     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11760       EUC-JP }
11761     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11762     { ISO-10646-UCS-Basic csUnicodeASCII }
11763     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11764     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11765     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11766     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11767     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11768     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11769     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11770     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11771     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11772     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11773     { Adobe-Standard-Encoding csAdobeStandardEncoding }
11774     { Ventura-US csVenturaUS }
11775     { Ventura-International csVenturaInternational }
11776     { PC8-Danish-Norwegian csPC8DanishNorwegian }
11777     { PC8-Turkish csPC8Turkish }
11778     { IBM-Symbols csIBMSymbols }
11779     { IBM-Thai csIBMThai }
11780     { HP-Legal csHPLegal }
11781     { HP-Pi-font csHPPiFont }
11782     { HP-Math8 csHPMath8 }
11783     { Adobe-Symbol-Encoding csHPPSMath }
11784     { HP-DeskTop csHPDesktop }
11785     { Ventura-Math csVenturaMath }
11786     { Microsoft-Publishing csMicrosoftPublishing }
11787     { Windows-31J csWindows31J }
11788     { GB2312 csGB2312 }
11789     { Big5 csBig5 }
11790 }
11791
11792 proc tcl_encoding {enc} {
11793     global encoding_aliases tcl_encoding_cache
11794     if {[info exists tcl_encoding_cache($enc)]} {
11795         return $tcl_encoding_cache($enc)
11796     }
11797     set names [encoding names]
11798     set lcnames [string tolower $names]
11799     set enc [string tolower $enc]
11800     set i [lsearch -exact $lcnames $enc]
11801     if {$i < 0} {
11802         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11803         if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11804             set i [lsearch -exact $lcnames $encx]
11805         }
11806     }
11807     if {$i < 0} {
11808         foreach l $encoding_aliases {
11809             set ll [string tolower $l]
11810             if {[lsearch -exact $ll $enc] < 0} continue
11811             # look through the aliases for one that tcl knows about
11812             foreach e $ll {
11813                 set i [lsearch -exact $lcnames $e]
11814                 if {$i < 0} {
11815                     if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11816                         set i [lsearch -exact $lcnames $ex]
11817                     }
11818                 }
11819                 if {$i >= 0} break
11820             }
11821             break
11822         }
11823     }
11824     set tclenc {}
11825     if {$i >= 0} {
11826         set tclenc [lindex $names $i]
11827     }
11828     set tcl_encoding_cache($enc) $tclenc
11829     return $tclenc
11830 }
11831
11832 proc gitattr {path attr default} {
11833     global path_attr_cache
11834     if {[info exists path_attr_cache($attr,$path)]} {
11835         set r $path_attr_cache($attr,$path)
11836     } else {
11837         set r "unspecified"
11838         if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11839             regexp "(.*): $attr: (.*)" $line m f r
11840         }
11841         set path_attr_cache($attr,$path) $r
11842     }
11843     if {$r eq "unspecified"} {
11844         return $default
11845     }
11846     return $r
11847 }
11848
11849 proc cache_gitattr {attr pathlist} {
11850     global path_attr_cache
11851     set newlist {}
11852     foreach path $pathlist {
11853         if {![info exists path_attr_cache($attr,$path)]} {
11854             lappend newlist $path
11855         }
11856     }
11857     set lim 1000
11858     if {[tk windowingsystem] == "win32"} {
11859         # windows has a 32k limit on the arguments to a command...
11860         set lim 30
11861     }
11862     while {$newlist ne {}} {
11863         set head [lrange $newlist 0 [expr {$lim - 1}]]
11864         set newlist [lrange $newlist $lim end]
11865         if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11866             foreach row [split $rlist "\n"] {
11867                 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11868                     if {[string index $path 0] eq "\""} {
11869                         set path [encoding convertfrom [lindex $path 0]]
11870                     }
11871                     set path_attr_cache($attr,$path) $value
11872                 }
11873             }
11874         }
11875     }
11876 }
11877
11878 proc get_path_encoding {path} {
11879     global gui_encoding perfile_attrs
11880     set tcl_enc $gui_encoding
11881     if {$path ne {} && $perfile_attrs} {
11882         set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11883         if {$enc2 ne {}} {
11884             set tcl_enc $enc2
11885         }
11886     }
11887     return $tcl_enc
11888 }
11889
11890 # First check that Tcl/Tk is recent enough
11891 if {[catch {package require Tk 8.4} err]} {
11892     show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11893                      Gitk requires at least Tcl/Tk 8.4." list
11894     exit 1
11895 }
11896
11897 # on OSX bring the current Wish process window to front
11898 if {[tk windowingsystem] eq "aqua"} {
11899     exec osascript -e [format {
11900         tell application "System Events"
11901             set frontmost of processes whose unix id is %d to true
11902         end tell
11903     } [pid] ]
11904 }
11905
11906 # Unset GIT_TRACE var if set
11907 if { [info exists ::env(GIT_TRACE)] } {
11908     unset ::env(GIT_TRACE)
11909 }
11910
11911 # defaults...
11912 set wrcomcmd "git diff-tree --stdin -p --pretty"
11913
11914 set gitencoding {}
11915 catch {
11916     set gitencoding [exec git config --get i18n.commitencoding]
11917 }
11918 catch {
11919     set gitencoding [exec git config --get i18n.logoutputencoding]
11920 }
11921 if {$gitencoding == ""} {
11922     set gitencoding "utf-8"
11923 }
11924 set tclencoding [tcl_encoding $gitencoding]
11925 if {$tclencoding == {}} {
11926     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11927 }
11928
11929 set gui_encoding [encoding system]
11930 catch {
11931     set enc [exec git config --get gui.encoding]
11932     if {$enc ne {}} {
11933         set tclenc [tcl_encoding $enc]
11934         if {$tclenc ne {}} {
11935             set gui_encoding $tclenc
11936         } else {
11937             puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11938         }
11939     }
11940 }
11941
11942 set log_showroot true
11943 catch {
11944     set log_showroot [exec git config --bool --get log.showroot]
11945 }
11946
11947 if {[tk windowingsystem] eq "aqua"} {
11948     set mainfont {{Lucida Grande} 9}
11949     set textfont {Monaco 9}
11950     set uifont {{Lucida Grande} 9 bold}
11951 } elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
11952     # fontconfig!
11953     set mainfont {sans 9}
11954     set textfont {monospace 9}
11955     set uifont {sans 9 bold}
11956 } else {
11957     set mainfont {Helvetica 9}
11958     set textfont {Courier 9}
11959     set uifont {Helvetica 9 bold}
11960 }
11961 set tabstop 8
11962 set findmergefiles 0
11963 set maxgraphpct 50
11964 set maxwidth 16
11965 set revlistorder 0
11966 set fastdate 0
11967 set uparrowlen 5
11968 set downarrowlen 5
11969 set mingaplen 100
11970 set cmitmode "patch"
11971 set wrapcomment "none"
11972 set showneartags 1
11973 set hideremotes 0
11974 set maxrefs 20
11975 set maxlinelen 200
11976 set showlocalchanges 1
11977 set limitdiffs 1
11978 set datetimeformat "%Y-%m-%d %H:%M:%S"
11979 set autoselect 1
11980 set autosellen 40
11981 set perfile_attrs 0
11982 set want_ttk 1
11983
11984 if {[tk windowingsystem] eq "aqua"} {
11985     set extdifftool "opendiff"
11986 } else {
11987     set extdifftool "meld"
11988 }
11989
11990 set colors {green red blue magenta darkgrey brown orange}
11991 if {[tk windowingsystem] eq "win32"} {
11992     set uicolor SystemButtonFace
11993     set uifgcolor SystemButtonText
11994     set uifgdisabledcolor SystemDisabledText
11995     set bgcolor SystemWindow
11996     set fgcolor SystemWindowText
11997     set selectbgcolor SystemHighlight
11998 } else {
11999     set uicolor grey85
12000     set uifgcolor black
12001     set uifgdisabledcolor "#999"
12002     set bgcolor white
12003     set fgcolor black
12004     set selectbgcolor gray85
12005 }
12006 set diffcolors {red "#00a000" blue}
12007 set diffcontext 3
12008 set mergecolors {red blue green purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12009 set ignorespace 0
12010 set worddiff ""
12011 set markbgcolor "#e0e0ff"
12012
12013 set headbgcolor green
12014 set headfgcolor black
12015 set headoutlinecolor black
12016 set remotebgcolor #ffddaa
12017 set tagbgcolor yellow
12018 set tagfgcolor black
12019 set tagoutlinecolor black
12020 set reflinecolor black
12021 set filesepbgcolor #aaaaaa
12022 set filesepfgcolor black
12023 set linehoverbgcolor #ffff80
12024 set linehoverfgcolor black
12025 set linehoveroutlinecolor black
12026 set mainheadcirclecolor yellow
12027 set workingfilescirclecolor red
12028 set indexcirclecolor green
12029 set circlecolors {white blue gray blue blue}
12030 set linkfgcolor blue
12031 set circleoutlinecolor $fgcolor
12032 set foundbgcolor yellow
12033 set currentsearchhitbgcolor orange
12034
12035 # button for popping up context menus
12036 if {[tk windowingsystem] eq "aqua"} {
12037     set ctxbut <Button-2>
12038 } else {
12039     set ctxbut <Button-3>
12040 }
12041
12042 ## For msgcat loading, first locate the installation location.
12043 if { [info exists ::env(GITK_MSGSDIR)] } {
12044     ## Msgsdir was manually set in the environment.
12045     set gitk_msgsdir $::env(GITK_MSGSDIR)
12046 } else {
12047     ## Let's guess the prefix from argv0.
12048     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12049     set gitk_libdir [file join $gitk_prefix share gitk lib]
12050     set gitk_msgsdir [file join $gitk_libdir msgs]
12051     unset gitk_prefix
12052 }
12053
12054 ## Internationalization (i18n) through msgcat and gettext. See
12055 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12056 package require msgcat
12057 namespace import ::msgcat::mc
12058 ## And eventually load the actual message catalog
12059 ::msgcat::mcload $gitk_msgsdir
12060
12061 catch {source ~/.gitk}
12062
12063 parsefont mainfont $mainfont
12064 eval font create mainfont [fontflags mainfont]
12065 eval font create mainfontbold [fontflags mainfont 1]
12066
12067 parsefont textfont $textfont
12068 eval font create textfont [fontflags textfont]
12069 eval font create textfontbold [fontflags textfont 1]
12070
12071 parsefont uifont $uifont
12072 eval font create uifont [fontflags uifont]
12073
12074 setui $uicolor
12075
12076 setoptions
12077
12078 # check that we can find a .git directory somewhere...
12079 if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12080     show_error {} . [mc "Cannot find a git repository here."]
12081     exit 1
12082 }
12083
12084 set selecthead {}
12085 set selectheadid {}
12086
12087 set revtreeargs {}
12088 set cmdline_files {}
12089 set i 0
12090 set revtreeargscmd {}
12091 foreach arg $argv {
12092     switch -glob -- $arg {
12093         "" { }
12094         "--" {
12095             set cmdline_files [lrange $argv [expr {$i + 1}] end]
12096             break
12097         }
12098         "--select-commit=*" {
12099             set selecthead [string range $arg 16 end]
12100         }
12101         "--argscmd=*" {
12102             set revtreeargscmd [string range $arg 10 end]
12103         }
12104         default {
12105             lappend revtreeargs $arg
12106         }
12107     }
12108     incr i
12109 }
12110
12111 if {$selecthead eq "HEAD"} {
12112     set selecthead {}
12113 }
12114
12115 if {$i >= [llength $argv] && $revtreeargs ne {}} {
12116     # no -- on command line, but some arguments (other than --argscmd)
12117     if {[catch {
12118         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12119         set cmdline_files [split $f "\n"]
12120         set n [llength $cmdline_files]
12121         set revtreeargs [lrange $revtreeargs 0 end-$n]
12122         # Unfortunately git rev-parse doesn't produce an error when
12123         # something is both a revision and a filename.  To be consistent
12124         # with git log and git rev-list, check revtreeargs for filenames.
12125         foreach arg $revtreeargs {
12126             if {[file exists $arg]} {
12127                 show_error {} . [mc "Ambiguous argument '%s': both revision\
12128                                  and filename" $arg]
12129                 exit 1
12130             }
12131         }
12132     } err]} {
12133         # unfortunately we get both stdout and stderr in $err,
12134         # so look for "fatal:".
12135         set i [string first "fatal:" $err]
12136         if {$i > 0} {
12137             set err [string range $err [expr {$i + 6}] end]
12138         }
12139         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12140         exit 1
12141     }
12142 }
12143
12144 set nullid "0000000000000000000000000000000000000000"
12145 set nullid2 "0000000000000000000000000000000000000001"
12146 set nullfile "/dev/null"
12147
12148 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12149 if {![info exists have_ttk]} {
12150     set have_ttk [llength [info commands ::ttk::style]]
12151 }
12152 set use_ttk [expr {$have_ttk && $want_ttk}]
12153 set NS [expr {$use_ttk ? "ttk" : ""}]
12154
12155 regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12156
12157 set show_notes {}
12158 if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12159     set show_notes "--show-notes"
12160 }
12161
12162 set appname "gitk"
12163
12164 set runq {}
12165 set history {}
12166 set historyindex 0
12167 set fh_serial 0
12168 set nhl_names {}
12169 set highlight_paths {}
12170 set findpattern {}
12171 set searchdirn -forwards
12172 set boldids {}
12173 set boldnameids {}
12174 set diffelide {0 0}
12175 set markingmatches 0
12176 set linkentercount 0
12177 set need_redisplay 0
12178 set nrows_drawn 0
12179 set firsttabstop 0
12180
12181 set nextviewnum 1
12182 set curview 0
12183 set selectedview 0
12184 set selectedhlview [mc "None"]
12185 set highlight_related [mc "None"]
12186 set highlight_files {}
12187 set viewfiles(0) {}
12188 set viewperm(0) 0
12189 set viewargs(0) {}
12190 set viewargscmd(0) {}
12191
12192 set selectedline {}
12193 set numcommits 0
12194 set loginstance 0
12195 set cmdlineok 0
12196 set stopped 0
12197 set stuffsaved 0
12198 set patchnum 0
12199 set lserial 0
12200 set hasworktree [hasworktree]
12201 set cdup {}
12202 if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12203     set cdup [exec git rev-parse --show-cdup]
12204 }
12205 set worktree [exec git rev-parse --show-toplevel]
12206 setcoords
12207 makewindow
12208 catch {
12209     image create photo gitlogo      -width 16 -height 16
12210
12211     image create photo gitlogominus -width  4 -height  2
12212     gitlogominus put #C00000 -to 0 0 4 2
12213     gitlogo copy gitlogominus -to  1 5
12214     gitlogo copy gitlogominus -to  6 5
12215     gitlogo copy gitlogominus -to 11 5
12216     image delete gitlogominus
12217
12218     image create photo gitlogoplus  -width  4 -height  4
12219     gitlogoplus  put #008000 -to 1 0 3 4
12220     gitlogoplus  put #008000 -to 0 1 4 3
12221     gitlogo copy gitlogoplus  -to  1 9
12222     gitlogo copy gitlogoplus  -to  6 9
12223     gitlogo copy gitlogoplus  -to 11 9
12224     image delete gitlogoplus
12225
12226     image create photo gitlogo32    -width 32 -height 32
12227     gitlogo32 copy gitlogo -zoom 2 2
12228
12229     wm iconphoto . -default gitlogo gitlogo32
12230 }
12231 # wait for the window to become visible
12232 tkwait visibility .
12233 wm title . "$appname: [reponame]"
12234 update
12235 readrefs
12236
12237 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12238     # create a view for the files/dirs specified on the command line
12239     set curview 1
12240     set selectedview 1
12241     set nextviewnum 2
12242     set viewname(1) [mc "Command line"]
12243     set viewfiles(1) $cmdline_files
12244     set viewargs(1) $revtreeargs
12245     set viewargscmd(1) $revtreeargscmd
12246     set viewperm(1) 0
12247     set vdatemode(1) 0
12248     addviewmenu 1
12249     .bar.view entryconf [mca "Edit view..."] -state normal
12250     .bar.view entryconf [mca "Delete view"] -state normal
12251 }
12252
12253 if {[info exists permviews]} {
12254     foreach v $permviews {
12255         set n $nextviewnum
12256         incr nextviewnum
12257         set viewname($n) [lindex $v 0]
12258         set viewfiles($n) [lindex $v 1]
12259         set viewargs($n) [lindex $v 2]
12260         set viewargscmd($n) [lindex $v 3]
12261         set viewperm($n) 1
12262         addviewmenu $n
12263     }
12264 }
12265
12266 if {[tk windowingsystem] eq "win32"} {
12267     focus -force .
12268 }
12269
12270 getcommits {}
12271
12272 # Local variables:
12273 # mode: tcl
12274 # indent-tabs-mode: t
12275 # tab-width: 8
12276 # End: