gitk-git/gitk

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