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 {id font} {
4008     global canv linehtag currentid boldids need_redisplay
4009
4010     # need_redisplay = 1 means the display is stale and about to be redrawn
4011     if {$need_redisplay} return
4012     lappend boldids $id
4013     $canv itemconf $linehtag($id) -font $font
4014     if {[info exists currentid] && $id eq $currentid} {
4015         $canv delete secsel
4016         set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4017                    -outline {{}} -tags secsel \
4018                    -fill [$canv cget -selectbackground]]
4019         $canv lower $t
4020     }
4021 }
4022
4023 proc bolden_name {id font} {
4024     global canv2 linentag currentid boldnameids need_redisplay
4025
4026     if {$need_redisplay} return
4027     lappend boldnameids $id
4028     $canv2 itemconf $linentag($id) -font $font
4029     if {[info exists currentid] && $id eq $currentid} {
4030         $canv2 delete secsel
4031         set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4032                    -outline {{}} -tags secsel \
4033                    -fill [$canv2 cget -selectbackground]]
4034         $canv2 lower $t
4035     }
4036 }
4037
4038 proc unbolden {} {
4039     global boldids
4040
4041     set stillbold {}
4042     foreach id $boldids {
4043         if {![ishighlighted $id]} {
4044             bolden $id mainfont
4045         } else {
4046             lappend stillbold $id
4047         }
4048     }
4049     set boldids $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 $id 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 $id 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 boldnameids
4174     global findpattern findtype findstring gdttype
4175
4176     stopfinding
4177     # delete previous highlights, if any
4178     foreach id $boldnameids {
4179         bolden_name $id mainfont
4180     }
4181     set boldnameids {}
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         if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4271             bolden $line mainfontbold
4272         }
4273         set fhighlights($line) 1
4274     }
4275     if {[eof $filehighlight]} {
4276         # strange...
4277         puts "oops, git diff-tree died"
4278         catch {close $filehighlight}
4279         unset filehighlight
4280         return 0
4281     }
4282     if {[info exists find_dirn]} {
4283         run findmore
4284     }
4285     return 1
4286 }
4287
4288 proc doesmatch {f} {
4289     global findtype findpattern
4290
4291     if {$findtype eq [mc "Regexp"]} {
4292         return [regexp $findpattern $f]
4293     } elseif {$findtype eq [mc "IgnCase"]} {
4294         return [string match -nocase $findpattern $f]
4295     } else {
4296         return [string match $findpattern $f]
4297     }
4298 }
4299
4300 proc askfindhighlight {row id} {
4301     global nhighlights commitinfo iddrawn
4302     global findloc
4303     global markingmatches
4304
4305     if {![info exists commitinfo($id)]} {
4306         getcommit $id
4307     }
4308     set info $commitinfo($id)
4309     set isbold 0
4310     set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
4311     foreach f $info ty $fldtypes {
4312         if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4313             [doesmatch $f]} {
4314             if {$ty eq [mc "Author"]} {
4315                 set isbold 2
4316                 break
4317             }
4318             set isbold 1
4319         }
4320     }
4321     if {$isbold && [info exists iddrawn($id)]} {
4322         if {![ishighlighted $id]} {
4323             bolden $id mainfontbold
4324             if {$isbold > 1} {
4325                 bolden_name $id mainfontbold
4326             }
4327         }
4328         if {$markingmatches} {
4329             markrowmatches $row $id
4330         }
4331     }
4332     set nhighlights($id) $isbold
4333 }
4334
4335 proc markrowmatches {row id} {
4336     global canv canv2 linehtag linentag commitinfo findloc
4337
4338     set headline [lindex $commitinfo($id) 0]
4339     set author [lindex $commitinfo($id) 1]
4340     $canv delete match$row
4341     $canv2 delete match$row
4342     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4343         set m [findmatches $headline]
4344         if {$m ne {}} {
4345             markmatches $canv $row $headline $linehtag($id) $m \
4346                 [$canv itemcget $linehtag($id) -font] $row
4347         }
4348     }
4349     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4350         set m [findmatches $author]
4351         if {$m ne {}} {
4352             markmatches $canv2 $row $author $linentag($id) $m \
4353                 [$canv2 itemcget $linentag($id) -font] $row
4354         }
4355     }
4356 }
4357
4358 proc vrel_change {name ix op} {
4359     global highlight_related
4360
4361     rhighlight_none
4362     if {$highlight_related ne [mc "None"]} {
4363         run drawvisible
4364     }
4365 }
4366
4367 # prepare for testing whether commits are descendents or ancestors of a
4368 proc rhighlight_sel {a} {
4369     global descendent desc_todo ancestor anc_todo
4370     global highlight_related
4371
4372     catch {unset descendent}
4373     set desc_todo [list $a]
4374     catch {unset ancestor}
4375     set anc_todo [list $a]
4376     if {$highlight_related ne [mc "None"]} {
4377         rhighlight_none
4378         run drawvisible
4379     }
4380 }
4381
4382 proc rhighlight_none {} {
4383     global rhighlights
4384
4385     catch {unset rhighlights}
4386     unbolden
4387 }
4388
4389 proc is_descendent {a} {
4390     global curview children descendent desc_todo
4391
4392     set v $curview
4393     set la [rowofcommit $a]
4394     set todo $desc_todo
4395     set leftover {}
4396     set done 0
4397     for {set i 0} {$i < [llength $todo]} {incr i} {
4398         set do [lindex $todo $i]
4399         if {[rowofcommit $do] < $la} {
4400             lappend leftover $do
4401             continue
4402         }
4403         foreach nk $children($v,$do) {
4404             if {![info exists descendent($nk)]} {
4405                 set descendent($nk) 1
4406                 lappend todo $nk
4407                 if {$nk eq $a} {
4408                     set done 1
4409                 }
4410             }
4411         }
4412         if {$done} {
4413             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4414             return
4415         }
4416     }
4417     set descendent($a) 0
4418     set desc_todo $leftover
4419 }
4420
4421 proc is_ancestor {a} {
4422     global curview parents ancestor anc_todo
4423
4424     set v $curview
4425     set la [rowofcommit $a]
4426     set todo $anc_todo
4427     set leftover {}
4428     set done 0
4429     for {set i 0} {$i < [llength $todo]} {incr i} {
4430         set do [lindex $todo $i]
4431         if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4432             lappend leftover $do
4433             continue
4434         }
4435         foreach np $parents($v,$do) {
4436             if {![info exists ancestor($np)]} {
4437                 set ancestor($np) 1
4438                 lappend todo $np
4439                 if {$np eq $a} {
4440                     set done 1
4441                 }
4442             }
4443         }
4444         if {$done} {
4445             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4446             return
4447         }
4448     }
4449     set ancestor($a) 0
4450     set anc_todo $leftover
4451 }
4452
4453 proc askrelhighlight {row id} {
4454     global descendent highlight_related iddrawn rhighlights
4455     global selectedline ancestor
4456
4457     if {$selectedline eq {}} return
4458     set isbold 0
4459     if {$highlight_related eq [mc "Descendant"] ||
4460         $highlight_related eq [mc "Not descendant"]} {
4461         if {![info exists descendent($id)]} {
4462             is_descendent $id
4463         }
4464         if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4465             set isbold 1
4466         }
4467     } elseif {$highlight_related eq [mc "Ancestor"] ||
4468               $highlight_related eq [mc "Not ancestor"]} {
4469         if {![info exists ancestor($id)]} {
4470             is_ancestor $id
4471         }
4472         if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4473             set isbold 1
4474         }
4475     }
4476     if {[info exists iddrawn($id)]} {
4477         if {$isbold && ![ishighlighted $id]} {
4478             bolden $id mainfontbold
4479         }
4480     }
4481     set rhighlights($id) $isbold
4482 }
4483
4484 # Graph layout functions
4485
4486 proc shortids {ids} {
4487     set res {}
4488     foreach id $ids {
4489         if {[llength $id] > 1} {
4490             lappend res [shortids $id]
4491         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4492             lappend res [string range $id 0 7]
4493         } else {
4494             lappend res $id
4495         }
4496     }
4497     return $res
4498 }
4499
4500 proc ntimes {n o} {
4501     set ret {}
4502     set o [list $o]
4503     for {set mask 1} {$mask <= $n} {incr mask $mask} {
4504         if {($n & $mask) != 0} {
4505             set ret [concat $ret $o]
4506         }
4507         set o [concat $o $o]
4508     }
4509     return $ret
4510 }
4511
4512 proc ordertoken {id} {
4513     global ordertok curview varcid varcstart varctok curview parents children
4514     global nullid nullid2
4515
4516     if {[info exists ordertok($id)]} {
4517         return $ordertok($id)
4518     }
4519     set origid $id
4520     set todo {}
4521     while {1} {
4522         if {[info exists varcid($curview,$id)]} {
4523             set a $varcid($curview,$id)
4524             set p [lindex $varcstart($curview) $a]
4525         } else {
4526             set p [lindex $children($curview,$id) 0]
4527         }
4528         if {[info exists ordertok($p)]} {
4529             set tok $ordertok($p)
4530             break
4531         }
4532         set id [first_real_child $curview,$p]
4533         if {$id eq {}} {
4534             # it's a root
4535             set tok [lindex $varctok($curview) $varcid($curview,$p)]
4536             break
4537         }
4538         if {[llength $parents($curview,$id)] == 1} {
4539             lappend todo [list $p {}]
4540         } else {
4541             set j [lsearch -exact $parents($curview,$id) $p]
4542             if {$j < 0} {
4543                 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4544             }
4545             lappend todo [list $p [strrep $j]]
4546         }
4547     }
4548     for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4549         set p [lindex $todo $i 0]
4550         append tok [lindex $todo $i 1]
4551         set ordertok($p) $tok
4552     }
4553     set ordertok($origid) $tok
4554     return $tok
4555 }
4556
4557 # Work out where id should go in idlist so that order-token
4558 # values increase from left to right
4559 proc idcol {idlist id {i 0}} {
4560     set t [ordertoken $id]
4561     if {$i < 0} {
4562         set i 0
4563     }
4564     if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4565         if {$i > [llength $idlist]} {
4566             set i [llength $idlist]
4567         }
4568         while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4569         incr i
4570     } else {
4571         if {$t > [ordertoken [lindex $idlist $i]]} {
4572             while {[incr i] < [llength $idlist] &&
4573                    $t >= [ordertoken [lindex $idlist $i]]} {}
4574         }
4575     }
4576     return $i
4577 }
4578
4579 proc initlayout {} {
4580     global rowidlist rowisopt rowfinal displayorder parentlist
4581     global numcommits canvxmax canv
4582     global nextcolor
4583     global colormap rowtextx
4584
4585     set numcommits 0
4586     set displayorder {}
4587     set parentlist {}
4588     set nextcolor 0
4589     set rowidlist {}
4590     set rowisopt {}
4591     set rowfinal {}
4592     set canvxmax [$canv cget -width]
4593     catch {unset colormap}
4594     catch {unset rowtextx}
4595     setcanvscroll
4596 }
4597
4598 proc setcanvscroll {} {
4599     global canv canv2 canv3 numcommits linespc canvxmax canvy0
4600     global lastscrollset lastscrollrows
4601
4602     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4603     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4604     $canv2 conf -scrollregion [list 0 0 0 $ymax]
4605     $canv3 conf -scrollregion [list 0 0 0 $ymax]
4606     set lastscrollset [clock clicks -milliseconds]
4607     set lastscrollrows $numcommits
4608 }
4609
4610 proc visiblerows {} {
4611     global canv numcommits linespc
4612
4613     set ymax [lindex [$canv cget -scrollregion] 3]
4614     if {$ymax eq {} || $ymax == 0} return
4615     set f [$canv yview]
4616     set y0 [expr {int([lindex $f 0] * $ymax)}]
4617     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4618     if {$r0 < 0} {
4619         set r0 0
4620     }
4621     set y1 [expr {int([lindex $f 1] * $ymax)}]
4622     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4623     if {$r1 >= $numcommits} {
4624         set r1 [expr {$numcommits - 1}]
4625     }
4626     return [list $r0 $r1]
4627 }
4628
4629 proc layoutmore {} {
4630     global commitidx viewcomplete curview
4631     global numcommits pending_select curview
4632     global lastscrollset lastscrollrows
4633
4634     if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4635         [clock clicks -milliseconds] - $lastscrollset > 500} {
4636         setcanvscroll
4637     }
4638     if {[info exists pending_select] &&
4639         [commitinview $pending_select $curview]} {
4640         update
4641         selectline [rowofcommit $pending_select] 1
4642     }
4643     drawvisible
4644 }
4645
4646 proc doshowlocalchanges {} {
4647     global curview mainheadid
4648
4649     if {$mainheadid eq {}} return
4650     if {[commitinview $mainheadid $curview]} {
4651         dodiffindex
4652     } else {
4653         interestedin $mainheadid dodiffindex
4654     }
4655 }
4656
4657 proc dohidelocalchanges {} {
4658     global nullid nullid2 lserial curview
4659
4660     if {[commitinview $nullid $curview]} {
4661         removefakerow $nullid
4662     }
4663     if {[commitinview $nullid2 $curview]} {
4664         removefakerow $nullid2
4665     }
4666     incr lserial
4667 }
4668
4669 # spawn off a process to do git diff-index --cached HEAD
4670 proc dodiffindex {} {
4671     global lserial showlocalchanges
4672     global isworktree
4673
4674     if {!$showlocalchanges || !$isworktree} return
4675     incr lserial
4676     set fd [open "|git diff-index --cached HEAD" r]
4677     fconfigure $fd -blocking 0
4678     set i [reg_instance $fd]
4679     filerun $fd [list readdiffindex $fd $lserial $i]
4680 }
4681
4682 proc readdiffindex {fd serial inst} {
4683     global mainheadid nullid nullid2 curview commitinfo commitdata lserial
4684
4685     set isdiff 1
4686     if {[gets $fd line] < 0} {
4687         if {![eof $fd]} {
4688             return 1
4689         }
4690         set isdiff 0
4691     }
4692     # we only need to see one line and we don't really care what it says...
4693     stop_instance $inst
4694
4695     if {$serial != $lserial} {
4696         return 0
4697     }
4698
4699     # now see if there are any local changes not checked in to the index
4700     set fd [open "|git diff-files" r]
4701     fconfigure $fd -blocking 0
4702     set i [reg_instance $fd]
4703     filerun $fd [list readdifffiles $fd $serial $i]
4704
4705     if {$isdiff && ![commitinview $nullid2 $curview]} {
4706         # add the line for the changes in the index to the graph
4707         set hl [mc "Local changes checked in to index but not committed"]
4708         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
4709         set commitdata($nullid2) "\n    $hl\n"
4710         if {[commitinview $nullid $curview]} {
4711             removefakerow $nullid
4712         }
4713         insertfakerow $nullid2 $mainheadid
4714     } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
4715         removefakerow $nullid2
4716     }
4717     return 0
4718 }
4719
4720 proc readdifffiles {fd serial inst} {
4721     global mainheadid nullid nullid2 curview
4722     global commitinfo commitdata lserial
4723
4724     set isdiff 1
4725     if {[gets $fd line] < 0} {
4726         if {![eof $fd]} {
4727             return 1
4728         }
4729         set isdiff 0
4730     }
4731     # we only need to see one line and we don't really care what it says...
4732     stop_instance $inst
4733
4734     if {$serial != $lserial} {
4735         return 0
4736     }
4737
4738     if {$isdiff && ![commitinview $nullid $curview]} {
4739         # add the line for the local diff to the graph
4740         set hl [mc "Local uncommitted changes, not checked in to index"]
4741         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
4742         set commitdata($nullid) "\n    $hl\n"
4743         if {[commitinview $nullid2 $curview]} {
4744             set p $nullid2
4745         } else {
4746             set p $mainheadid
4747         }
4748         insertfakerow $nullid $p
4749     } elseif {!$isdiff && [commitinview $nullid $curview]} {
4750         removefakerow $nullid
4751     }
4752     return 0
4753 }
4754
4755 proc nextuse {id row} {
4756     global curview children
4757
4758     if {[info exists children($curview,$id)]} {
4759         foreach kid $children($curview,$id) {
4760             if {![commitinview $kid $curview]} {
4761                 return -1
4762             }
4763             if {[rowofcommit $kid] > $row} {
4764                 return [rowofcommit $kid]
4765             }
4766         }
4767     }
4768     if {[commitinview $id $curview]} {
4769         return [rowofcommit $id]
4770     }
4771     return -1
4772 }
4773
4774 proc prevuse {id row} {
4775     global curview children
4776
4777     set ret -1
4778     if {[info exists children($curview,$id)]} {
4779         foreach kid $children($curview,$id) {
4780             if {![commitinview $kid $curview]} break
4781             if {[rowofcommit $kid] < $row} {
4782                 set ret [rowofcommit $kid]
4783             }
4784         }
4785     }
4786     return $ret
4787 }
4788
4789 proc make_idlist {row} {
4790     global displayorder parentlist uparrowlen downarrowlen mingaplen
4791     global commitidx curview children
4792
4793     set r [expr {$row - $mingaplen - $downarrowlen - 1}]
4794     if {$r < 0} {
4795         set r 0
4796     }
4797     set ra [expr {$row - $downarrowlen}]
4798     if {$ra < 0} {
4799         set ra 0
4800     }
4801     set rb [expr {$row + $uparrowlen}]
4802     if {$rb > $commitidx($curview)} {
4803         set rb $commitidx($curview)
4804     }
4805     make_disporder $r [expr {$rb + 1}]
4806     set ids {}
4807     for {} {$r < $ra} {incr r} {
4808         set nextid [lindex $displayorder [expr {$r + 1}]]
4809         foreach p [lindex $parentlist $r] {
4810             if {$p eq $nextid} continue
4811             set rn [nextuse $p $r]
4812             if {$rn >= $row &&
4813                 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
4814                 lappend ids [list [ordertoken $p] $p]
4815             }
4816         }
4817     }
4818     for {} {$r < $row} {incr r} {
4819         set nextid [lindex $displayorder [expr {$r + 1}]]
4820         foreach p [lindex $parentlist $r] {
4821             if {$p eq $nextid} continue
4822             set rn [nextuse $p $r]
4823             if {$rn < 0 || $rn >= $row} {
4824                 lappend ids [list [ordertoken $p] $p]
4825             }
4826         }
4827     }
4828     set id [lindex $displayorder $row]
4829     lappend ids [list [ordertoken $id] $id]
4830     while {$r < $rb} {
4831         foreach p [lindex $parentlist $r] {
4832             set firstkid [lindex $children($curview,$p) 0]
4833             if {[rowofcommit $firstkid] < $row} {
4834                 lappend ids [list [ordertoken $p] $p]
4835             }
4836         }
4837         incr r
4838         set id [lindex $displayorder $r]
4839         if {$id ne {}} {
4840             set firstkid [lindex $children($curview,$id) 0]
4841             if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
4842                 lappend ids [list [ordertoken $id] $id]
4843             }
4844         }
4845     }
4846     set idlist {}
4847     foreach idx [lsort -unique $ids] {
4848         lappend idlist [lindex $idx 1]
4849     }
4850     return $idlist
4851 }
4852
4853 proc rowsequal {a b} {
4854     while {[set i [lsearch -exact $a {}]] >= 0} {
4855         set a [lreplace $a $i $i]
4856     }
4857     while {[set i [lsearch -exact $b {}]] >= 0} {
4858         set b [lreplace $b $i $i]
4859     }
4860     return [expr {$a eq $b}]
4861 }
4862
4863 proc makeupline {id row rend col} {
4864     global rowidlist uparrowlen downarrowlen mingaplen
4865
4866     for {set r $rend} {1} {set r $rstart} {
4867         set rstart [prevuse $id $r]
4868         if {$rstart < 0} return
4869         if {$rstart < $row} break
4870     }
4871     if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
4872         set rstart [expr {$rend - $uparrowlen - 1}]
4873     }
4874     for {set r $rstart} {[incr r] <= $row} {} {
4875         set idlist [lindex $rowidlist $r]
4876         if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
4877             set col [idcol $idlist $id $col]
4878             lset rowidlist $r [linsert $idlist $col $id]
4879             changedrow $r
4880         }
4881     }
4882 }
4883
4884 proc layoutrows {row endrow} {
4885     global rowidlist rowisopt rowfinal displayorder
4886     global uparrowlen downarrowlen maxwidth mingaplen
4887     global children parentlist
4888     global commitidx viewcomplete curview
4889
4890     make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
4891     set idlist {}
4892     if {$row > 0} {
4893         set rm1 [expr {$row - 1}]
4894         foreach id [lindex $rowidlist $rm1] {
4895             if {$id ne {}} {
4896                 lappend idlist $id
4897             }
4898         }
4899         set final [lindex $rowfinal $rm1]
4900     }
4901     for {} {$row < $endrow} {incr row} {
4902         set rm1 [expr {$row - 1}]
4903         if {$rm1 < 0 || $idlist eq {}} {
4904             set idlist [make_idlist $row]
4905             set final 1
4906         } else {
4907             set id [lindex $displayorder $rm1]
4908             set col [lsearch -exact $idlist $id]
4909             set idlist [lreplace $idlist $col $col]
4910             foreach p [lindex $parentlist $rm1] {
4911                 if {[lsearch -exact $idlist $p] < 0} {
4912                     set col [idcol $idlist $p $col]
4913                     set idlist [linsert $idlist $col $p]
4914                     # if not the first child, we have to insert a line going up
4915                     if {$id ne [lindex $children($curview,$p) 0]} {
4916                         makeupline $p $rm1 $row $col
4917                     }
4918                 }
4919             }
4920             set id [lindex $displayorder $row]
4921             if {$row > $downarrowlen} {
4922                 set termrow [expr {$row - $downarrowlen - 1}]
4923                 foreach p [lindex $parentlist $termrow] {
4924                     set i [lsearch -exact $idlist $p]
4925                     if {$i < 0} continue
4926                     set nr [nextuse $p $termrow]
4927                     if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
4928                         set idlist [lreplace $idlist $i $i]
4929                     }
4930                 }
4931             }
4932             set col [lsearch -exact $idlist $id]
4933             if {$col < 0} {
4934                 set col [idcol $idlist $id]
4935                 set idlist [linsert $idlist $col $id]
4936                 if {$children($curview,$id) ne {}} {
4937                     makeupline $id $rm1 $row $col
4938                 }
4939             }
4940             set r [expr {$row + $uparrowlen - 1}]
4941             if {$r < $commitidx($curview)} {
4942                 set x $col
4943                 foreach p [lindex $parentlist $r] {
4944                     if {[lsearch -exact $idlist $p] >= 0} continue
4945                     set fk [lindex $children($curview,$p) 0]
4946                     if {[rowofcommit $fk] < $row} {
4947                         set x [idcol $idlist $p $x]
4948                         set idlist [linsert $idlist $x $p]
4949                     }
4950                 }
4951                 if {[incr r] < $commitidx($curview)} {
4952                     set p [lindex $displayorder $r]
4953                     if {[lsearch -exact $idlist $p] < 0} {
4954                         set fk [lindex $children($curview,$p) 0]
4955                         if {$fk ne {} && [rowofcommit $fk] < $row} {
4956                             set x [idcol $idlist $p $x]
4957                             set idlist [linsert $idlist $x $p]
4958                         }
4959                     }
4960                 }
4961             }
4962         }
4963         if {$final && !$viewcomplete($curview) &&
4964             $row + $uparrowlen + $mingaplen + $downarrowlen
4965                 >= $commitidx($curview)} {
4966             set final 0
4967         }
4968         set l [llength $rowidlist]
4969         if {$row == $l} {
4970             lappend rowidlist $idlist
4971             lappend rowisopt 0
4972             lappend rowfinal $final
4973         } elseif {$row < $l} {
4974             if {![rowsequal $idlist [lindex $rowidlist $row]]} {
4975                 lset rowidlist $row $idlist
4976                 changedrow $row
4977             }
4978             lset rowfinal $row $final
4979         } else {
4980             set pad [ntimes [expr {$row - $l}] {}]
4981             set rowidlist [concat $rowidlist $pad]
4982             lappend rowidlist $idlist
4983             set rowfinal [concat $rowfinal $pad]
4984             lappend rowfinal $final
4985             set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
4986         }
4987     }
4988     return $row
4989 }
4990
4991 proc changedrow {row} {
4992     global displayorder iddrawn rowisopt need_redisplay
4993
4994     set l [llength $rowisopt]
4995     if {$row < $l} {
4996         lset rowisopt $row 0
4997         if {$row + 1 < $l} {
4998             lset rowisopt [expr {$row + 1}] 0
4999             if {$row + 2 < $l} {
5000                 lset rowisopt [expr {$row + 2}] 0
5001             }
5002         }
5003     }
5004     set id [lindex $displayorder $row]
5005     if {[info exists iddrawn($id)]} {
5006         set need_redisplay 1
5007     }
5008 }
5009
5010 proc insert_pad {row col npad} {
5011     global rowidlist
5012
5013     set pad [ntimes $npad {}]
5014     set idlist [lindex $rowidlist $row]
5015     set bef [lrange $idlist 0 [expr {$col - 1}]]
5016     set aft [lrange $idlist $col end]
5017     set i [lsearch -exact $aft {}]
5018     if {$i > 0} {
5019         set aft [lreplace $aft $i $i]
5020     }
5021     lset rowidlist $row [concat $bef $pad $aft]
5022     changedrow $row
5023 }
5024
5025 proc optimize_rows {row col endrow} {
5026     global rowidlist rowisopt displayorder curview children
5027
5028     if {$row < 1} {
5029         set row 1
5030     }
5031     for {} {$row < $endrow} {incr row; set col 0} {
5032         if {[lindex $rowisopt $row]} continue
5033         set haspad 0
5034         set y0 [expr {$row - 1}]
5035         set ym [expr {$row - 2}]
5036         set idlist [lindex $rowidlist $row]
5037         set previdlist [lindex $rowidlist $y0]
5038         if {$idlist eq {} || $previdlist eq {}} continue
5039         if {$ym >= 0} {
5040             set pprevidlist [lindex $rowidlist $ym]
5041             if {$pprevidlist eq {}} continue
5042         } else {
5043             set pprevidlist {}
5044         }
5045         set x0 -1
5046         set xm -1
5047         for {} {$col < [llength $idlist]} {incr col} {
5048             set id [lindex $idlist $col]
5049             if {[lindex $previdlist $col] eq $id} continue
5050             if {$id eq {}} {
5051                 set haspad 1
5052                 continue
5053             }
5054             set x0 [lsearch -exact $previdlist $id]
5055             if {$x0 < 0} continue
5056             set z [expr {$x0 - $col}]
5057             set isarrow 0
5058             set z0 {}
5059             if {$ym >= 0} {
5060                 set xm [lsearch -exact $pprevidlist $id]
5061                 if {$xm >= 0} {
5062                     set z0 [expr {$xm - $x0}]
5063                 }
5064             }
5065             if {$z0 eq {}} {
5066                 # if row y0 is the first child of $id then it's not an arrow
5067                 if {[lindex $children($curview,$id) 0] ne
5068                     [lindex $displayorder $y0]} {
5069                     set isarrow 1
5070                 }
5071             }
5072             if {!$isarrow && $id ne [lindex $displayorder $row] &&
5073                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5074                 set isarrow 1
5075             }
5076             # Looking at lines from this row to the previous row,
5077             # make them go straight up if they end in an arrow on
5078             # the previous row; otherwise make them go straight up
5079             # or at 45 degrees.
5080             if {$z < -1 || ($z < 0 && $isarrow)} {
5081                 # Line currently goes left too much;
5082                 # insert pads in the previous row, then optimize it
5083                 set npad [expr {-1 - $z + $isarrow}]
5084                 insert_pad $y0 $x0 $npad
5085                 if {$y0 > 0} {
5086                     optimize_rows $y0 $x0 $row
5087                 }
5088                 set previdlist [lindex $rowidlist $y0]
5089                 set x0 [lsearch -exact $previdlist $id]
5090                 set z [expr {$x0 - $col}]
5091                 if {$z0 ne {}} {
5092                     set pprevidlist [lindex $rowidlist $ym]
5093                     set xm [lsearch -exact $pprevidlist $id]
5094                     set z0 [expr {$xm - $x0}]
5095                 }
5096             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5097                 # Line currently goes right too much;
5098                 # insert pads in this line
5099                 set npad [expr {$z - 1 + $isarrow}]
5100                 insert_pad $row $col $npad
5101                 set idlist [lindex $rowidlist $row]
5102                 incr col $npad
5103                 set z [expr {$x0 - $col}]
5104                 set haspad 1
5105             }
5106             if {$z0 eq {} && !$isarrow && $ym >= 0} {
5107                 # this line links to its first child on row $row-2
5108                 set id [lindex $displayorder $ym]
5109                 set xc [lsearch -exact $pprevidlist $id]
5110                 if {$xc >= 0} {
5111                     set z0 [expr {$xc - $x0}]
5112                 }
5113             }
5114             # avoid lines jigging left then immediately right
5115             if {$z0 ne {} && $z < 0 && $z0 > 0} {
5116                 insert_pad $y0 $x0 1
5117                 incr x0
5118                 optimize_rows $y0 $x0 $row
5119                 set previdlist [lindex $rowidlist $y0]
5120             }
5121         }
5122         if {!$haspad} {
5123             # Find the first column that doesn't have a line going right
5124             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5125                 set id [lindex $idlist $col]
5126                 if {$id eq {}} break
5127                 set x0 [lsearch -exact $previdlist $id]
5128                 if {$x0 < 0} {
5129                     # check if this is the link to the first child
5130                     set kid [lindex $displayorder $y0]
5131                     if {[lindex $children($curview,$id) 0] eq $kid} {
5132                         # it is, work out offset to child
5133                         set x0 [lsearch -exact $previdlist $kid]
5134                     }
5135                 }
5136                 if {$x0 <= $col} break
5137             }
5138             # Insert a pad at that column as long as it has a line and
5139             # isn't the last column
5140             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5141                 set idlist [linsert $idlist $col {}]
5142                 lset rowidlist $row $idlist
5143                 changedrow $row
5144             }
5145         }
5146     }
5147 }
5148
5149 proc xc {row col} {
5150     global canvx0 linespc
5151     return [expr {$canvx0 + $col * $linespc}]
5152 }
5153
5154 proc yc {row} {
5155     global canvy0 linespc
5156     return [expr {$canvy0 + $row * $linespc}]
5157 }
5158
5159 proc linewidth {id} {
5160     global thickerline lthickness
5161
5162     set wid $lthickness
5163     if {[info exists thickerline] && $id eq $thickerline} {
5164         set wid [expr {2 * $lthickness}]
5165     }
5166     return $wid
5167 }
5168
5169 proc rowranges {id} {
5170     global curview children uparrowlen downarrowlen
5171     global rowidlist
5172
5173     set kids $children($curview,$id)
5174     if {$kids eq {}} {
5175         return {}
5176     }
5177     set ret {}
5178     lappend kids $id
5179     foreach child $kids {
5180         if {![commitinview $child $curview]} break
5181         set row [rowofcommit $child]
5182         if {![info exists prev]} {
5183             lappend ret [expr {$row + 1}]
5184         } else {
5185             if {$row <= $prevrow} {
5186                 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5187             }
5188             # see if the line extends the whole way from prevrow to row
5189             if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5190                 [lsearch -exact [lindex $rowidlist \
5191                             [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5192                 # it doesn't, see where it ends
5193                 set r [expr {$prevrow + $downarrowlen}]
5194                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5195                     while {[incr r -1] > $prevrow &&
5196                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5197                 } else {
5198                     while {[incr r] <= $row &&
5199                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5200                     incr r -1
5201                 }
5202                 lappend ret $r
5203                 # see where it starts up again
5204                 set r [expr {$row - $uparrowlen}]
5205                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5206                     while {[incr r] < $row &&
5207                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5208                 } else {
5209                     while {[incr r -1] >= $prevrow &&
5210                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5211                     incr r
5212                 }
5213                 lappend ret $r
5214             }
5215         }
5216         if {$child eq $id} {
5217             lappend ret $row
5218         }
5219         set prev $child
5220         set prevrow $row
5221     }
5222     return $ret
5223 }
5224
5225 proc drawlineseg {id row endrow arrowlow} {
5226     global rowidlist displayorder iddrawn linesegs
5227     global canv colormap linespc curview maxlinelen parentlist
5228
5229     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5230     set le [expr {$row + 1}]
5231     set arrowhigh 1
5232     while {1} {
5233         set c [lsearch -exact [lindex $rowidlist $le] $id]
5234         if {$c < 0} {
5235             incr le -1
5236             break
5237         }
5238         lappend cols $c
5239         set x [lindex $displayorder $le]
5240         if {$x eq $id} {
5241             set arrowhigh 0
5242             break
5243         }
5244         if {[info exists iddrawn($x)] || $le == $endrow} {
5245             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5246             if {$c >= 0} {
5247                 lappend cols $c
5248                 set arrowhigh 0
5249             }
5250             break
5251         }
5252         incr le
5253     }
5254     if {$le <= $row} {
5255         return $row
5256     }
5257
5258     set lines {}
5259     set i 0
5260     set joinhigh 0
5261     if {[info exists linesegs($id)]} {
5262         set lines $linesegs($id)
5263         foreach li $lines {
5264             set r0 [lindex $li 0]
5265             if {$r0 > $row} {
5266                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5267                     set joinhigh 1
5268                 }
5269                 break
5270             }
5271             incr i
5272         }
5273     }
5274     set joinlow 0
5275     if {$i > 0} {
5276         set li [lindex $lines [expr {$i-1}]]
5277         set r1 [lindex $li 1]
5278         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5279             set joinlow 1
5280         }
5281     }
5282
5283     set x [lindex $cols [expr {$le - $row}]]
5284     set xp [lindex $cols [expr {$le - 1 - $row}]]
5285     set dir [expr {$xp - $x}]
5286     if {$joinhigh} {
5287         set ith [lindex $lines $i 2]
5288         set coords [$canv coords $ith]
5289         set ah [$canv itemcget $ith -arrow]
5290         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5291         set x2 [lindex $cols [expr {$le + 1 - $row}]]
5292         if {$x2 ne {} && $x - $x2 == $dir} {
5293             set coords [lrange $coords 0 end-2]
5294         }
5295     } else {
5296         set coords [list [xc $le $x] [yc $le]]
5297     }
5298     if {$joinlow} {
5299         set itl [lindex $lines [expr {$i-1}] 2]
5300         set al [$canv itemcget $itl -arrow]
5301         set arrowlow [expr {$al eq "last" || $al eq "both"}]
5302     } elseif {$arrowlow} {
5303         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5304             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5305             set arrowlow 0
5306         }
5307     }
5308     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5309     for {set y $le} {[incr y -1] > $row} {} {
5310         set x $xp
5311         set xp [lindex $cols [expr {$y - 1 - $row}]]
5312         set ndir [expr {$xp - $x}]
5313         if {$dir != $ndir || $xp < 0} {
5314             lappend coords [xc $y $x] [yc $y]
5315         }
5316         set dir $ndir
5317     }
5318     if {!$joinlow} {
5319         if {$xp < 0} {
5320             # join parent line to first child
5321             set ch [lindex $displayorder $row]
5322             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5323             if {$xc < 0} {
5324                 puts "oops: drawlineseg: child $ch not on row $row"
5325             } elseif {$xc != $x} {
5326                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5327                     set d [expr {int(0.5 * $linespc)}]
5328                     set x1 [xc $row $x]
5329                     if {$xc < $x} {
5330                         set x2 [expr {$x1 - $d}]
5331                     } else {
5332                         set x2 [expr {$x1 + $d}]
5333                     }
5334                     set y2 [yc $row]
5335                     set y1 [expr {$y2 + $d}]
5336                     lappend coords $x1 $y1 $x2 $y2
5337                 } elseif {$xc < $x - 1} {
5338                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
5339                 } elseif {$xc > $x + 1} {
5340                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
5341                 }
5342                 set x $xc
5343             }
5344             lappend coords [xc $row $x] [yc $row]
5345         } else {
5346             set xn [xc $row $xp]
5347             set yn [yc $row]
5348             lappend coords $xn $yn
5349         }
5350         if {!$joinhigh} {
5351             assigncolor $id
5352             set t [$canv create line $coords -width [linewidth $id] \
5353                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
5354             $canv lower $t
5355             bindline $t $id
5356             set lines [linsert $lines $i [list $row $le $t]]
5357         } else {
5358             $canv coords $ith $coords
5359             if {$arrow ne $ah} {
5360                 $canv itemconf $ith -arrow $arrow
5361             }
5362             lset lines $i 0 $row
5363         }
5364     } else {
5365         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5366         set ndir [expr {$xo - $xp}]
5367         set clow [$canv coords $itl]
5368         if {$dir == $ndir} {
5369             set clow [lrange $clow 2 end]
5370         }
5371         set coords [concat $coords $clow]
5372         if {!$joinhigh} {
5373             lset lines [expr {$i-1}] 1 $le
5374         } else {
5375             # coalesce two pieces
5376             $canv delete $ith
5377             set b [lindex $lines [expr {$i-1}] 0]
5378             set e [lindex $lines $i 1]
5379             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5380         }
5381         $canv coords $itl $coords
5382         if {$arrow ne $al} {
5383             $canv itemconf $itl -arrow $arrow
5384         }
5385     }
5386
5387     set linesegs($id) $lines
5388     return $le
5389 }
5390
5391 proc drawparentlinks {id row} {
5392     global rowidlist canv colormap curview parentlist
5393     global idpos linespc
5394
5395     set rowids [lindex $rowidlist $row]
5396     set col [lsearch -exact $rowids $id]
5397     if {$col < 0} return
5398     set olds [lindex $parentlist $row]
5399     set row2 [expr {$row + 1}]
5400     set x [xc $row $col]
5401     set y [yc $row]
5402     set y2 [yc $row2]
5403     set d [expr {int(0.5 * $linespc)}]
5404     set ymid [expr {$y + $d}]
5405     set ids [lindex $rowidlist $row2]
5406     # rmx = right-most X coord used
5407     set rmx 0
5408     foreach p $olds {
5409         set i [lsearch -exact $ids $p]
5410         if {$i < 0} {
5411             puts "oops, parent $p of $id not in list"
5412             continue
5413         }
5414         set x2 [xc $row2 $i]
5415         if {$x2 > $rmx} {
5416             set rmx $x2
5417         }
5418         set j [lsearch -exact $rowids $p]
5419         if {$j < 0} {
5420             # drawlineseg will do this one for us
5421             continue
5422         }
5423         assigncolor $p
5424         # should handle duplicated parents here...
5425         set coords [list $x $y]
5426         if {$i != $col} {
5427             # if attaching to a vertical segment, draw a smaller
5428             # slant for visual distinctness
5429             if {$i == $j} {
5430                 if {$i < $col} {
5431                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5432                 } else {
5433                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5434                 }
5435             } elseif {$i < $col && $i < $j} {
5436                 # segment slants towards us already
5437                 lappend coords [xc $row $j] $y
5438             } else {
5439                 if {$i < $col - 1} {
5440                     lappend coords [expr {$x2 + $linespc}] $y
5441                 } elseif {$i > $col + 1} {
5442                     lappend coords [expr {$x2 - $linespc}] $y
5443                 }
5444                 lappend coords $x2 $y2
5445             }
5446         } else {
5447             lappend coords $x2 $y2
5448         }
5449         set t [$canv create line $coords -width [linewidth $p] \
5450                    -fill $colormap($p) -tags lines.$p]
5451         $canv lower $t
5452         bindline $t $p
5453     }
5454     if {$rmx > [lindex $idpos($id) 1]} {
5455         lset idpos($id) 1 $rmx
5456         redrawtags $id
5457     }
5458 }
5459
5460 proc drawlines {id} {
5461     global canv
5462
5463     $canv itemconf lines.$id -width [linewidth $id]
5464 }
5465
5466 proc drawcmittext {id row col} {
5467     global linespc canv canv2 canv3 fgcolor curview
5468     global cmitlisted commitinfo rowidlist parentlist
5469     global rowtextx idpos idtags idheads idotherrefs
5470     global linehtag linentag linedtag selectedline
5471     global canvxmax boldids boldnameids fgcolor
5472     global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5473
5474     # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5475     set listed $cmitlisted($curview,$id)
5476     if {$id eq $nullid} {
5477         set ofill red
5478     } elseif {$id eq $nullid2} {
5479         set ofill green
5480     } elseif {$id eq $mainheadid} {
5481         set ofill yellow
5482     } else {
5483         set ofill [lindex $circlecolors $listed]
5484     }
5485     set x [xc $row $col]
5486     set y [yc $row]
5487     set orad [expr {$linespc / 3}]
5488     if {$listed <= 2} {
5489         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5490                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5491                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5492     } elseif {$listed == 3} {
5493         # triangle pointing left for left-side commits
5494         set t [$canv create polygon \
5495                    [expr {$x - $orad}] $y \
5496                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5497                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5498                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5499     } else {
5500         # triangle pointing right for right-side commits
5501         set t [$canv create polygon \
5502                    [expr {$x + $orad - 1}] $y \
5503                    [expr {$x - $orad}] [expr {$y - $orad}] \
5504                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5505                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5506     }
5507     set circleitem($row) $t
5508     $canv raise $t
5509     $canv bind $t <1> {selcanvline {} %x %y}
5510     set rmx [llength [lindex $rowidlist $row]]
5511     set olds [lindex $parentlist $row]
5512     if {$olds ne {}} {
5513         set nextids [lindex $rowidlist [expr {$row + 1}]]
5514         foreach p $olds {
5515             set i [lsearch -exact $nextids $p]
5516             if {$i > $rmx} {
5517                 set rmx $i
5518             }
5519         }
5520     }
5521     set xt [xc $row $rmx]
5522     set rowtextx($row) $xt
5523     set idpos($id) [list $x $xt $y]
5524     if {[info exists idtags($id)] || [info exists idheads($id)]
5525         || [info exists idotherrefs($id)]} {
5526         set xt [drawtags $id $x $xt $y]
5527     }
5528     set headline [lindex $commitinfo($id) 0]
5529     set name [lindex $commitinfo($id) 1]
5530     set date [lindex $commitinfo($id) 2]
5531     set date [formatdate $date]
5532     set font mainfont
5533     set nfont mainfont
5534     set isbold [ishighlighted $id]
5535     if {$isbold > 0} {
5536         lappend boldids $id
5537         set font mainfontbold
5538         if {$isbold > 1} {
5539             lappend boldnameids $id
5540             set nfont mainfontbold
5541         }
5542     }
5543     set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
5544                            -text $headline -font $font -tags text]
5545     $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
5546     set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5547                            -text $name -font $nfont -tags text]
5548     set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5549                            -text $date -font mainfont -tags text]
5550     if {$selectedline == $row} {
5551         make_secsel $id
5552     }
5553     set xr [expr {$xt + [font measure $font $headline]}]
5554     if {$xr > $canvxmax} {
5555         set canvxmax $xr
5556         setcanvscroll
5557     }
5558 }
5559
5560 proc drawcmitrow {row} {
5561     global displayorder rowidlist nrows_drawn
5562     global iddrawn markingmatches
5563     global commitinfo numcommits
5564     global filehighlight fhighlights findpattern nhighlights
5565     global hlview vhighlights
5566     global highlight_related rhighlights
5567
5568     if {$row >= $numcommits} return
5569
5570     set id [lindex $displayorder $row]
5571     if {[info exists hlview] && ![info exists vhighlights($id)]} {
5572         askvhighlight $row $id
5573     }
5574     if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5575         askfilehighlight $row $id
5576     }
5577     if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5578         askfindhighlight $row $id
5579     }
5580     if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5581         askrelhighlight $row $id
5582     }
5583     if {![info exists iddrawn($id)]} {
5584         set col [lsearch -exact [lindex $rowidlist $row] $id]
5585         if {$col < 0} {
5586             puts "oops, row $row id $id not in list"
5587             return
5588         }
5589         if {![info exists commitinfo($id)]} {
5590             getcommit $id
5591         }
5592         assigncolor $id
5593         drawcmittext $id $row $col
5594         set iddrawn($id) 1
5595         incr nrows_drawn
5596     }
5597     if {$markingmatches} {
5598         markrowmatches $row $id
5599     }
5600 }
5601
5602 proc drawcommits {row {endrow {}}} {
5603     global numcommits iddrawn displayorder curview need_redisplay
5604     global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
5605
5606     if {$row < 0} {
5607         set row 0
5608     }
5609     if {$endrow eq {}} {
5610         set endrow $row
5611     }
5612     if {$endrow >= $numcommits} {
5613         set endrow [expr {$numcommits - 1}]
5614     }
5615
5616     set rl1 [expr {$row - $downarrowlen - 3}]
5617     if {$rl1 < 0} {
5618         set rl1 0
5619     }
5620     set ro1 [expr {$row - 3}]
5621     if {$ro1 < 0} {
5622         set ro1 0
5623     }
5624     set r2 [expr {$endrow + $uparrowlen + 3}]
5625     if {$r2 > $numcommits} {
5626         set r2 $numcommits
5627     }
5628     for {set r $rl1} {$r < $r2} {incr r} {
5629         if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
5630             if {$rl1 < $r} {
5631                 layoutrows $rl1 $r
5632             }
5633             set rl1 [expr {$r + 1}]
5634         }
5635     }
5636     if {$rl1 < $r} {
5637         layoutrows $rl1 $r
5638     }
5639     optimize_rows $ro1 0 $r2
5640     if {$need_redisplay || $nrows_drawn > 2000} {
5641         clear_display
5642         drawvisible
5643     }
5644
5645     # make the lines join to already-drawn rows either side
5646     set r [expr {$row - 1}]
5647     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
5648         set r $row
5649     }
5650     set er [expr {$endrow + 1}]
5651     if {$er >= $numcommits ||
5652         ![info exists iddrawn([lindex $displayorder $er])]} {
5653         set er $endrow
5654     }
5655     for {} {$r <= $er} {incr r} {
5656         set id [lindex $displayorder $r]
5657         set wasdrawn [info exists iddrawn($id)]
5658         drawcmitrow $r
5659         if {$r == $er} break
5660         set nextid [lindex $displayorder [expr {$r + 1}]]
5661         if {$wasdrawn && [info exists iddrawn($nextid)]} continue
5662         drawparentlinks $id $r
5663
5664         set rowids [lindex $rowidlist $r]
5665         foreach lid $rowids {
5666             if {$lid eq {}} continue
5667             if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
5668             if {$lid eq $id} {
5669                 # see if this is the first child of any of its parents
5670                 foreach p [lindex $parentlist $r] {
5671                     if {[lsearch -exact $rowids $p] < 0} {
5672                         # make this line extend up to the child
5673                         set lineend($p) [drawlineseg $p $r $er 0]
5674                     }
5675                 }
5676             } else {
5677                 set lineend($lid) [drawlineseg $lid $r $er 1]
5678             }
5679         }
5680     }
5681 }
5682
5683 proc undolayout {row} {
5684     global uparrowlen mingaplen downarrowlen
5685     global rowidlist rowisopt rowfinal need_redisplay
5686
5687     set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
5688     if {$r < 0} {
5689         set r 0
5690     }
5691     if {[llength $rowidlist] > $r} {
5692         incr r -1
5693         set rowidlist [lrange $rowidlist 0 $r]
5694         set rowfinal [lrange $rowfinal 0 $r]
5695         set rowisopt [lrange $rowisopt 0 $r]
5696         set need_redisplay 1
5697         run drawvisible
5698     }
5699 }
5700
5701 proc drawvisible {} {
5702     global canv linespc curview vrowmod selectedline targetrow targetid
5703     global need_redisplay cscroll numcommits
5704
5705     set fs [$canv yview]
5706     set ymax [lindex [$canv cget -scrollregion] 3]
5707     if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
5708     set f0 [lindex $fs 0]
5709     set f1 [lindex $fs 1]
5710     set y0 [expr {int($f0 * $ymax)}]
5711     set y1 [expr {int($f1 * $ymax)}]
5712
5713     if {[info exists targetid]} {
5714         if {[commitinview $targetid $curview]} {
5715             set r [rowofcommit $targetid]
5716             if {$r != $targetrow} {
5717                 # Fix up the scrollregion and change the scrolling position
5718                 # now that our target row has moved.
5719                 set diff [expr {($r - $targetrow) * $linespc}]
5720                 set targetrow $r
5721                 setcanvscroll
5722                 set ymax [lindex [$canv cget -scrollregion] 3]
5723                 incr y0 $diff
5724                 incr y1 $diff
5725                 set f0 [expr {$y0 / $ymax}]
5726                 set f1 [expr {$y1 / $ymax}]
5727                 allcanvs yview moveto $f0
5728                 $cscroll set $f0 $f1
5729                 set need_redisplay 1
5730             }
5731         } else {
5732             unset targetid
5733         }
5734     }
5735
5736     set row [expr {int(($y0 - 3) / $linespc) - 1}]
5737     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
5738     if {$endrow >= $vrowmod($curview)} {
5739         update_arcrows $curview
5740     }
5741     if {$selectedline ne {} &&
5742         $row <= $selectedline && $selectedline <= $endrow} {
5743         set targetrow $selectedline
5744     } elseif {[info exists targetid]} {
5745         set targetrow [expr {int(($row + $endrow) / 2)}]
5746     }
5747     if {[info exists targetrow]} {
5748         if {$targetrow >= $numcommits} {
5749             set targetrow [expr {$numcommits - 1}]
5750         }
5751         set targetid [commitonrow $targetrow]
5752     }
5753     drawcommits $row $endrow
5754 }
5755
5756 proc clear_display {} {
5757     global iddrawn linesegs need_redisplay nrows_drawn
5758     global vhighlights fhighlights nhighlights rhighlights
5759     global linehtag linentag linedtag boldids boldnameids
5760
5761     allcanvs delete all
5762     catch {unset iddrawn}
5763     catch {unset linesegs}
5764     catch {unset linehtag}
5765     catch {unset linentag}
5766     catch {unset linedtag}
5767     set boldids {}
5768     set boldnameids {}
5769     catch {unset vhighlights}
5770     catch {unset fhighlights}
5771     catch {unset nhighlights}
5772     catch {unset rhighlights}
5773     set need_redisplay 0
5774     set nrows_drawn 0
5775 }
5776
5777 proc findcrossings {id} {
5778     global rowidlist parentlist numcommits displayorder
5779
5780     set cross {}
5781     set ccross {}
5782     foreach {s e} [rowranges $id] {
5783         if {$e >= $numcommits} {
5784             set e [expr {$numcommits - 1}]
5785         }
5786         if {$e <= $s} continue
5787         for {set row $e} {[incr row -1] >= $s} {} {
5788             set x [lsearch -exact [lindex $rowidlist $row] $id]
5789             if {$x < 0} break
5790             set olds [lindex $parentlist $row]
5791             set kid [lindex $displayorder $row]
5792             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
5793             if {$kidx < 0} continue
5794             set nextrow [lindex $rowidlist [expr {$row + 1}]]
5795             foreach p $olds {
5796                 set px [lsearch -exact $nextrow $p]
5797                 if {$px < 0} continue
5798                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
5799                     if {[lsearch -exact $ccross $p] >= 0} continue
5800                     if {$x == $px + ($kidx < $px? -1: 1)} {
5801                         lappend ccross $p
5802                     } elseif {[lsearch -exact $cross $p] < 0} {
5803                         lappend cross $p
5804                     }
5805                 }
5806             }
5807         }
5808     }
5809     return [concat $ccross {{}} $cross]
5810 }
5811
5812 proc assigncolor {id} {
5813     global colormap colors nextcolor
5814     global parents children children curview
5815
5816     if {[info exists colormap($id)]} return
5817     set ncolors [llength $colors]
5818     if {[info exists children($curview,$id)]} {
5819         set kids $children($curview,$id)
5820     } else {
5821         set kids {}
5822     }
5823     if {[llength $kids] == 1} {
5824         set child [lindex $kids 0]
5825         if {[info exists colormap($child)]
5826             && [llength $parents($curview,$child)] == 1} {
5827             set colormap($id) $colormap($child)
5828             return
5829         }
5830     }
5831     set badcolors {}
5832     set origbad {}
5833     foreach x [findcrossings $id] {
5834         if {$x eq {}} {
5835             # delimiter between corner crossings and other crossings
5836             if {[llength $badcolors] >= $ncolors - 1} break
5837             set origbad $badcolors
5838         }
5839         if {[info exists colormap($x)]
5840             && [lsearch -exact $badcolors $colormap($x)] < 0} {
5841             lappend badcolors $colormap($x)
5842         }
5843     }
5844     if {[llength $badcolors] >= $ncolors} {
5845         set badcolors $origbad
5846     }
5847     set origbad $badcolors
5848     if {[llength $badcolors] < $ncolors - 1} {
5849         foreach child $kids {
5850             if {[info exists colormap($child)]
5851                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
5852                 lappend badcolors $colormap($child)
5853             }
5854             foreach p $parents($curview,$child) {
5855                 if {[info exists colormap($p)]
5856                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
5857                     lappend badcolors $colormap($p)
5858                 }
5859             }
5860         }
5861         if {[llength $badcolors] >= $ncolors} {
5862             set badcolors $origbad
5863         }
5864     }
5865     for {set i 0} {$i <= $ncolors} {incr i} {
5866         set c [lindex $colors $nextcolor]
5867         if {[incr nextcolor] >= $ncolors} {
5868             set nextcolor 0
5869         }
5870         if {[lsearch -exact $badcolors $c]} break
5871     }
5872     set colormap($id) $c
5873 }
5874
5875 proc bindline {t id} {
5876     global canv
5877
5878     $canv bind $t <Enter> "lineenter %x %y $id"
5879     $canv bind $t <Motion> "linemotion %x %y $id"
5880     $canv bind $t <Leave> "lineleave $id"
5881     $canv bind $t <Button-1> "lineclick %x %y $id 1"
5882 }
5883
5884 proc drawtags {id x xt y1} {
5885     global idtags idheads idotherrefs mainhead
5886     global linespc lthickness
5887     global canv rowtextx curview fgcolor bgcolor ctxbut
5888
5889     set marks {}
5890     set ntags 0
5891     set nheads 0
5892     if {[info exists idtags($id)]} {
5893         set marks $idtags($id)
5894         set ntags [llength $marks]
5895     }
5896     if {[info exists idheads($id)]} {
5897         set marks [concat $marks $idheads($id)]
5898         set nheads [llength $idheads($id)]
5899     }
5900     if {[info exists idotherrefs($id)]} {
5901         set marks [concat $marks $idotherrefs($id)]
5902     }
5903     if {$marks eq {}} {
5904         return $xt
5905     }
5906
5907     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
5908     set yt [expr {$y1 - 0.5 * $linespc}]
5909     set yb [expr {$yt + $linespc - 1}]
5910     set xvals {}
5911     set wvals {}
5912     set i -1
5913     foreach tag $marks {
5914         incr i
5915         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
5916             set wid [font measure mainfontbold $tag]
5917         } else {
5918             set wid [font measure mainfont $tag]
5919         }
5920         lappend xvals $xt
5921         lappend wvals $wid
5922         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
5923     }
5924     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
5925                -width $lthickness -fill black -tags tag.$id]
5926     $canv lower $t
5927     foreach tag $marks x $xvals wid $wvals {
5928         set xl [expr {$x + $delta}]
5929         set xr [expr {$x + $delta + $wid + $lthickness}]
5930         set font mainfont
5931         if {[incr ntags -1] >= 0} {
5932             # draw a tag
5933             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
5934                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
5935                        -width 1 -outline black -fill yellow -tags tag.$id]
5936             $canv bind $t <1> [list showtag $tag 1]
5937             set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
5938         } else {
5939             # draw a head or other ref
5940             if {[incr nheads -1] >= 0} {
5941                 set col green
5942                 if {$tag eq $mainhead} {
5943                     set font mainfontbold
5944                 }
5945             } else {
5946                 set col "#ddddff"
5947             }
5948             set xl [expr {$xl - $delta/2}]
5949             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
5950                 -width 1 -outline black -fill $col -tags tag.$id
5951             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
5952                 set rwid [font measure mainfont $remoteprefix]
5953                 set xi [expr {$x + 1}]
5954                 set yti [expr {$yt + 1}]
5955                 set xri [expr {$x + $rwid}]
5956                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
5957                         -width 0 -fill "#ffddaa" -tags tag.$id
5958             }
5959         }
5960         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
5961                    -font $font -tags [list tag.$id text]]
5962         if {$ntags >= 0} {
5963             $canv bind $t <1> [list showtag $tag 1]
5964         } elseif {$nheads >= 0} {
5965             $canv bind $t $ctxbut [list headmenu %X %Y $id $tag]
5966         }
5967     }
5968     return $xt
5969 }
5970
5971 proc xcoord {i level ln} {
5972     global canvx0 xspc1 xspc2
5973
5974     set x [expr {$canvx0 + $i * $xspc1($ln)}]
5975     if {$i > 0 && $i == $level} {
5976         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
5977     } elseif {$i > $level} {
5978         set x [expr {$x + $xspc2 - $xspc1($ln)}]
5979     }
5980     return $x
5981 }
5982
5983 proc show_status {msg} {
5984     global canv fgcolor
5985
5986     clear_display
5987     $canv create text 3 3 -anchor nw -text $msg -font mainfont \
5988         -tags text -fill $fgcolor
5989 }
5990
5991 # Don't change the text pane cursor if it is currently the hand cursor,
5992 # showing that we are over a sha1 ID link.
5993 proc settextcursor {c} {
5994     global ctext curtextcursor
5995
5996     if {[$ctext cget -cursor] == $curtextcursor} {
5997         $ctext config -cursor $c
5998     }
5999     set curtextcursor $c
6000 }
6001
6002 proc nowbusy {what {name {}}} {
6003     global isbusy busyname statusw
6004
6005     if {[array names isbusy] eq {}} {
6006         . config -cursor watch
6007         settextcursor watch
6008     }
6009     set isbusy($what) 1
6010     set busyname($what) $name
6011     if {$name ne {}} {
6012         $statusw conf -text $name
6013     }
6014 }
6015
6016 proc notbusy {what} {
6017     global isbusy maincursor textcursor busyname statusw
6018
6019     catch {
6020         unset isbusy($what)
6021         if {$busyname($what) ne {} &&
6022             [$statusw cget -text] eq $busyname($what)} {
6023             $statusw conf -text {}
6024         }
6025     }
6026     if {[array names isbusy] eq {}} {
6027         . config -cursor $maincursor
6028         settextcursor $textcursor
6029     }
6030 }
6031
6032 proc findmatches {f} {
6033     global findtype findstring
6034     if {$findtype == [mc "Regexp"]} {
6035         set matches [regexp -indices -all -inline $findstring $f]
6036     } else {
6037         set fs $findstring
6038         if {$findtype == [mc "IgnCase"]} {
6039             set f [string tolower $f]
6040             set fs [string tolower $fs]
6041         }
6042         set matches {}
6043         set i 0
6044         set l [string length $fs]
6045         while {[set j [string first $fs $f $i]] >= 0} {
6046             lappend matches [list $j [expr {$j+$l-1}]]
6047             set i [expr {$j + $l}]
6048         }
6049     }
6050     return $matches
6051 }
6052
6053 proc dofind {{dirn 1} {wrap 1}} {
6054     global findstring findstartline findcurline selectedline numcommits
6055     global gdttype filehighlight fh_serial find_dirn findallowwrap
6056
6057     if {[info exists find_dirn]} {
6058         if {$find_dirn == $dirn} return
6059         stopfinding
6060     }
6061     focus .
6062     if {$findstring eq {} || $numcommits == 0} return
6063     if {$selectedline eq {}} {
6064         set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6065     } else {
6066         set findstartline $selectedline
6067     }
6068     set findcurline $findstartline
6069     nowbusy finding [mc "Searching"]
6070     if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6071         after cancel do_file_hl $fh_serial
6072         do_file_hl $fh_serial
6073     }
6074     set find_dirn $dirn
6075     set findallowwrap $wrap
6076     run findmore
6077 }
6078
6079 proc stopfinding {} {
6080     global find_dirn findcurline fprogcoord
6081
6082     if {[info exists find_dirn]} {
6083         unset find_dirn
6084         unset findcurline
6085         notbusy finding
6086         set fprogcoord 0
6087         adjustprogress
6088     }
6089     stopblaming
6090 }
6091
6092 proc findmore {} {
6093     global commitdata commitinfo numcommits findpattern findloc
6094     global findstartline findcurline findallowwrap
6095     global find_dirn gdttype fhighlights fprogcoord
6096     global curview varcorder vrownum varccommits vrowmod
6097
6098     if {![info exists find_dirn]} {
6099         return 0
6100     }
6101     set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
6102     set l $findcurline
6103     set moretodo 0
6104     if {$find_dirn > 0} {
6105         incr l
6106         if {$l >= $numcommits} {
6107             set l 0
6108         }
6109         if {$l <= $findstartline} {
6110             set lim [expr {$findstartline + 1}]
6111         } else {
6112             set lim $numcommits
6113             set moretodo $findallowwrap
6114         }
6115     } else {
6116         if {$l == 0} {
6117             set l $numcommits
6118         }
6119         incr l -1
6120         if {$l >= $findstartline} {
6121             set lim [expr {$findstartline - 1}]
6122         } else {
6123             set lim -1
6124             set moretodo $findallowwrap
6125         }
6126     }
6127     set n [expr {($lim - $l) * $find_dirn}]
6128     if {$n > 500} {
6129         set n 500
6130         set moretodo 1
6131     }
6132     if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6133         update_arcrows $curview
6134     }
6135     set found 0
6136     set domore 1
6137     set ai [bsearch $vrownum($curview) $l]
6138     set a [lindex $varcorder($curview) $ai]
6139     set arow [lindex $vrownum($curview) $ai]
6140     set ids [lindex $varccommits($curview,$a)]
6141     set arowend [expr {$arow + [llength $ids]}]
6142     if {$gdttype eq [mc "containing:"]} {
6143         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6144             if {$l < $arow || $l >= $arowend} {
6145                 incr ai $find_dirn
6146                 set a [lindex $varcorder($curview) $ai]
6147                 set arow [lindex $vrownum($curview) $ai]
6148                 set ids [lindex $varccommits($curview,$a)]
6149                 set arowend [expr {$arow + [llength $ids]}]
6150             }
6151             set id [lindex $ids [expr {$l - $arow}]]
6152             # shouldn't happen unless git log doesn't give all the commits...
6153             if {![info exists commitdata($id)] ||
6154                 ![doesmatch $commitdata($id)]} {
6155                 continue
6156             }
6157             if {![info exists commitinfo($id)]} {
6158                 getcommit $id
6159             }
6160             set info $commitinfo($id)
6161             foreach f $info ty $fldtypes {
6162                 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6163                     [doesmatch $f]} {
6164                     set found 1
6165                     break
6166                 }
6167             }
6168             if {$found} break
6169         }
6170     } else {
6171         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6172             if {$l < $arow || $l >= $arowend} {
6173                 incr ai $find_dirn
6174                 set a [lindex $varcorder($curview) $ai]
6175                 set arow [lindex $vrownum($curview) $ai]
6176                 set ids [lindex $varccommits($curview,$a)]
6177                 set arowend [expr {$arow + [llength $ids]}]
6178             }
6179             set id [lindex $ids [expr {$l - $arow}]]
6180             if {![info exists fhighlights($id)]} {
6181                 # this sets fhighlights($id) to -1
6182                 askfilehighlight $l $id
6183             }
6184             if {$fhighlights($id) > 0} {
6185                 set found $domore
6186                 break
6187             }
6188             if {$fhighlights($id) < 0} {
6189                 if {$domore} {
6190                     set domore 0
6191                     set findcurline [expr {$l - $find_dirn}]
6192                 }
6193             }
6194         }
6195     }
6196     if {$found || ($domore && !$moretodo)} {
6197         unset findcurline
6198         unset find_dirn
6199         notbusy finding
6200         set fprogcoord 0
6201         adjustprogress
6202         if {$found} {
6203             findselectline $l
6204         } else {
6205             bell
6206         }
6207         return 0
6208     }
6209     if {!$domore} {
6210         flushhighlights
6211     } else {
6212         set findcurline [expr {$l - $find_dirn}]
6213     }
6214     set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6215     if {$n < 0} {
6216         incr n $numcommits
6217     }
6218     set fprogcoord [expr {$n * 1.0 / $numcommits}]
6219     adjustprogress
6220     return $domore
6221 }
6222
6223 proc findselectline {l} {
6224     global findloc commentend ctext findcurline markingmatches gdttype
6225
6226     set markingmatches 1
6227     set findcurline $l
6228     selectline $l 1
6229     if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
6230         # highlight the matches in the comments
6231         set f [$ctext get 1.0 $commentend]
6232         set matches [findmatches $f]
6233         foreach match $matches {
6234             set start [lindex $match 0]
6235             set end [expr {[lindex $match 1] + 1}]
6236             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6237         }
6238     }
6239     drawvisible
6240 }
6241
6242 # mark the bits of a headline or author that match a find string
6243 proc markmatches {canv l str tag matches font row} {
6244     global selectedline
6245
6246     set bbox [$canv bbox $tag]
6247     set x0 [lindex $bbox 0]
6248     set y0 [lindex $bbox 1]
6249     set y1 [lindex $bbox 3]
6250     foreach match $matches {
6251         set start [lindex $match 0]
6252         set end [lindex $match 1]
6253         if {$start > $end} continue
6254         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6255         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6256         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6257                    [expr {$x0+$xlen+2}] $y1 \
6258                    -outline {} -tags [list match$l matches] -fill yellow]
6259         $canv lower $t
6260         if {$row == $selectedline} {
6261             $canv raise $t secsel
6262         }
6263     }
6264 }
6265
6266 proc unmarkmatches {} {
6267     global markingmatches
6268
6269     allcanvs delete matches
6270     set markingmatches 0
6271     stopfinding
6272 }
6273
6274 proc selcanvline {w x y} {
6275     global canv canvy0 ctext linespc
6276     global rowtextx
6277     set ymax [lindex [$canv cget -scrollregion] 3]
6278     if {$ymax == {}} return
6279     set yfrac [lindex [$canv yview] 0]
6280     set y [expr {$y + $yfrac * $ymax}]
6281     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6282     if {$l < 0} {
6283         set l 0
6284     }
6285     if {$w eq $canv} {
6286         set xmax [lindex [$canv cget -scrollregion] 2]
6287         set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6288         if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6289     }
6290     unmarkmatches
6291     selectline $l 1
6292 }
6293
6294 proc commit_descriptor {p} {
6295     global commitinfo
6296     if {![info exists commitinfo($p)]} {
6297         getcommit $p
6298     }
6299     set l "..."
6300     if {[llength $commitinfo($p)] > 1} {
6301         set l [lindex $commitinfo($p) 0]
6302     }
6303     return "$p ($l)\n"
6304 }
6305
6306 # append some text to the ctext widget, and make any SHA1 ID
6307 # that we know about be a clickable link.
6308 proc appendwithlinks {text tags} {
6309     global ctext linknum curview
6310
6311     set start [$ctext index "end - 1c"]
6312     $ctext insert end $text $tags
6313     set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
6314     foreach l $links {
6315         set s [lindex $l 0]
6316         set e [lindex $l 1]
6317         set linkid [string range $text $s $e]
6318         incr e
6319         $ctext tag delete link$linknum
6320         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6321         setlink $linkid link$linknum
6322         incr linknum
6323     }
6324 }
6325
6326 proc setlink {id lk} {
6327     global curview ctext pendinglinks
6328
6329     set known 0
6330     if {[string length $id] < 40} {
6331         set matches [longid $id]
6332         if {[llength $matches] > 0} {
6333             if {[llength $matches] > 1} return
6334             set known 1
6335             set id [lindex $matches 0]
6336         }
6337     } else {
6338         set known [commitinview $id $curview]
6339     }
6340     if {$known} {
6341         $ctext tag conf $lk -foreground blue -underline 1
6342         $ctext tag bind $lk <1> [list selbyid $id]
6343         $ctext tag bind $lk <Enter> {linkcursor %W 1}
6344         $ctext tag bind $lk <Leave> {linkcursor %W -1}
6345     } else {
6346         lappend pendinglinks($id) $lk
6347         interestedin $id {makelink %P}
6348     }
6349 }
6350
6351 proc makelink {id} {
6352     global pendinglinks
6353
6354     if {![info exists pendinglinks($id)]} return
6355     foreach lk $pendinglinks($id) {
6356         setlink $id $lk
6357     }
6358     unset pendinglinks($id)
6359 }
6360
6361 proc linkcursor {w inc} {
6362     global linkentercount curtextcursor
6363
6364     if {[incr linkentercount $inc] > 0} {
6365         $w configure -cursor hand2
6366     } else {
6367         $w configure -cursor $curtextcursor
6368         if {$linkentercount < 0} {
6369             set linkentercount 0
6370         }
6371     }
6372 }
6373
6374 proc viewnextline {dir} {
6375     global canv linespc
6376
6377     $canv delete hover
6378     set ymax [lindex [$canv cget -scrollregion] 3]
6379     set wnow [$canv yview]
6380     set wtop [expr {[lindex $wnow 0] * $ymax}]
6381     set newtop [expr {$wtop + $dir * $linespc}]
6382     if {$newtop < 0} {
6383         set newtop 0
6384     } elseif {$newtop > $ymax} {
6385         set newtop $ymax
6386     }
6387     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6388 }
6389
6390 # add a list of tag or branch names at position pos
6391 # returns the number of names inserted
6392 proc appendrefs {pos ids var} {
6393     global ctext linknum curview $var maxrefs
6394
6395     if {[catch {$ctext index $pos}]} {
6396         return 0
6397     }
6398     $ctext conf -state normal
6399     $ctext delete $pos "$pos lineend"
6400     set tags {}
6401     foreach id $ids {
6402         foreach tag [set $var\($id\)] {
6403             lappend tags [list $tag $id]
6404         }
6405     }
6406     if {[llength $tags] > $maxrefs} {
6407         $ctext insert $pos "many ([llength $tags])"
6408     } else {
6409         set tags [lsort -index 0 -decreasing $tags]
6410         set sep {}
6411         foreach ti $tags {
6412             set id [lindex $ti 1]
6413             set lk link$linknum
6414             incr linknum
6415             $ctext tag delete $lk
6416             $ctext insert $pos $sep
6417             $ctext insert $pos [lindex $ti 0] $lk
6418             setlink $id $lk
6419             set sep ", "
6420         }
6421     }
6422     $ctext conf -state disabled
6423     return [llength $tags]
6424 }
6425
6426 # called when we have finished computing the nearby tags
6427 proc dispneartags {delay} {
6428     global selectedline currentid showneartags tagphase
6429
6430     if {$selectedline eq {} || !$showneartags} return
6431     after cancel dispnexttag
6432     if {$delay} {
6433         after 200 dispnexttag
6434         set tagphase -1
6435     } else {
6436         after idle dispnexttag
6437         set tagphase 0
6438     }
6439 }
6440
6441 proc dispnexttag {} {
6442     global selectedline currentid showneartags tagphase ctext
6443
6444     if {$selectedline eq {} || !$showneartags} return
6445     switch -- $tagphase {
6446         0 {
6447             set dtags [desctags $currentid]
6448             if {$dtags ne {}} {
6449                 appendrefs precedes $dtags idtags
6450             }
6451         }
6452         1 {
6453             set atags [anctags $currentid]
6454             if {$atags ne {}} {
6455                 appendrefs follows $atags idtags
6456             }
6457         }
6458         2 {
6459             set dheads [descheads $currentid]
6460             if {$dheads ne {}} {
6461                 if {[appendrefs branch $dheads idheads] > 1
6462                     && [$ctext get "branch -3c"] eq "h"} {
6463                     # turn "Branch" into "Branches"
6464                     $ctext conf -state normal
6465                     $ctext insert "branch -2c" "es"
6466                     $ctext conf -state disabled
6467                 }
6468             }
6469         }
6470     }
6471     if {[incr tagphase] <= 2} {
6472         after idle dispnexttag
6473     }
6474 }
6475
6476 proc make_secsel {id} {
6477     global linehtag linentag linedtag canv canv2 canv3
6478
6479     if {![info exists linehtag($id)]} return
6480     $canv delete secsel
6481     set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
6482                -tags secsel -fill [$canv cget -selectbackground]]
6483     $canv lower $t
6484     $canv2 delete secsel
6485     set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
6486                -tags secsel -fill [$canv2 cget -selectbackground]]
6487     $canv2 lower $t
6488     $canv3 delete secsel
6489     set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
6490                -tags secsel -fill [$canv3 cget -selectbackground]]
6491     $canv3 lower $t
6492 }
6493
6494 proc selectline {l isnew {desired_loc {}}} {
6495     global canv ctext commitinfo selectedline
6496     global canvy0 linespc parents children curview
6497     global currentid sha1entry
6498     global commentend idtags linknum
6499     global mergemax numcommits pending_select
6500     global cmitmode showneartags allcommits
6501     global targetrow targetid lastscrollrows
6502     global autoselect jump_to_here
6503
6504     catch {unset pending_select}
6505     $canv delete hover
6506     normalline
6507     unsel_reflist
6508     stopfinding
6509     if {$l < 0 || $l >= $numcommits} return
6510     set id [commitonrow $l]
6511     set targetid $id
6512     set targetrow $l
6513     set selectedline $l
6514     set currentid $id
6515     if {$lastscrollrows < $numcommits} {
6516         setcanvscroll
6517     }
6518
6519     set y [expr {$canvy0 + $l * $linespc}]
6520     set ymax [lindex [$canv cget -scrollregion] 3]
6521     set ytop [expr {$y - $linespc - 1}]
6522     set ybot [expr {$y + $linespc + 1}]
6523     set wnow [$canv yview]
6524     set wtop [expr {[lindex $wnow 0] * $ymax}]
6525     set wbot [expr {[lindex $wnow 1] * $ymax}]
6526     set wh [expr {$wbot - $wtop}]
6527     set newtop $wtop
6528     if {$ytop < $wtop} {
6529         if {$ybot < $wtop} {
6530             set newtop [expr {$y - $wh / 2.0}]
6531         } else {
6532             set newtop $ytop
6533             if {$newtop > $wtop - $linespc} {
6534                 set newtop [expr {$wtop - $linespc}]
6535             }
6536         }
6537     } elseif {$ybot > $wbot} {
6538         if {$ytop > $wbot} {
6539             set newtop [expr {$y - $wh / 2.0}]
6540         } else {
6541             set newtop [expr {$ybot - $wh}]
6542             if {$newtop < $wtop + $linespc} {
6543                 set newtop [expr {$wtop + $linespc}]
6544             }
6545         }
6546     }
6547     if {$newtop != $wtop} {
6548         if {$newtop < 0} {
6549             set newtop 0
6550         }
6551         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6552         drawvisible
6553     }
6554
6555     make_secsel $id
6556
6557     if {$isnew} {
6558         addtohistory [list selbyid $id]
6559     }
6560
6561     $sha1entry delete 0 end
6562     $sha1entry insert 0 $id
6563     if {$autoselect} {
6564         $sha1entry selection from 0
6565         $sha1entry selection to end
6566     }
6567     rhighlight_sel $id
6568
6569     $ctext conf -state normal
6570     clear_ctext
6571     set linknum 0
6572     if {![info exists commitinfo($id)]} {
6573         getcommit $id
6574     }
6575     set info $commitinfo($id)
6576     set date [formatdate [lindex $info 2]]
6577     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
6578     set date [formatdate [lindex $info 4]]
6579     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
6580     if {[info exists idtags($id)]} {
6581         $ctext insert end [mc "Tags:"]
6582         foreach tag $idtags($id) {
6583             $ctext insert end " $tag"
6584         }
6585         $ctext insert end "\n"
6586     }
6587
6588     set headers {}
6589     set olds $parents($curview,$id)
6590     if {[llength $olds] > 1} {
6591         set np 0
6592         foreach p $olds {
6593             if {$np >= $mergemax} {
6594                 set tag mmax
6595             } else {
6596                 set tag m$np
6597             }
6598             $ctext insert end "[mc "Parent"]: " $tag
6599             appendwithlinks [commit_descriptor $p] {}
6600             incr np
6601         }
6602     } else {
6603         foreach p $olds {
6604             append headers "[mc "Parent"]: [commit_descriptor $p]"
6605         }
6606     }
6607
6608     foreach c $children($curview,$id) {
6609         append headers "[mc "Child"]:  [commit_descriptor $c]"
6610     }
6611
6612     # make anything that looks like a SHA1 ID be a clickable link
6613     appendwithlinks $headers {}
6614     if {$showneartags} {
6615         if {![info exists allcommits]} {
6616             getallcommits
6617         }
6618         $ctext insert end "[mc "Branch"]: "
6619         $ctext mark set branch "end -1c"
6620         $ctext mark gravity branch left
6621         $ctext insert end "\n[mc "Follows"]: "
6622         $ctext mark set follows "end -1c"
6623         $ctext mark gravity follows left
6624         $ctext insert end "\n[mc "Precedes"]: "
6625         $ctext mark set precedes "end -1c"
6626         $ctext mark gravity precedes left
6627         $ctext insert end "\n"
6628         dispneartags 1
6629     }
6630     $ctext insert end "\n"
6631     set comment [lindex $info 5]
6632     if {[string first "\r" $comment] >= 0} {
6633         set comment [string map {"\r" "\n    "} $comment]
6634     }
6635     appendwithlinks $comment {comment}
6636
6637     $ctext tag remove found 1.0 end
6638     $ctext conf -state disabled
6639     set commentend [$ctext index "end - 1c"]
6640
6641     set jump_to_here $desired_loc
6642     init_flist [mc "Comments"]
6643     if {$cmitmode eq "tree"} {
6644         gettree $id
6645     } elseif {[llength $olds] <= 1} {
6646         startdiff $id
6647     } else {
6648         mergediff $id
6649     }
6650 }
6651
6652 proc selfirstline {} {
6653     unmarkmatches
6654     selectline 0 1
6655 }
6656
6657 proc sellastline {} {
6658     global numcommits
6659     unmarkmatches
6660     set l [expr {$numcommits - 1}]
6661     selectline $l 1
6662 }
6663
6664 proc selnextline {dir} {
6665     global selectedline
6666     focus .
6667     if {$selectedline eq {}} return
6668     set l [expr {$selectedline + $dir}]
6669     unmarkmatches
6670     selectline $l 1
6671 }
6672
6673 proc selnextpage {dir} {
6674     global canv linespc selectedline numcommits
6675
6676     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
6677     if {$lpp < 1} {
6678         set lpp 1
6679     }
6680     allcanvs yview scroll [expr {$dir * $lpp}] units
6681     drawvisible
6682     if {$selectedline eq {}} return
6683     set l [expr {$selectedline + $dir * $lpp}]
6684     if {$l < 0} {
6685         set l 0
6686     } elseif {$l >= $numcommits} {
6687         set l [expr $numcommits - 1]
6688     }
6689     unmarkmatches
6690     selectline $l 1
6691 }
6692
6693 proc unselectline {} {
6694     global selectedline currentid
6695
6696     set selectedline {}
6697     catch {unset currentid}
6698     allcanvs delete secsel
6699     rhighlight_none
6700 }
6701
6702 proc reselectline {} {
6703     global selectedline
6704
6705     if {$selectedline ne {}} {
6706         selectline $selectedline 0
6707     }
6708 }
6709
6710 proc addtohistory {cmd} {
6711     global history historyindex curview
6712
6713     set elt [list $curview $cmd]
6714     if {$historyindex > 0
6715         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
6716         return
6717     }
6718
6719     if {$historyindex < [llength $history]} {
6720         set history [lreplace $history $historyindex end $elt]
6721     } else {
6722         lappend history $elt
6723     }
6724     incr historyindex
6725     if {$historyindex > 1} {
6726         .tf.bar.leftbut conf -state normal
6727     } else {
6728         .tf.bar.leftbut conf -state disabled
6729     }
6730     .tf.bar.rightbut conf -state disabled
6731 }
6732
6733 proc godo {elt} {
6734     global curview
6735
6736     set view [lindex $elt 0]
6737     set cmd [lindex $elt 1]
6738     if {$curview != $view} {
6739         showview $view
6740     }
6741     eval $cmd
6742 }
6743
6744 proc goback {} {
6745     global history historyindex
6746     focus .
6747
6748     if {$historyindex > 1} {
6749         incr historyindex -1
6750         godo [lindex $history [expr {$historyindex - 1}]]
6751         .tf.bar.rightbut conf -state normal
6752     }
6753     if {$historyindex <= 1} {
6754         .tf.bar.leftbut conf -state disabled
6755     }
6756 }
6757
6758 proc goforw {} {
6759     global history historyindex
6760     focus .
6761
6762     if {$historyindex < [llength $history]} {
6763         set cmd [lindex $history $historyindex]
6764         incr historyindex
6765         godo $cmd
6766         .tf.bar.leftbut conf -state normal
6767     }
6768     if {$historyindex >= [llength $history]} {
6769         .tf.bar.rightbut conf -state disabled
6770     }
6771 }
6772
6773 proc gettree {id} {
6774     global treefilelist treeidlist diffids diffmergeid treepending
6775     global nullid nullid2
6776
6777     set diffids $id
6778     catch {unset diffmergeid}
6779     if {![info exists treefilelist($id)]} {
6780         if {![info exists treepending]} {
6781             if {$id eq $nullid} {
6782                 set cmd [list | git ls-files]
6783             } elseif {$id eq $nullid2} {
6784                 set cmd [list | git ls-files --stage -t]
6785             } else {
6786                 set cmd [list | git ls-tree -r $id]
6787             }
6788             if {[catch {set gtf [open $cmd r]}]} {
6789                 return
6790             }
6791             set treepending $id
6792             set treefilelist($id) {}
6793             set treeidlist($id) {}
6794             fconfigure $gtf -blocking 0 -encoding binary
6795             filerun $gtf [list gettreeline $gtf $id]
6796         }
6797     } else {
6798         setfilelist $id
6799     }
6800 }
6801
6802 proc gettreeline {gtf id} {
6803     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
6804
6805     set nl 0
6806     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
6807         if {$diffids eq $nullid} {
6808             set fname $line
6809         } else {
6810             set i [string first "\t" $line]
6811             if {$i < 0} continue
6812             set fname [string range $line [expr {$i+1}] end]
6813             set line [string range $line 0 [expr {$i-1}]]
6814             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
6815             set sha1 [lindex $line 2]
6816             lappend treeidlist($id) $sha1
6817         }
6818         if {[string index $fname 0] eq "\""} {
6819             set fname [lindex $fname 0]
6820         }
6821         set fname [encoding convertfrom $fname]
6822         lappend treefilelist($id) $fname
6823     }
6824     if {![eof $gtf]} {
6825         return [expr {$nl >= 1000? 2: 1}]
6826     }
6827     close $gtf
6828     unset treepending
6829     if {$cmitmode ne "tree"} {
6830         if {![info exists diffmergeid]} {
6831             gettreediffs $diffids
6832         }
6833     } elseif {$id ne $diffids} {
6834         gettree $diffids
6835     } else {
6836         setfilelist $id
6837     }
6838     return 0
6839 }
6840
6841 proc showfile {f} {
6842     global treefilelist treeidlist diffids nullid nullid2
6843     global ctext_file_names ctext_file_lines
6844     global ctext commentend
6845
6846     set i [lsearch -exact $treefilelist($diffids) $f]
6847     if {$i < 0} {
6848         puts "oops, $f not in list for id $diffids"
6849         return
6850     }
6851     if {$diffids eq $nullid} {
6852         if {[catch {set bf [open $f r]} err]} {
6853             puts "oops, can't read $f: $err"
6854             return
6855         }
6856     } else {
6857         set blob [lindex $treeidlist($diffids) $i]
6858         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
6859             puts "oops, error reading blob $blob: $err"
6860             return
6861         }
6862     }
6863     fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
6864     filerun $bf [list getblobline $bf $diffids]
6865     $ctext config -state normal
6866     clear_ctext $commentend
6867     lappend ctext_file_names $f
6868     lappend ctext_file_lines [lindex [split $commentend "."] 0]
6869     $ctext insert end "\n"
6870     $ctext insert end "$f\n" filesep
6871     $ctext config -state disabled
6872     $ctext yview $commentend
6873     settabs 0
6874 }
6875
6876 proc getblobline {bf id} {
6877     global diffids cmitmode ctext
6878
6879     if {$id ne $diffids || $cmitmode ne "tree"} {
6880         catch {close $bf}
6881         return 0
6882     }
6883     $ctext config -state normal
6884     set nl 0
6885     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
6886         $ctext insert end "$line\n"
6887     }
6888     if {[eof $bf]} {
6889         global jump_to_here ctext_file_names commentend
6890
6891         # delete last newline
6892         $ctext delete "end - 2c" "end - 1c"
6893         close $bf
6894         if {$jump_to_here ne {} &&
6895             [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
6896             set lnum [expr {[lindex $jump_to_here 1] +
6897                             [lindex [split $commentend .] 0]}]
6898             mark_ctext_line $lnum
6899         }
6900         return 0
6901     }
6902     $ctext config -state disabled
6903     return [expr {$nl >= 1000? 2: 1}]
6904 }
6905
6906 proc mark_ctext_line {lnum} {
6907     global ctext markbgcolor
6908
6909     $ctext tag delete omark
6910     $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
6911     $ctext tag conf omark -background $markbgcolor
6912     $ctext see $lnum.0
6913 }
6914
6915 proc mergediff {id} {
6916     global diffmergeid
6917     global diffids treediffs
6918     global parents curview
6919
6920     set diffmergeid $id
6921     set diffids $id
6922     set treediffs($id) {}
6923     set np [llength $parents($curview,$id)]
6924     settabs $np
6925     getblobdiffs $id
6926 }
6927
6928 proc startdiff {ids} {
6929     global treediffs diffids treepending diffmergeid nullid nullid2
6930
6931     settabs 1
6932     set diffids $ids
6933     catch {unset diffmergeid}
6934     if {![info exists treediffs($ids)] ||
6935         [lsearch -exact $ids $nullid] >= 0 ||
6936         [lsearch -exact $ids $nullid2] >= 0} {
6937         if {![info exists treepending]} {
6938             gettreediffs $ids
6939         }
6940     } else {
6941         addtocflist $ids
6942     }
6943 }
6944
6945 proc path_filter {filter name} {
6946     foreach p $filter {
6947         set l [string length $p]
6948         if {[string index $p end] eq "/"} {
6949             if {[string compare -length $l $p $name] == 0} {
6950                 return 1
6951             }
6952         } else {
6953             if {[string compare -length $l $p $name] == 0 &&
6954                 ([string length $name] == $l ||
6955                  [string index $name $l] eq "/")} {
6956                 return 1
6957             }
6958         }
6959     }
6960     return 0
6961 }
6962
6963 proc addtocflist {ids} {
6964     global treediffs
6965
6966     add_flist $treediffs($ids)
6967     getblobdiffs $ids
6968 }
6969
6970 proc diffcmd {ids flags} {
6971     global nullid nullid2
6972
6973     set i [lsearch -exact $ids $nullid]
6974     set j [lsearch -exact $ids $nullid2]
6975     if {$i >= 0} {
6976         if {[llength $ids] > 1 && $j < 0} {
6977             # comparing working directory with some specific revision
6978             set cmd [concat | git diff-index $flags]
6979             if {$i == 0} {
6980                 lappend cmd -R [lindex $ids 1]
6981             } else {
6982                 lappend cmd [lindex $ids 0]
6983             }
6984         } else {
6985             # comparing working directory with index
6986             set cmd [concat | git diff-files $flags]
6987             if {$j == 1} {
6988                 lappend cmd -R
6989             }
6990         }
6991     } elseif {$j >= 0} {
6992         set cmd [concat | git diff-index --cached $flags]
6993         if {[llength $ids] > 1} {
6994             # comparing index with specific revision
6995             if {$i == 0} {
6996                 lappend cmd -R [lindex $ids 1]
6997             } else {
6998                 lappend cmd [lindex $ids 0]
6999             }
7000         } else {
7001             # comparing index with HEAD
7002             lappend cmd HEAD
7003         }
7004     } else {
7005         set cmd [concat | git diff-tree -r $flags $ids]
7006     }
7007     return $cmd
7008 }
7009
7010 proc gettreediffs {ids} {
7011     global treediff treepending
7012
7013     if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7014
7015     set treepending $ids
7016     set treediff {}
7017     fconfigure $gdtf -blocking 0 -encoding binary
7018     filerun $gdtf [list gettreediffline $gdtf $ids]
7019 }
7020
7021 proc gettreediffline {gdtf ids} {
7022     global treediff treediffs treepending diffids diffmergeid
7023     global cmitmode vfilelimit curview limitdiffs perfile_attrs
7024
7025     set nr 0
7026     set sublist {}
7027     set max 1000
7028     if {$perfile_attrs} {
7029         # cache_gitattr is slow, and even slower on win32 where we
7030         # have to invoke it for only about 30 paths at a time
7031         set max 500
7032         if {[tk windowingsystem] == "win32"} {
7033             set max 120
7034         }
7035     }
7036     while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7037         set i [string first "\t" $line]
7038         if {$i >= 0} {
7039             set file [string range $line [expr {$i+1}] end]
7040             if {[string index $file 0] eq "\""} {
7041                 set file [lindex $file 0]
7042             }
7043             set file [encoding convertfrom $file]
7044             if {$file ne [lindex $treediff end]} {
7045                 lappend treediff $file
7046                 lappend sublist $file
7047             }
7048         }
7049     }
7050     if {$perfile_attrs} {
7051         cache_gitattr encoding $sublist
7052     }
7053     if {![eof $gdtf]} {
7054         return [expr {$nr >= $max? 2: 1}]
7055     }
7056     close $gdtf
7057     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7058         set flist {}
7059         foreach f $treediff {
7060             if {[path_filter $vfilelimit($curview) $f]} {
7061                 lappend flist $f
7062             }
7063         }
7064         set treediffs($ids) $flist
7065     } else {
7066         set treediffs($ids) $treediff
7067     }
7068     unset treepending
7069     if {$cmitmode eq "tree"} {
7070         gettree $diffids
7071     } elseif {$ids != $diffids} {
7072         if {![info exists diffmergeid]} {
7073             gettreediffs $diffids
7074         }
7075     } else {
7076         addtocflist $ids
7077     }
7078     return 0
7079 }
7080
7081 # empty string or positive integer
7082 proc diffcontextvalidate {v} {
7083     return [regexp {^(|[1-9][0-9]*)$} $v]
7084 }
7085
7086 proc diffcontextchange {n1 n2 op} {
7087     global diffcontextstring diffcontext
7088
7089     if {[string is integer -strict $diffcontextstring]} {
7090         if {$diffcontextstring > 0} {
7091             set diffcontext $diffcontextstring
7092             reselectline
7093         }
7094     }
7095 }
7096
7097 proc changeignorespace {} {
7098     reselectline
7099 }
7100
7101 proc getblobdiffs {ids} {
7102     global blobdifffd diffids env
7103     global diffinhdr treediffs
7104     global diffcontext
7105     global ignorespace
7106     global limitdiffs vfilelimit curview
7107     global diffencoding targetline diffnparents
7108
7109     set cmd [diffcmd $ids "-p -C --cc --no-commit-id -U$diffcontext"]
7110     if {$ignorespace} {
7111         append cmd " -w"
7112     }
7113     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7114         set cmd [concat $cmd -- $vfilelimit($curview)]
7115     }
7116     if {[catch {set bdf [open $cmd r]} err]} {
7117         error_popup [mc "Error getting diffs: %s" $err]
7118         return
7119     }
7120     set targetline {}
7121     set diffnparents 0
7122     set diffinhdr 0
7123     set diffencoding [get_path_encoding {}]
7124     fconfigure $bdf -blocking 0 -encoding binary
7125     set blobdifffd($ids) $bdf
7126     filerun $bdf [list getblobdiffline $bdf $diffids]
7127 }
7128
7129 proc setinlist {var i val} {
7130     global $var
7131
7132     while {[llength [set $var]] < $i} {
7133         lappend $var {}
7134     }
7135     if {[llength [set $var]] == $i} {
7136         lappend $var $val
7137     } else {
7138         lset $var $i $val
7139     }
7140 }
7141
7142 proc makediffhdr {fname ids} {
7143     global ctext curdiffstart treediffs diffencoding
7144     global ctext_file_names jump_to_here targetline diffline
7145
7146     set fname [encoding convertfrom $fname]
7147     set diffencoding [get_path_encoding $fname]
7148     set i [lsearch -exact $treediffs($ids) $fname]
7149     if {$i >= 0} {
7150         setinlist difffilestart $i $curdiffstart
7151     }
7152     lset ctext_file_names end $fname
7153     set l [expr {(78 - [string length $fname]) / 2}]
7154     set pad [string range "----------------------------------------" 1 $l]
7155     $ctext insert $curdiffstart "$pad $fname $pad" filesep
7156     set targetline {}
7157     if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7158         set targetline [lindex $jump_to_here 1]
7159     }
7160     set diffline 0
7161 }
7162
7163 proc getblobdiffline {bdf ids} {
7164     global diffids blobdifffd ctext curdiffstart
7165     global diffnexthead diffnextnote difffilestart
7166     global ctext_file_names ctext_file_lines
7167     global diffinhdr treediffs mergemax diffnparents
7168     global diffencoding jump_to_here targetline diffline
7169
7170     set nr 0
7171     $ctext conf -state normal
7172     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7173         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7174             close $bdf
7175             return 0
7176         }
7177         if {![string compare -length 5 "diff " $line]} {
7178             if {![regexp {^diff (--cc|--git) } $line m type]} {
7179                 set line [encoding convertfrom $line]
7180                 $ctext insert end "$line\n" hunksep
7181                 continue
7182             }
7183             # start of a new file
7184             set diffinhdr 1
7185             $ctext insert end "\n"
7186             set curdiffstart [$ctext index "end - 1c"]
7187             lappend ctext_file_names ""
7188             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7189             $ctext insert end "\n" filesep
7190
7191             if {$type eq "--cc"} {
7192                 # start of a new file in a merge diff
7193                 set fname [string range $line 10 end]
7194                 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7195                     lappend treediffs($ids) $fname
7196                     add_flist [list $fname]
7197                 }
7198
7199             } else {
7200                 set line [string range $line 11 end]
7201                 # If the name hasn't changed the length will be odd,
7202                 # the middle char will be a space, and the two bits either
7203                 # side will be a/name and b/name, or "a/name" and "b/name".
7204                 # If the name has changed we'll get "rename from" and
7205                 # "rename to" or "copy from" and "copy to" lines following
7206                 # this, and we'll use them to get the filenames.
7207                 # This complexity is necessary because spaces in the
7208                 # filename(s) don't get escaped.
7209                 set l [string length $line]
7210                 set i [expr {$l / 2}]
7211                 if {!(($l & 1) && [string index $line $i] eq " " &&
7212                       [string range $line 2 [expr {$i - 1}]] eq \
7213                           [string range $line [expr {$i + 3}] end])} {
7214                     continue
7215                 }
7216                 # unescape if quoted and chop off the a/ from the front
7217                 if {[string index $line 0] eq "\""} {
7218                     set fname [string range [lindex $line 0] 2 end]
7219                 } else {
7220                     set fname [string range $line 2 [expr {$i - 1}]]
7221                 }
7222             }
7223             makediffhdr $fname $ids
7224
7225         } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7226             set fname [encoding convertfrom [string range $line 16 end]]
7227             $ctext insert end "\n"
7228             set curdiffstart [$ctext index "end - 1c"]
7229             lappend ctext_file_names $fname
7230             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7231             $ctext insert end "$line\n" filesep
7232             set i [lsearch -exact $treediffs($ids) $fname]
7233             if {$i >= 0} {
7234                 setinlist difffilestart $i $curdiffstart
7235             }
7236
7237         } elseif {![string compare -length 2 "@@" $line]} {
7238             regexp {^@@+} $line ats
7239             set line [encoding convertfrom $diffencoding $line]
7240             $ctext insert end "$line\n" hunksep
7241             if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7242                 set diffline $nl
7243             }
7244             set diffnparents [expr {[string length $ats] - 1}]
7245             set diffinhdr 0
7246
7247         } elseif {$diffinhdr} {
7248             if {![string compare -length 12 "rename from " $line]} {
7249                 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7250                 if {[string index $fname 0] eq "\""} {
7251                     set fname [lindex $fname 0]
7252                 }
7253                 set fname [encoding convertfrom $fname]
7254                 set i [lsearch -exact $treediffs($ids) $fname]
7255                 if {$i >= 0} {
7256                     setinlist difffilestart $i $curdiffstart
7257                 }
7258             } elseif {![string compare -length 10 $line "rename to "] ||
7259                       ![string compare -length 8 $line "copy to "]} {
7260                 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7261                 if {[string index $fname 0] eq "\""} {
7262                     set fname [lindex $fname 0]
7263                 }
7264                 makediffhdr $fname $ids
7265             } elseif {[string compare -length 3 $line "---"] == 0} {
7266                 # do nothing
7267                 continue
7268             } elseif {[string compare -length 3 $line "+++"] == 0} {
7269                 set diffinhdr 0
7270                 continue
7271             }
7272             $ctext insert end "$line\n" filesep
7273
7274         } else {
7275             set line [encoding convertfrom $diffencoding $line]
7276             # parse the prefix - one ' ', '-' or '+' for each parent
7277             set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7278             set tag [expr {$diffnparents > 1? "m": "d"}]
7279             if {[string trim $prefix " -+"] eq {}} {
7280                 # prefix only has " ", "-" and "+" in it: normal diff line
7281                 set num [string first "-" $prefix]
7282                 if {$num >= 0} {
7283                     # removed line, first parent with line is $num
7284                     if {$num >= $mergemax} {
7285                         set num "max"
7286                     }
7287                     $ctext insert end "$line\n" $tag$num
7288                 } else {
7289                     set tags {}
7290                     if {[string first "+" $prefix] >= 0} {
7291                         # added line
7292                         lappend tags ${tag}result
7293                         if {$diffnparents > 1} {
7294                             set num [string first " " $prefix]
7295                             if {$num >= 0} {
7296                                 if {$num >= $mergemax} {
7297                                     set num "max"
7298                                 }
7299                                 lappend tags m$num
7300                             }
7301                         }
7302                     }
7303                     if {$targetline ne {}} {
7304                         if {$diffline == $targetline} {
7305                             set seehere [$ctext index "end - 1 chars"]
7306                             set targetline {}
7307                         } else {
7308                             incr diffline
7309                         }
7310                     }
7311                     $ctext insert end "$line\n" $tags
7312                 }
7313             } else {
7314                 # "\ No newline at end of file",
7315                 # or something else we don't recognize
7316                 $ctext insert end "$line\n" hunksep
7317             }
7318         }
7319     }
7320     if {[info exists seehere]} {
7321         mark_ctext_line [lindex [split $seehere .] 0]
7322     }
7323     $ctext conf -state disabled
7324     if {[eof $bdf]} {
7325         close $bdf
7326         return 0
7327     }
7328     return [expr {$nr >= 1000? 2: 1}]
7329 }
7330
7331 proc changediffdisp {} {
7332     global ctext diffelide
7333
7334     $ctext tag conf d0 -elide [lindex $diffelide 0]
7335     $ctext tag conf dresult -elide [lindex $diffelide 1]
7336 }
7337
7338 proc highlightfile {loc cline} {
7339     global ctext cflist cflist_top
7340
7341     $ctext yview $loc
7342     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7343     $cflist tag add highlight $cline.0 "$cline.0 lineend"
7344     $cflist see $cline.0
7345     set cflist_top $cline
7346 }
7347
7348 proc prevfile {} {
7349     global difffilestart ctext cmitmode
7350
7351     if {$cmitmode eq "tree"} return
7352     set prev 0.0
7353     set prevline 1
7354     set here [$ctext index @0,0]
7355     foreach loc $difffilestart {
7356         if {[$ctext compare $loc >= $here]} {
7357             highlightfile $prev $prevline
7358             return
7359         }
7360         set prev $loc
7361         incr prevline
7362     }
7363     highlightfile $prev $prevline
7364 }
7365
7366 proc nextfile {} {
7367     global difffilestart ctext cmitmode
7368
7369     if {$cmitmode eq "tree"} return
7370     set here [$ctext index @0,0]
7371     set line 1
7372     foreach loc $difffilestart {
7373         incr line
7374         if {[$ctext compare $loc > $here]} {
7375             highlightfile $loc $line
7376             return
7377         }
7378     }
7379 }
7380
7381 proc clear_ctext {{first 1.0}} {
7382     global ctext smarktop smarkbot
7383     global ctext_file_names ctext_file_lines
7384     global pendinglinks
7385
7386     set l [lindex [split $first .] 0]
7387     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7388         set smarktop $l
7389     }
7390     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7391         set smarkbot $l
7392     }
7393     $ctext delete $first end
7394     if {$first eq "1.0"} {
7395         catch {unset pendinglinks}
7396     }
7397     set ctext_file_names {}
7398     set ctext_file_lines {}
7399 }
7400
7401 proc settabs {{firstab {}}} {
7402     global firsttabstop tabstop ctext have_tk85
7403
7404     if {$firstab ne {} && $have_tk85} {
7405         set firsttabstop $firstab
7406     }
7407     set w [font measure textfont "0"]
7408     if {$firsttabstop != 0} {
7409         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7410                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7411     } elseif {$have_tk85 || $tabstop != 8} {
7412         $ctext conf -tabs [expr {$tabstop * $w}]
7413     } else {
7414         $ctext conf -tabs {}
7415     }
7416 }
7417
7418 proc incrsearch {name ix op} {
7419     global ctext searchstring searchdirn
7420
7421     $ctext tag remove found 1.0 end
7422     if {[catch {$ctext index anchor}]} {
7423         # no anchor set, use start of selection, or of visible area
7424         set sel [$ctext tag ranges sel]
7425         if {$sel ne {}} {
7426             $ctext mark set anchor [lindex $sel 0]
7427         } elseif {$searchdirn eq "-forwards"} {
7428             $ctext mark set anchor @0,0
7429         } else {
7430             $ctext mark set anchor @0,[winfo height $ctext]
7431         }
7432     }
7433     if {$searchstring ne {}} {
7434         set here [$ctext search $searchdirn -- $searchstring anchor]
7435         if {$here ne {}} {
7436             $ctext see $here
7437         }
7438         searchmarkvisible 1
7439     }
7440 }
7441
7442 proc dosearch {} {
7443     global sstring ctext searchstring searchdirn
7444
7445     focus $sstring
7446     $sstring icursor end
7447     set searchdirn -forwards
7448     if {$searchstring ne {}} {
7449         set sel [$ctext tag ranges sel]
7450         if {$sel ne {}} {
7451             set start "[lindex $sel 0] + 1c"
7452         } elseif {[catch {set start [$ctext index anchor]}]} {
7453             set start "@0,0"
7454         }
7455         set match [$ctext search -count mlen -- $searchstring $start]
7456         $ctext tag remove sel 1.0 end
7457         if {$match eq {}} {
7458             bell
7459             return
7460         }
7461         $ctext see $match
7462         set mend "$match + $mlen c"
7463         $ctext tag add sel $match $mend
7464         $ctext mark unset anchor
7465     }
7466 }
7467
7468 proc dosearchback {} {
7469     global sstring ctext searchstring searchdirn
7470
7471     focus $sstring
7472     $sstring icursor end
7473     set searchdirn -backwards
7474     if {$searchstring ne {}} {
7475         set sel [$ctext tag ranges sel]
7476         if {$sel ne {}} {
7477             set start [lindex $sel 0]
7478         } elseif {[catch {set start [$ctext index anchor]}]} {
7479             set start @0,[winfo height $ctext]
7480         }
7481         set match [$ctext search -backwards -count ml -- $searchstring $start]
7482         $ctext tag remove sel 1.0 end
7483         if {$match eq {}} {
7484             bell
7485             return
7486         }
7487         $ctext see $match
7488         set mend "$match + $ml c"
7489         $ctext tag add sel $match $mend
7490         $ctext mark unset anchor
7491     }
7492 }
7493
7494 proc searchmark {first last} {
7495     global ctext searchstring
7496
7497     set mend $first.0
7498     while {1} {
7499         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
7500         if {$match eq {}} break
7501         set mend "$match + $mlen c"
7502         $ctext tag add found $match $mend
7503     }
7504 }
7505
7506 proc searchmarkvisible {doall} {
7507     global ctext smarktop smarkbot
7508
7509     set topline [lindex [split [$ctext index @0,0] .] 0]
7510     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
7511     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
7512         # no overlap with previous
7513         searchmark $topline $botline
7514         set smarktop $topline
7515         set smarkbot $botline
7516     } else {
7517         if {$topline < $smarktop} {
7518             searchmark $topline [expr {$smarktop-1}]
7519             set smarktop $topline
7520         }
7521         if {$botline > $smarkbot} {
7522             searchmark [expr {$smarkbot+1}] $botline
7523             set smarkbot $botline
7524         }
7525     }
7526 }
7527
7528 proc scrolltext {f0 f1} {
7529     global searchstring
7530
7531     .bleft.bottom.sb set $f0 $f1
7532     if {$searchstring ne {}} {
7533         searchmarkvisible 0
7534     }
7535 }
7536
7537 proc setcoords {} {
7538     global linespc charspc canvx0 canvy0
7539     global xspc1 xspc2 lthickness
7540
7541     set linespc [font metrics mainfont -linespace]
7542     set charspc [font measure mainfont "m"]
7543     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
7544     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
7545     set lthickness [expr {int($linespc / 9) + 1}]
7546     set xspc1(0) $linespc
7547     set xspc2 $linespc
7548 }
7549
7550 proc redisplay {} {
7551     global canv
7552     global selectedline
7553
7554     set ymax [lindex [$canv cget -scrollregion] 3]
7555     if {$ymax eq {} || $ymax == 0} return
7556     set span [$canv yview]
7557     clear_display
7558     setcanvscroll
7559     allcanvs yview moveto [lindex $span 0]
7560     drawvisible
7561     if {$selectedline ne {}} {
7562         selectline $selectedline 0
7563         allcanvs yview moveto [lindex $span 0]
7564     }
7565 }
7566
7567 proc parsefont {f n} {
7568     global fontattr
7569
7570     set fontattr($f,family) [lindex $n 0]
7571     set s [lindex $n 1]
7572     if {$s eq {} || $s == 0} {
7573         set s 10
7574     } elseif {$s < 0} {
7575         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
7576     }
7577     set fontattr($f,size) $s
7578     set fontattr($f,weight) normal
7579     set fontattr($f,slant) roman
7580     foreach style [lrange $n 2 end] {
7581         switch -- $style {
7582             "normal" -
7583             "bold"   {set fontattr($f,weight) $style}
7584             "roman" -
7585             "italic" {set fontattr($f,slant) $style}
7586         }
7587     }
7588 }
7589
7590 proc fontflags {f {isbold 0}} {
7591     global fontattr
7592
7593     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
7594                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
7595                 -slant $fontattr($f,slant)]
7596 }
7597
7598 proc fontname {f} {
7599     global fontattr
7600
7601     set n [list $fontattr($f,family) $fontattr($f,size)]
7602     if {$fontattr($f,weight) eq "bold"} {
7603         lappend n "bold"
7604     }
7605     if {$fontattr($f,slant) eq "italic"} {
7606         lappend n "italic"
7607     }
7608     return $n
7609 }
7610
7611 proc incrfont {inc} {
7612     global mainfont textfont ctext canv cflist showrefstop
7613     global stopped entries fontattr
7614
7615     unmarkmatches
7616     set s $fontattr(mainfont,size)
7617     incr s $inc
7618     if {$s < 1} {
7619         set s 1
7620     }
7621     set fontattr(mainfont,size) $s
7622     font config mainfont -size $s
7623     font config mainfontbold -size $s
7624     set mainfont [fontname mainfont]
7625     set s $fontattr(textfont,size)
7626     incr s $inc
7627     if {$s < 1} {
7628         set s 1
7629     }
7630     set fontattr(textfont,size) $s
7631     font config textfont -size $s
7632     font config textfontbold -size $s
7633     set textfont [fontname textfont]
7634     setcoords
7635     settabs
7636     redisplay
7637 }
7638
7639 proc clearsha1 {} {
7640     global sha1entry sha1string
7641     if {[string length $sha1string] == 40} {
7642         $sha1entry delete 0 end
7643     }
7644 }
7645
7646 proc sha1change {n1 n2 op} {
7647     global sha1string currentid sha1but
7648     if {$sha1string == {}
7649         || ([info exists currentid] && $sha1string == $currentid)} {
7650         set state disabled
7651     } else {
7652         set state normal
7653     }
7654     if {[$sha1but cget -state] == $state} return
7655     if {$state == "normal"} {
7656         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
7657     } else {
7658         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
7659     }
7660 }
7661
7662 proc gotocommit {} {
7663     global sha1string tagids headids curview varcid
7664
7665     if {$sha1string == {}
7666         || ([info exists currentid] && $sha1string == $currentid)} return
7667     if {[info exists tagids($sha1string)]} {
7668         set id $tagids($sha1string)
7669     } elseif {[info exists headids($sha1string)]} {
7670         set id $headids($sha1string)
7671     } else {
7672         set id [string tolower $sha1string]
7673         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
7674             set matches [longid $id]
7675             if {$matches ne {}} {
7676                 if {[llength $matches] > 1} {
7677                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
7678                     return
7679                 }
7680                 set id [lindex $matches 0]
7681             }
7682         }
7683     }
7684     if {[commitinview $id $curview]} {
7685         selectline [rowofcommit $id] 1
7686         return
7687     }
7688     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
7689         set msg [mc "SHA1 id %s is not known" $sha1string]
7690     } else {
7691         set msg [mc "Tag/Head %s is not known" $sha1string]
7692     }
7693     error_popup $msg
7694 }
7695
7696 proc lineenter {x y id} {
7697     global hoverx hovery hoverid hovertimer
7698     global commitinfo canv
7699
7700     if {![info exists commitinfo($id)] && ![getcommit $id]} return
7701     set hoverx $x
7702     set hovery $y
7703     set hoverid $id
7704     if {[info exists hovertimer]} {
7705         after cancel $hovertimer
7706     }
7707     set hovertimer [after 500 linehover]
7708     $canv delete hover
7709 }
7710
7711 proc linemotion {x y id} {
7712     global hoverx hovery hoverid hovertimer
7713
7714     if {[info exists hoverid] && $id == $hoverid} {
7715         set hoverx $x
7716         set hovery $y
7717         if {[info exists hovertimer]} {
7718             after cancel $hovertimer
7719         }
7720         set hovertimer [after 500 linehover]
7721     }
7722 }
7723
7724 proc lineleave {id} {
7725     global hoverid hovertimer canv
7726
7727     if {[info exists hoverid] && $id == $hoverid} {
7728         $canv delete hover
7729         if {[info exists hovertimer]} {
7730             after cancel $hovertimer
7731             unset hovertimer
7732         }
7733         unset hoverid
7734     }
7735 }
7736
7737 proc linehover {} {
7738     global hoverx hovery hoverid hovertimer
7739     global canv linespc lthickness
7740     global commitinfo
7741
7742     set text [lindex $commitinfo($hoverid) 0]
7743     set ymax [lindex [$canv cget -scrollregion] 3]
7744     if {$ymax == {}} return
7745     set yfrac [lindex [$canv yview] 0]
7746     set x [expr {$hoverx + 2 * $linespc}]
7747     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
7748     set x0 [expr {$x - 2 * $lthickness}]
7749     set y0 [expr {$y - 2 * $lthickness}]
7750     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
7751     set y1 [expr {$y + $linespc + 2 * $lthickness}]
7752     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
7753                -fill \#ffff80 -outline black -width 1 -tags hover]
7754     $canv raise $t
7755     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
7756                -font mainfont]
7757     $canv raise $t
7758 }
7759
7760 proc clickisonarrow {id y} {
7761     global lthickness
7762
7763     set ranges [rowranges $id]
7764     set thresh [expr {2 * $lthickness + 6}]
7765     set n [expr {[llength $ranges] - 1}]
7766     for {set i 1} {$i < $n} {incr i} {
7767         set row [lindex $ranges $i]
7768         if {abs([yc $row] - $y) < $thresh} {
7769             return $i
7770         }
7771     }
7772     return {}
7773 }
7774
7775 proc arrowjump {id n y} {
7776     global canv
7777
7778     # 1 <-> 2, 3 <-> 4, etc...
7779     set n [expr {(($n - 1) ^ 1) + 1}]
7780     set row [lindex [rowranges $id] $n]
7781     set yt [yc $row]
7782     set ymax [lindex [$canv cget -scrollregion] 3]
7783     if {$ymax eq {} || $ymax <= 0} return
7784     set view [$canv yview]
7785     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
7786     set yfrac [expr {$yt / $ymax - $yspan / 2}]
7787     if {$yfrac < 0} {
7788         set yfrac 0
7789     }
7790     allcanvs yview moveto $yfrac
7791 }
7792
7793 proc lineclick {x y id isnew} {
7794     global ctext commitinfo children canv thickerline curview
7795
7796     if {![info exists commitinfo($id)] && ![getcommit $id]} return
7797     unmarkmatches
7798     unselectline
7799     normalline
7800     $canv delete hover
7801     # draw this line thicker than normal
7802     set thickerline $id
7803     drawlines $id
7804     if {$isnew} {
7805         set ymax [lindex [$canv cget -scrollregion] 3]
7806         if {$ymax eq {}} return
7807         set yfrac [lindex [$canv yview] 0]
7808         set y [expr {$y + $yfrac * $ymax}]
7809     }
7810     set dirn [clickisonarrow $id $y]
7811     if {$dirn ne {}} {
7812         arrowjump $id $dirn $y
7813         return
7814     }
7815
7816     if {$isnew} {
7817         addtohistory [list lineclick $x $y $id 0]
7818     }
7819     # fill the details pane with info about this line
7820     $ctext conf -state normal
7821     clear_ctext
7822     settabs 0
7823     $ctext insert end "[mc "Parent"]:\t"
7824     $ctext insert end $id link0
7825     setlink $id link0
7826     set info $commitinfo($id)
7827     $ctext insert end "\n\t[lindex $info 0]\n"
7828     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
7829     set date [formatdate [lindex $info 2]]
7830     $ctext insert end "\t[mc "Date"]:\t$date\n"
7831     set kids $children($curview,$id)
7832     if {$kids ne {}} {
7833         $ctext insert end "\n[mc "Children"]:"
7834         set i 0
7835         foreach child $kids {
7836             incr i
7837             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
7838             set info $commitinfo($child)
7839             $ctext insert end "\n\t"
7840             $ctext insert end $child link$i
7841             setlink $child link$i
7842             $ctext insert end "\n\t[lindex $info 0]"
7843             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
7844             set date [formatdate [lindex $info 2]]
7845             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
7846         }
7847     }
7848     $ctext conf -state disabled
7849     init_flist {}
7850 }
7851
7852 proc normalline {} {
7853     global thickerline
7854     if {[info exists thickerline]} {
7855         set id $thickerline
7856         unset thickerline
7857         drawlines $id
7858     }
7859 }
7860
7861 proc selbyid {id} {
7862     global curview
7863     if {[commitinview $id $curview]} {
7864         selectline [rowofcommit $id] 1
7865     }
7866 }
7867
7868 proc mstime {} {
7869     global startmstime
7870     if {![info exists startmstime]} {
7871         set startmstime [clock clicks -milliseconds]
7872     }
7873     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
7874 }
7875
7876 proc rowmenu {x y id} {
7877     global rowctxmenu selectedline rowmenuid curview
7878     global nullid nullid2 fakerowmenu mainhead
7879
7880     stopfinding
7881     set rowmenuid $id
7882     if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
7883         set state disabled
7884     } else {
7885         set state normal
7886     }
7887     if {$id ne $nullid && $id ne $nullid2} {
7888         set menu $rowctxmenu
7889         if {$mainhead ne {}} {
7890             $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
7891         } else {
7892             $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
7893         }
7894     } else {
7895         set menu $fakerowmenu
7896     }
7897     $menu entryconfigure [mca "Diff this -> selected"] -state $state
7898     $menu entryconfigure [mca "Diff selected -> this"] -state $state
7899     $menu entryconfigure [mca "Make patch"] -state $state
7900     tk_popup $menu $x $y
7901 }
7902
7903 proc diffvssel {dirn} {
7904     global rowmenuid selectedline
7905
7906     if {$selectedline eq {}} return
7907     if {$dirn} {
7908         set oldid [commitonrow $selectedline]
7909         set newid $rowmenuid
7910     } else {
7911         set oldid $rowmenuid
7912         set newid [commitonrow $selectedline]
7913     }
7914     addtohistory [list doseldiff $oldid $newid]
7915     doseldiff $oldid $newid
7916 }
7917
7918 proc doseldiff {oldid newid} {
7919     global ctext
7920     global commitinfo
7921
7922     $ctext conf -state normal
7923     clear_ctext
7924     init_flist [mc "Top"]
7925     $ctext insert end "[mc "From"] "
7926     $ctext insert end $oldid link0
7927     setlink $oldid link0
7928     $ctext insert end "\n     "
7929     $ctext insert end [lindex $commitinfo($oldid) 0]
7930     $ctext insert end "\n\n[mc "To"]   "
7931     $ctext insert end $newid link1
7932     setlink $newid link1
7933     $ctext insert end "\n     "
7934     $ctext insert end [lindex $commitinfo($newid) 0]
7935     $ctext insert end "\n"
7936     $ctext conf -state disabled
7937     $ctext tag remove found 1.0 end
7938     startdiff [list $oldid $newid]
7939 }
7940
7941 proc mkpatch {} {
7942     global rowmenuid currentid commitinfo patchtop patchnum
7943
7944     if {![info exists currentid]} return
7945     set oldid $currentid
7946     set oldhead [lindex $commitinfo($oldid) 0]
7947     set newid $rowmenuid
7948     set newhead [lindex $commitinfo($newid) 0]
7949     set top .patch
7950     set patchtop $top
7951     catch {destroy $top}
7952     toplevel $top
7953     make_transient $top .
7954     label $top.title -text [mc "Generate patch"]
7955     grid $top.title - -pady 10
7956     label $top.from -text [mc "From:"]
7957     entry $top.fromsha1 -width 40 -relief flat
7958     $top.fromsha1 insert 0 $oldid
7959     $top.fromsha1 conf -state readonly
7960     grid $top.from $top.fromsha1 -sticky w
7961     entry $top.fromhead -width 60 -relief flat
7962     $top.fromhead insert 0 $oldhead
7963     $top.fromhead conf -state readonly
7964     grid x $top.fromhead -sticky w
7965     label $top.to -text [mc "To:"]
7966     entry $top.tosha1 -width 40 -relief flat
7967     $top.tosha1 insert 0 $newid
7968     $top.tosha1 conf -state readonly
7969     grid $top.to $top.tosha1 -sticky w
7970     entry $top.tohead -width 60 -relief flat
7971     $top.tohead insert 0 $newhead
7972     $top.tohead conf -state readonly
7973     grid x $top.tohead -sticky w
7974     button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
7975     grid $top.rev x -pady 10
7976     label $top.flab -text [mc "Output file:"]
7977     entry $top.fname -width 60
7978     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
7979     incr patchnum
7980     grid $top.flab $top.fname -sticky w
7981     frame $top.buts
7982     button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
7983     button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
7984     bind $top <Key-Return> mkpatchgo
7985     bind $top <Key-Escape> mkpatchcan
7986     grid $top.buts.gen $top.buts.can
7987     grid columnconfigure $top.buts 0 -weight 1 -uniform a
7988     grid columnconfigure $top.buts 1 -weight 1 -uniform a
7989     grid $top.buts - -pady 10 -sticky ew
7990     focus $top.fname
7991 }
7992
7993 proc mkpatchrev {} {
7994     global patchtop
7995
7996     set oldid [$patchtop.fromsha1 get]
7997     set oldhead [$patchtop.fromhead get]
7998     set newid [$patchtop.tosha1 get]
7999     set newhead [$patchtop.tohead get]
8000     foreach e [list fromsha1 fromhead tosha1 tohead] \
8001             v [list $newid $newhead $oldid $oldhead] {
8002         $patchtop.$e conf -state normal
8003         $patchtop.$e delete 0 end
8004         $patchtop.$e insert 0 $v
8005         $patchtop.$e conf -state readonly
8006     }
8007 }
8008
8009 proc mkpatchgo {} {
8010     global patchtop nullid nullid2
8011
8012     set oldid [$patchtop.fromsha1 get]
8013     set newid [$patchtop.tosha1 get]
8014     set fname [$patchtop.fname get]
8015     set cmd [diffcmd [list $oldid $newid] -p]
8016     # trim off the initial "|"
8017     set cmd [lrange $cmd 1 end]
8018     lappend cmd >$fname &
8019     if {[catch {eval exec $cmd} err]} {
8020         error_popup "[mc "Error creating patch:"] $err" $patchtop
8021     }
8022     catch {destroy $patchtop}
8023     unset patchtop
8024 }
8025
8026 proc mkpatchcan {} {
8027     global patchtop
8028
8029     catch {destroy $patchtop}
8030     unset patchtop
8031 }
8032
8033 proc mktag {} {
8034     global rowmenuid mktagtop commitinfo
8035
8036     set top .maketag
8037     set mktagtop $top
8038     catch {destroy $top}
8039     toplevel $top
8040     make_transient $top .
8041     label $top.title -text [mc "Create tag"]
8042     grid $top.title - -pady 10
8043     label $top.id -text [mc "ID:"]
8044     entry $top.sha1 -width 40 -relief flat
8045     $top.sha1 insert 0 $rowmenuid
8046     $top.sha1 conf -state readonly
8047     grid $top.id $top.sha1 -sticky w
8048     entry $top.head -width 60 -relief flat
8049     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8050     $top.head conf -state readonly
8051     grid x $top.head -sticky w
8052     label $top.tlab -text [mc "Tag name:"]
8053     entry $top.tag -width 60
8054     grid $top.tlab $top.tag -sticky w
8055     frame $top.buts
8056     button $top.buts.gen -text [mc "Create"] -command mktaggo
8057     button $top.buts.can -text [mc "Cancel"] -command mktagcan
8058     bind $top <Key-Return> mktaggo
8059     bind $top <Key-Escape> mktagcan
8060     grid $top.buts.gen $top.buts.can
8061     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8062     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8063     grid $top.buts - -pady 10 -sticky ew
8064     focus $top.tag
8065 }
8066
8067 proc domktag {} {
8068     global mktagtop env tagids idtags
8069
8070     set id [$mktagtop.sha1 get]
8071     set tag [$mktagtop.tag get]
8072     if {$tag == {}} {
8073         error_popup [mc "No tag name specified"] $mktagtop
8074         return 0
8075     }
8076     if {[info exists tagids($tag)]} {
8077         error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8078         return 0
8079     }
8080     if {[catch {
8081         exec git tag $tag $id
8082     } err]} {
8083         error_popup "[mc "Error creating tag:"] $err" $mktagtop
8084         return 0
8085     }
8086
8087     set tagids($tag) $id
8088     lappend idtags($id) $tag
8089     redrawtags $id
8090     addedtag $id
8091     dispneartags 0
8092     run refill_reflist
8093     return 1
8094 }
8095
8096 proc redrawtags {id} {
8097     global canv linehtag idpos currentid curview cmitlisted
8098     global canvxmax iddrawn circleitem mainheadid circlecolors
8099
8100     if {![commitinview $id $curview]} return
8101     if {![info exists iddrawn($id)]} return
8102     set row [rowofcommit $id]
8103     if {$id eq $mainheadid} {
8104         set ofill yellow
8105     } else {
8106         set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8107     }
8108     $canv itemconf $circleitem($row) -fill $ofill
8109     $canv delete tag.$id
8110     set xt [eval drawtags $id $idpos($id)]
8111     $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8112     set text [$canv itemcget $linehtag($id) -text]
8113     set font [$canv itemcget $linehtag($id) -font]
8114     set xr [expr {$xt + [font measure $font $text]}]
8115     if {$xr > $canvxmax} {
8116         set canvxmax $xr
8117         setcanvscroll
8118     }
8119     if {[info exists currentid] && $currentid == $id} {
8120         make_secsel $id
8121     }
8122 }
8123
8124 proc mktagcan {} {
8125     global mktagtop
8126
8127     catch {destroy $mktagtop}
8128     unset mktagtop
8129 }
8130
8131 proc mktaggo {} {
8132     if {![domktag]} return
8133     mktagcan
8134 }
8135
8136 proc writecommit {} {
8137     global rowmenuid wrcomtop commitinfo wrcomcmd
8138
8139     set top .writecommit
8140     set wrcomtop $top
8141     catch {destroy $top}
8142     toplevel $top
8143     make_transient $top .
8144     label $top.title -text [mc "Write commit to file"]
8145     grid $top.title - -pady 10
8146     label $top.id -text [mc "ID:"]
8147     entry $top.sha1 -width 40 -relief flat
8148     $top.sha1 insert 0 $rowmenuid
8149     $top.sha1 conf -state readonly
8150     grid $top.id $top.sha1 -sticky w
8151     entry $top.head -width 60 -relief flat
8152     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8153     $top.head conf -state readonly
8154     grid x $top.head -sticky w
8155     label $top.clab -text [mc "Command:"]
8156     entry $top.cmd -width 60 -textvariable wrcomcmd
8157     grid $top.clab $top.cmd -sticky w -pady 10
8158     label $top.flab -text [mc "Output file:"]
8159     entry $top.fname -width 60
8160     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8161     grid $top.flab $top.fname -sticky w
8162     frame $top.buts
8163     button $top.buts.gen -text [mc "Write"] -command wrcomgo
8164     button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8165     bind $top <Key-Return> wrcomgo
8166     bind $top <Key-Escape> wrcomcan
8167     grid $top.buts.gen $top.buts.can
8168     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8169     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8170     grid $top.buts - -pady 10 -sticky ew
8171     focus $top.fname
8172 }
8173
8174 proc wrcomgo {} {
8175     global wrcomtop
8176
8177     set id [$wrcomtop.sha1 get]
8178     set cmd "echo $id | [$wrcomtop.cmd get]"
8179     set fname [$wrcomtop.fname get]
8180     if {[catch {exec sh -c $cmd >$fname &} err]} {
8181         error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8182     }
8183     catch {destroy $wrcomtop}
8184     unset wrcomtop
8185 }
8186
8187 proc wrcomcan {} {
8188     global wrcomtop
8189
8190     catch {destroy $wrcomtop}
8191     unset wrcomtop
8192 }
8193
8194 proc mkbranch {} {
8195     global rowmenuid mkbrtop
8196
8197     set top .makebranch
8198     catch {destroy $top}
8199     toplevel $top
8200     make_transient $top .
8201     label $top.title -text [mc "Create new branch"]
8202     grid $top.title - -pady 10
8203     label $top.id -text [mc "ID:"]
8204     entry $top.sha1 -width 40 -relief flat
8205     $top.sha1 insert 0 $rowmenuid
8206     $top.sha1 conf -state readonly
8207     grid $top.id $top.sha1 -sticky w
8208     label $top.nlab -text [mc "Name:"]
8209     entry $top.name -width 40
8210     bind $top.name <Key-Return> "[list mkbrgo $top]"
8211     grid $top.nlab $top.name -sticky w
8212     frame $top.buts
8213     button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
8214     button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
8215     bind $top <Key-Return> [list mkbrgo $top]
8216     bind $top <Key-Escape> "catch {destroy $top}"
8217     grid $top.buts.go $top.buts.can
8218     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8219     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8220     grid $top.buts - -pady 10 -sticky ew
8221     focus $top.name
8222 }
8223
8224 proc mkbrgo {top} {
8225     global headids idheads
8226
8227     set name [$top.name get]
8228     set id [$top.sha1 get]
8229     set cmdargs {}
8230     set old_id {}
8231     if {$name eq {}} {
8232         error_popup [mc "Please specify a name for the new branch"] $top
8233         return
8234     }
8235     if {[info exists headids($name)]} {
8236         if {![confirm_popup [mc \
8237                 "Branch '%s' already exists. Overwrite?" $name] $top]} {
8238             return
8239         }
8240         set old_id $headids($name)
8241         lappend cmdargs -f
8242     }
8243     catch {destroy $top}
8244     lappend cmdargs $name $id
8245     nowbusy newbranch
8246     update
8247     if {[catch {
8248         eval exec git branch $cmdargs
8249     } err]} {
8250         notbusy newbranch
8251         error_popup $err
8252     } else {
8253         notbusy newbranch
8254         if {$old_id ne {}} {
8255             movehead $id $name
8256             movedhead $id $name
8257             redrawtags $old_id
8258             redrawtags $id
8259         } else {
8260             set headids($name) $id
8261             lappend idheads($id) $name
8262             addedhead $id $name
8263             redrawtags $id
8264         }
8265         dispneartags 0
8266         run refill_reflist
8267     }
8268 }
8269
8270 proc exec_citool {tool_args {baseid {}}} {
8271     global commitinfo env
8272
8273     set save_env [array get env GIT_AUTHOR_*]
8274
8275     if {$baseid ne {}} {
8276         if {![info exists commitinfo($baseid)]} {
8277             getcommit $baseid
8278         }
8279         set author [lindex $commitinfo($baseid) 1]
8280         set date [lindex $commitinfo($baseid) 2]
8281         if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
8282                     $author author name email]
8283             && $date ne {}} {
8284             set env(GIT_AUTHOR_NAME) $name
8285             set env(GIT_AUTHOR_EMAIL) $email
8286             set env(GIT_AUTHOR_DATE) $date
8287         }
8288     }
8289
8290     eval exec git citool $tool_args &
8291
8292     array unset env GIT_AUTHOR_*
8293     array set env $save_env
8294 }
8295
8296 proc cherrypick {} {
8297     global rowmenuid curview
8298     global mainhead mainheadid
8299
8300     set oldhead [exec git rev-parse HEAD]
8301     set dheads [descheads $rowmenuid]
8302     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
8303         set ok [confirm_popup [mc "Commit %s is already\
8304                 included in branch %s -- really re-apply it?" \
8305                                    [string range $rowmenuid 0 7] $mainhead]]
8306         if {!$ok} return
8307     }
8308     nowbusy cherrypick [mc "Cherry-picking"]
8309     update
8310     # Unfortunately git-cherry-pick writes stuff to stderr even when
8311     # no error occurs, and exec takes that as an indication of error...
8312     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
8313         notbusy cherrypick
8314         if {[regexp -line \
8315                  {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
8316                  $err msg fname]} {
8317             error_popup [mc "Cherry-pick failed because of local changes\
8318                         to file '%s'.\nPlease commit, reset or stash\
8319                         your changes and try again." $fname]
8320         } elseif {[regexp -line \
8321                        {^(CONFLICT \(.*\):|Automatic cherry-pick failed)} \
8322                        $err]} {
8323             if {[confirm_popup [mc "Cherry-pick failed because of merge\
8324                         conflict.\nDo you wish to run git citool to\
8325                         resolve it?"]]} {
8326                 # Force citool to read MERGE_MSG
8327                 file delete [file join [gitdir] "GITGUI_MSG"]
8328                 exec_citool {} $rowmenuid
8329             }
8330         } else {
8331             error_popup $err
8332         }
8333         run updatecommits
8334         return
8335     }
8336     set newhead [exec git rev-parse HEAD]
8337     if {$newhead eq $oldhead} {
8338         notbusy cherrypick
8339         error_popup [mc "No changes committed"]
8340         return
8341     }
8342     addnewchild $newhead $oldhead
8343     if {[commitinview $oldhead $curview]} {
8344         insertrow $newhead $oldhead $curview
8345         if {$mainhead ne {}} {
8346             movehead $newhead $mainhead
8347             movedhead $newhead $mainhead
8348         }
8349         set mainheadid $newhead
8350         redrawtags $oldhead
8351         redrawtags $newhead
8352         selbyid $newhead
8353     }
8354     notbusy cherrypick
8355 }
8356
8357 proc resethead {} {
8358     global mainhead rowmenuid confirm_ok resettype
8359
8360     set confirm_ok 0
8361     set w ".confirmreset"
8362     toplevel $w
8363     make_transient $w .
8364     wm title $w [mc "Confirm reset"]
8365     message $w.m -text \
8366         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
8367         -justify center -aspect 1000
8368     pack $w.m -side top -fill x -padx 20 -pady 20
8369     frame $w.f -relief sunken -border 2
8370     message $w.f.rt -text [mc "Reset type:"] -aspect 1000
8371     grid $w.f.rt -sticky w
8372     set resettype mixed
8373     radiobutton $w.f.soft -value soft -variable resettype -justify left \
8374         -text [mc "Soft: Leave working tree and index untouched"]
8375     grid $w.f.soft -sticky w
8376     radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
8377         -text [mc "Mixed: Leave working tree untouched, reset index"]
8378     grid $w.f.mixed -sticky w
8379     radiobutton $w.f.hard -value hard -variable resettype -justify left \
8380         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
8381     grid $w.f.hard -sticky w
8382     pack $w.f -side top -fill x
8383     button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
8384     pack $w.ok -side left -fill x -padx 20 -pady 20
8385     button $w.cancel -text [mc Cancel] -command "destroy $w"
8386     bind $w <Key-Escape> [list destroy $w]
8387     pack $w.cancel -side right -fill x -padx 20 -pady 20
8388     bind $w <Visibility> "grab $w; focus $w"
8389     tkwait window $w
8390     if {!$confirm_ok} return
8391     if {[catch {set fd [open \
8392             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
8393         error_popup $err
8394     } else {
8395         dohidelocalchanges
8396         filerun $fd [list readresetstat $fd]
8397         nowbusy reset [mc "Resetting"]
8398         selbyid $rowmenuid
8399     }
8400 }
8401
8402 proc readresetstat {fd} {
8403     global mainhead mainheadid showlocalchanges rprogcoord
8404
8405     if {[gets $fd line] >= 0} {
8406         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8407             set rprogcoord [expr {1.0 * $m / $n}]
8408             adjustprogress
8409         }
8410         return 1
8411     }
8412     set rprogcoord 0
8413     adjustprogress
8414     notbusy reset
8415     if {[catch {close $fd} err]} {
8416         error_popup $err
8417     }
8418     set oldhead $mainheadid
8419     set newhead [exec git rev-parse HEAD]
8420     if {$newhead ne $oldhead} {
8421         movehead $newhead $mainhead
8422         movedhead $newhead $mainhead
8423         set mainheadid $newhead
8424         redrawtags $oldhead
8425         redrawtags $newhead
8426     }
8427     if {$showlocalchanges} {
8428         doshowlocalchanges
8429     }
8430     return 0
8431 }
8432
8433 # context menu for a head
8434 proc headmenu {x y id head} {
8435     global headmenuid headmenuhead headctxmenu mainhead
8436
8437     stopfinding
8438     set headmenuid $id
8439     set headmenuhead $head
8440     set state normal
8441     if {$head eq $mainhead} {
8442         set state disabled
8443     }
8444     $headctxmenu entryconfigure 0 -state $state
8445     $headctxmenu entryconfigure 1 -state $state
8446     tk_popup $headctxmenu $x $y
8447 }
8448
8449 proc cobranch {} {
8450     global headmenuid headmenuhead headids
8451     global showlocalchanges mainheadid
8452
8453     # check the tree is clean first??
8454     nowbusy checkout [mc "Checking out"]
8455     update
8456     dohidelocalchanges
8457     if {[catch {
8458         set fd [open [list | git checkout $headmenuhead 2>@1] r]
8459     } err]} {
8460         notbusy checkout
8461         error_popup $err
8462         if {$showlocalchanges} {
8463             dodiffindex
8464         }
8465     } else {
8466         filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
8467     }
8468 }
8469
8470 proc readcheckoutstat {fd newhead newheadid} {
8471     global mainhead mainheadid headids showlocalchanges progresscoords
8472
8473     if {[gets $fd line] >= 0} {
8474         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8475             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
8476             adjustprogress
8477         }
8478         return 1
8479     }
8480     set progresscoords {0 0}
8481     adjustprogress
8482     notbusy checkout
8483     if {[catch {close $fd} err]} {
8484         error_popup $err
8485     }
8486     set oldmainid $mainheadid
8487     set mainhead $newhead
8488     set mainheadid $newheadid
8489     redrawtags $oldmainid
8490     redrawtags $newheadid
8491     selbyid $newheadid
8492     if {$showlocalchanges} {
8493         dodiffindex
8494     }
8495 }
8496
8497 proc rmbranch {} {
8498     global headmenuid headmenuhead mainhead
8499     global idheads
8500
8501     set head $headmenuhead
8502     set id $headmenuid
8503     # this check shouldn't be needed any more...
8504     if {$head eq $mainhead} {
8505         error_popup [mc "Cannot delete the currently checked-out branch"]
8506         return
8507     }
8508     set dheads [descheads $id]
8509     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
8510         # the stuff on this branch isn't on any other branch
8511         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
8512                         branch.\nReally delete branch %s?" $head $head]]} return
8513     }
8514     nowbusy rmbranch
8515     update
8516     if {[catch {exec git branch -D $head} err]} {
8517         notbusy rmbranch
8518         error_popup $err
8519         return
8520     }
8521     removehead $id $head
8522     removedhead $id $head
8523     redrawtags $id
8524     notbusy rmbranch
8525     dispneartags 0
8526     run refill_reflist
8527 }
8528
8529 # Display a list of tags and heads
8530 proc showrefs {} {
8531     global showrefstop bgcolor fgcolor selectbgcolor
8532     global bglist fglist reflistfilter reflist maincursor
8533
8534     set top .showrefs
8535     set showrefstop $top
8536     if {[winfo exists $top]} {
8537         raise $top
8538         refill_reflist
8539         return
8540     }
8541     toplevel $top
8542     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
8543     make_transient $top .
8544     text $top.list -background $bgcolor -foreground $fgcolor \
8545         -selectbackground $selectbgcolor -font mainfont \
8546         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
8547         -width 30 -height 20 -cursor $maincursor \
8548         -spacing1 1 -spacing3 1 -state disabled
8549     $top.list tag configure highlight -background $selectbgcolor
8550     lappend bglist $top.list
8551     lappend fglist $top.list
8552     scrollbar $top.ysb -command "$top.list yview" -orient vertical
8553     scrollbar $top.xsb -command "$top.list xview" -orient horizontal
8554     grid $top.list $top.ysb -sticky nsew
8555     grid $top.xsb x -sticky ew
8556     frame $top.f
8557     label $top.f.l -text "[mc "Filter"]: "
8558     entry $top.f.e -width 20 -textvariable reflistfilter
8559     set reflistfilter "*"
8560     trace add variable reflistfilter write reflistfilter_change
8561     pack $top.f.e -side right -fill x -expand 1
8562     pack $top.f.l -side left
8563     grid $top.f - -sticky ew -pady 2
8564     button $top.close -command [list destroy $top] -text [mc "Close"]
8565     bind $top <Key-Escape> [list destroy $top]
8566     grid $top.close -
8567     grid columnconfigure $top 0 -weight 1
8568     grid rowconfigure $top 0 -weight 1
8569     bind $top.list <1> {break}
8570     bind $top.list <B1-Motion> {break}
8571     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
8572     set reflist {}
8573     refill_reflist
8574 }
8575
8576 proc sel_reflist {w x y} {
8577     global showrefstop reflist headids tagids otherrefids
8578
8579     if {![winfo exists $showrefstop]} return
8580     set l [lindex [split [$w index "@$x,$y"] "."] 0]
8581     set ref [lindex $reflist [expr {$l-1}]]
8582     set n [lindex $ref 0]
8583     switch -- [lindex $ref 1] {
8584         "H" {selbyid $headids($n)}
8585         "T" {selbyid $tagids($n)}
8586         "o" {selbyid $otherrefids($n)}
8587     }
8588     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
8589 }
8590
8591 proc unsel_reflist {} {
8592     global showrefstop
8593
8594     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8595     $showrefstop.list tag remove highlight 0.0 end
8596 }
8597
8598 proc reflistfilter_change {n1 n2 op} {
8599     global reflistfilter
8600
8601     after cancel refill_reflist
8602     after 200 refill_reflist
8603 }
8604
8605 proc refill_reflist {} {
8606     global reflist reflistfilter showrefstop headids tagids otherrefids
8607     global curview
8608
8609     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8610     set refs {}
8611     foreach n [array names headids] {
8612         if {[string match $reflistfilter $n]} {
8613             if {[commitinview $headids($n) $curview]} {
8614                 lappend refs [list $n H]
8615             } else {
8616                 interestedin $headids($n) {run refill_reflist}
8617             }
8618         }
8619     }
8620     foreach n [array names tagids] {
8621         if {[string match $reflistfilter $n]} {
8622             if {[commitinview $tagids($n) $curview]} {
8623                 lappend refs [list $n T]
8624             } else {
8625                 interestedin $tagids($n) {run refill_reflist}
8626             }
8627         }
8628     }
8629     foreach n [array names otherrefids] {
8630         if {[string match $reflistfilter $n]} {
8631             if {[commitinview $otherrefids($n) $curview]} {
8632                 lappend refs [list $n o]
8633             } else {
8634                 interestedin $otherrefids($n) {run refill_reflist}
8635             }
8636         }
8637     }
8638     set refs [lsort -index 0 $refs]
8639     if {$refs eq $reflist} return
8640
8641     # Update the contents of $showrefstop.list according to the
8642     # differences between $reflist (old) and $refs (new)
8643     $showrefstop.list conf -state normal
8644     $showrefstop.list insert end "\n"
8645     set i 0
8646     set j 0
8647     while {$i < [llength $reflist] || $j < [llength $refs]} {
8648         if {$i < [llength $reflist]} {
8649             if {$j < [llength $refs]} {
8650                 set cmp [string compare [lindex $reflist $i 0] \
8651                              [lindex $refs $j 0]]
8652                 if {$cmp == 0} {
8653                     set cmp [string compare [lindex $reflist $i 1] \
8654                                  [lindex $refs $j 1]]
8655                 }
8656             } else {
8657                 set cmp -1
8658             }
8659         } else {
8660             set cmp 1
8661         }
8662         switch -- $cmp {
8663             -1 {
8664                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
8665                 incr i
8666             }
8667             0 {
8668                 incr i
8669                 incr j
8670             }
8671             1 {
8672                 set l [expr {$j + 1}]
8673                 $showrefstop.list image create $l.0 -align baseline \
8674                     -image reficon-[lindex $refs $j 1] -padx 2
8675                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
8676                 incr j
8677             }
8678         }
8679     }
8680     set reflist $refs
8681     # delete last newline
8682     $showrefstop.list delete end-2c end-1c
8683     $showrefstop.list conf -state disabled
8684 }
8685
8686 # Stuff for finding nearby tags
8687 proc getallcommits {} {
8688     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
8689     global idheads idtags idotherrefs allparents tagobjid
8690
8691     if {![info exists allcommits]} {
8692         set nextarc 0
8693         set allcommits 0
8694         set seeds {}
8695         set allcwait 0
8696         set cachedarcs 0
8697         set allccache [file join [gitdir] "gitk.cache"]
8698         if {![catch {
8699             set f [open $allccache r]
8700             set allcwait 1
8701             getcache $f
8702         }]} return
8703     }
8704
8705     if {$allcwait} {
8706         return
8707     }
8708     set cmd [list | git rev-list --parents]
8709     set allcupdate [expr {$seeds ne {}}]
8710     if {!$allcupdate} {
8711         set ids "--all"
8712     } else {
8713         set refs [concat [array names idheads] [array names idtags] \
8714                       [array names idotherrefs]]
8715         set ids {}
8716         set tagobjs {}
8717         foreach name [array names tagobjid] {
8718             lappend tagobjs $tagobjid($name)
8719         }
8720         foreach id [lsort -unique $refs] {
8721             if {![info exists allparents($id)] &&
8722                 [lsearch -exact $tagobjs $id] < 0} {
8723                 lappend ids $id
8724             }
8725         }
8726         if {$ids ne {}} {
8727             foreach id $seeds {
8728                 lappend ids "^$id"
8729             }
8730         }
8731     }
8732     if {$ids ne {}} {
8733         set fd [open [concat $cmd $ids] r]
8734         fconfigure $fd -blocking 0
8735         incr allcommits
8736         nowbusy allcommits
8737         filerun $fd [list getallclines $fd]
8738     } else {
8739         dispneartags 0
8740     }
8741 }
8742
8743 # Since most commits have 1 parent and 1 child, we group strings of
8744 # such commits into "arcs" joining branch/merge points (BMPs), which
8745 # are commits that either don't have 1 parent or don't have 1 child.
8746 #
8747 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
8748 # arcout(id) - outgoing arcs for BMP
8749 # arcids(a) - list of IDs on arc including end but not start
8750 # arcstart(a) - BMP ID at start of arc
8751 # arcend(a) - BMP ID at end of arc
8752 # growing(a) - arc a is still growing
8753 # arctags(a) - IDs out of arcids (excluding end) that have tags
8754 # archeads(a) - IDs out of arcids (excluding end) that have heads
8755 # The start of an arc is at the descendent end, so "incoming" means
8756 # coming from descendents, and "outgoing" means going towards ancestors.
8757
8758 proc getallclines {fd} {
8759     global allparents allchildren idtags idheads nextarc
8760     global arcnos arcids arctags arcout arcend arcstart archeads growing
8761     global seeds allcommits cachedarcs allcupdate
8762
8763     set nid 0
8764     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
8765         set id [lindex $line 0]
8766         if {[info exists allparents($id)]} {
8767             # seen it already
8768             continue
8769         }
8770         set cachedarcs 0
8771         set olds [lrange $line 1 end]
8772         set allparents($id) $olds
8773         if {![info exists allchildren($id)]} {
8774             set allchildren($id) {}
8775             set arcnos($id) {}
8776             lappend seeds $id
8777         } else {
8778             set a $arcnos($id)
8779             if {[llength $olds] == 1 && [llength $a] == 1} {
8780                 lappend arcids($a) $id
8781                 if {[info exists idtags($id)]} {
8782                     lappend arctags($a) $id
8783                 }
8784                 if {[info exists idheads($id)]} {
8785                     lappend archeads($a) $id
8786                 }
8787                 if {[info exists allparents($olds)]} {
8788                     # seen parent already
8789                     if {![info exists arcout($olds)]} {
8790                         splitarc $olds
8791                     }
8792                     lappend arcids($a) $olds
8793                     set arcend($a) $olds
8794                     unset growing($a)
8795                 }
8796                 lappend allchildren($olds) $id
8797                 lappend arcnos($olds) $a
8798                 continue
8799             }
8800         }
8801         foreach a $arcnos($id) {
8802             lappend arcids($a) $id
8803             set arcend($a) $id
8804             unset growing($a)
8805         }
8806
8807         set ao {}
8808         foreach p $olds {
8809             lappend allchildren($p) $id
8810             set a [incr nextarc]
8811             set arcstart($a) $id
8812             set archeads($a) {}
8813             set arctags($a) {}
8814             set archeads($a) {}
8815             set arcids($a) {}
8816             lappend ao $a
8817             set growing($a) 1
8818             if {[info exists allparents($p)]} {
8819                 # seen it already, may need to make a new branch
8820                 if {![info exists arcout($p)]} {
8821                     splitarc $p
8822                 }
8823                 lappend arcids($a) $p
8824                 set arcend($a) $p
8825                 unset growing($a)
8826             }
8827             lappend arcnos($p) $a
8828         }
8829         set arcout($id) $ao
8830     }
8831     if {$nid > 0} {
8832         global cached_dheads cached_dtags cached_atags
8833         catch {unset cached_dheads}
8834         catch {unset cached_dtags}
8835         catch {unset cached_atags}
8836     }
8837     if {![eof $fd]} {
8838         return [expr {$nid >= 1000? 2: 1}]
8839     }
8840     set cacheok 1
8841     if {[catch {
8842         fconfigure $fd -blocking 1
8843         close $fd
8844     } err]} {
8845         # got an error reading the list of commits
8846         # if we were updating, try rereading the whole thing again
8847         if {$allcupdate} {
8848             incr allcommits -1
8849             dropcache $err
8850             return
8851         }
8852         error_popup "[mc "Error reading commit topology information;\
8853                 branch and preceding/following tag information\
8854                 will be incomplete."]\n($err)"
8855         set cacheok 0
8856     }
8857     if {[incr allcommits -1] == 0} {
8858         notbusy allcommits
8859         if {$cacheok} {
8860             run savecache
8861         }
8862     }
8863     dispneartags 0
8864     return 0
8865 }
8866
8867 proc recalcarc {a} {
8868     global arctags archeads arcids idtags idheads
8869
8870     set at {}
8871     set ah {}
8872     foreach id [lrange $arcids($a) 0 end-1] {
8873         if {[info exists idtags($id)]} {
8874             lappend at $id
8875         }
8876         if {[info exists idheads($id)]} {
8877             lappend ah $id
8878         }
8879     }
8880     set arctags($a) $at
8881     set archeads($a) $ah
8882 }
8883
8884 proc splitarc {p} {
8885     global arcnos arcids nextarc arctags archeads idtags idheads
8886     global arcstart arcend arcout allparents growing
8887
8888     set a $arcnos($p)
8889     if {[llength $a] != 1} {
8890         puts "oops splitarc called but [llength $a] arcs already"
8891         return
8892     }
8893     set a [lindex $a 0]
8894     set i [lsearch -exact $arcids($a) $p]
8895     if {$i < 0} {
8896         puts "oops splitarc $p not in arc $a"
8897         return
8898     }
8899     set na [incr nextarc]
8900     if {[info exists arcend($a)]} {
8901         set arcend($na) $arcend($a)
8902     } else {
8903         set l [lindex $allparents([lindex $arcids($a) end]) 0]
8904         set j [lsearch -exact $arcnos($l) $a]
8905         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
8906     }
8907     set tail [lrange $arcids($a) [expr {$i+1}] end]
8908     set arcids($a) [lrange $arcids($a) 0 $i]
8909     set arcend($a) $p
8910     set arcstart($na) $p
8911     set arcout($p) $na
8912     set arcids($na) $tail
8913     if {[info exists growing($a)]} {
8914         set growing($na) 1
8915         unset growing($a)
8916     }
8917
8918     foreach id $tail {
8919         if {[llength $arcnos($id)] == 1} {
8920             set arcnos($id) $na
8921         } else {
8922             set j [lsearch -exact $arcnos($id) $a]
8923             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
8924         }
8925     }
8926
8927     # reconstruct tags and heads lists
8928     if {$arctags($a) ne {} || $archeads($a) ne {}} {
8929         recalcarc $a
8930         recalcarc $na
8931     } else {
8932         set arctags($na) {}
8933         set archeads($na) {}
8934     }
8935 }
8936
8937 # Update things for a new commit added that is a child of one
8938 # existing commit.  Used when cherry-picking.
8939 proc addnewchild {id p} {
8940     global allparents allchildren idtags nextarc
8941     global arcnos arcids arctags arcout arcend arcstart archeads growing
8942     global seeds allcommits
8943
8944     if {![info exists allcommits] || ![info exists arcnos($p)]} return
8945     set allparents($id) [list $p]
8946     set allchildren($id) {}
8947     set arcnos($id) {}
8948     lappend seeds $id
8949     lappend allchildren($p) $id
8950     set a [incr nextarc]
8951     set arcstart($a) $id
8952     set archeads($a) {}
8953     set arctags($a) {}
8954     set arcids($a) [list $p]
8955     set arcend($a) $p
8956     if {![info exists arcout($p)]} {
8957         splitarc $p
8958     }
8959     lappend arcnos($p) $a
8960     set arcout($id) [list $a]
8961 }
8962
8963 # This implements a cache for the topology information.
8964 # The cache saves, for each arc, the start and end of the arc,
8965 # the ids on the arc, and the outgoing arcs from the end.
8966 proc readcache {f} {
8967     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
8968     global idtags idheads allparents cachedarcs possible_seeds seeds growing
8969     global allcwait
8970
8971     set a $nextarc
8972     set lim $cachedarcs
8973     if {$lim - $a > 500} {
8974         set lim [expr {$a + 500}]
8975     }
8976     if {[catch {
8977         if {$a == $lim} {
8978             # finish reading the cache and setting up arctags, etc.
8979             set line [gets $f]
8980             if {$line ne "1"} {error "bad final version"}
8981             close $f
8982             foreach id [array names idtags] {
8983                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8984                     [llength $allparents($id)] == 1} {
8985                     set a [lindex $arcnos($id) 0]
8986                     if {$arctags($a) eq {}} {
8987                         recalcarc $a
8988                     }
8989                 }
8990             }
8991             foreach id [array names idheads] {
8992                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8993                     [llength $allparents($id)] == 1} {
8994                     set a [lindex $arcnos($id) 0]
8995                     if {$archeads($a) eq {}} {
8996                         recalcarc $a
8997                     }
8998                 }
8999             }
9000             foreach id [lsort -unique $possible_seeds] {
9001                 if {$arcnos($id) eq {}} {
9002                     lappend seeds $id
9003                 }
9004             }
9005             set allcwait 0
9006         } else {
9007             while {[incr a] <= $lim} {
9008                 set line [gets $f]
9009                 if {[llength $line] != 3} {error "bad line"}
9010                 set s [lindex $line 0]
9011                 set arcstart($a) $s
9012                 lappend arcout($s) $a
9013                 if {![info exists arcnos($s)]} {
9014                     lappend possible_seeds $s
9015                     set arcnos($s) {}
9016                 }
9017                 set e [lindex $line 1]
9018                 if {$e eq {}} {
9019                     set growing($a) 1
9020                 } else {
9021                     set arcend($a) $e
9022                     if {![info exists arcout($e)]} {
9023                         set arcout($e) {}
9024                     }
9025                 }
9026                 set arcids($a) [lindex $line 2]
9027                 foreach id $arcids($a) {
9028                     lappend allparents($s) $id
9029                     set s $id
9030                     lappend arcnos($id) $a
9031                 }
9032                 if {![info exists allparents($s)]} {
9033                     set allparents($s) {}
9034                 }
9035                 set arctags($a) {}
9036                 set archeads($a) {}
9037             }
9038             set nextarc [expr {$a - 1}]
9039         }
9040     } err]} {
9041         dropcache $err
9042         return 0
9043     }
9044     if {!$allcwait} {
9045         getallcommits
9046     }
9047     return $allcwait
9048 }
9049
9050 proc getcache {f} {
9051     global nextarc cachedarcs possible_seeds
9052
9053     if {[catch {
9054         set line [gets $f]
9055         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9056         # make sure it's an integer
9057         set cachedarcs [expr {int([lindex $line 1])}]
9058         if {$cachedarcs < 0} {error "bad number of arcs"}
9059         set nextarc 0
9060         set possible_seeds {}
9061         run readcache $f
9062     } err]} {
9063         dropcache $err
9064     }
9065     return 0
9066 }
9067
9068 proc dropcache {err} {
9069     global allcwait nextarc cachedarcs seeds
9070
9071     #puts "dropping cache ($err)"
9072     foreach v {arcnos arcout arcids arcstart arcend growing \
9073                    arctags archeads allparents allchildren} {
9074         global $v
9075         catch {unset $v}
9076     }
9077     set allcwait 0
9078     set nextarc 0
9079     set cachedarcs 0
9080     set seeds {}
9081     getallcommits
9082 }
9083
9084 proc writecache {f} {
9085     global cachearc cachedarcs allccache
9086     global arcstart arcend arcnos arcids arcout
9087
9088     set a $cachearc
9089     set lim $cachedarcs
9090     if {$lim - $a > 1000} {
9091         set lim [expr {$a + 1000}]
9092     }
9093     if {[catch {
9094         while {[incr a] <= $lim} {
9095             if {[info exists arcend($a)]} {
9096                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9097             } else {
9098                 puts $f [list $arcstart($a) {} $arcids($a)]
9099             }
9100         }
9101     } err]} {
9102         catch {close $f}
9103         catch {file delete $allccache}
9104         #puts "writing cache failed ($err)"
9105         return 0
9106     }
9107     set cachearc [expr {$a - 1}]
9108     if {$a > $cachedarcs} {
9109         puts $f "1"
9110         close $f
9111         return 0
9112     }
9113     return 1
9114 }
9115
9116 proc savecache {} {
9117     global nextarc cachedarcs cachearc allccache
9118
9119     if {$nextarc == $cachedarcs} return
9120     set cachearc 0
9121     set cachedarcs $nextarc
9122     catch {
9123         set f [open $allccache w]
9124         puts $f [list 1 $cachedarcs]
9125         run writecache $f
9126     }
9127 }
9128
9129 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9130 # or 0 if neither is true.
9131 proc anc_or_desc {a b} {
9132     global arcout arcstart arcend arcnos cached_isanc
9133
9134     if {$arcnos($a) eq $arcnos($b)} {
9135         # Both are on the same arc(s); either both are the same BMP,
9136         # or if one is not a BMP, the other is also not a BMP or is
9137         # the BMP at end of the arc (and it only has 1 incoming arc).
9138         # Or both can be BMPs with no incoming arcs.
9139         if {$a eq $b || $arcnos($a) eq {}} {
9140             return 0
9141         }
9142         # assert {[llength $arcnos($a)] == 1}
9143         set arc [lindex $arcnos($a) 0]
9144         set i [lsearch -exact $arcids($arc) $a]
9145         set j [lsearch -exact $arcids($arc) $b]
9146         if {$i < 0 || $i > $j} {
9147             return 1
9148         } else {
9149             return -1
9150         }
9151     }
9152
9153     if {![info exists arcout($a)]} {
9154         set arc [lindex $arcnos($a) 0]
9155         if {[info exists arcend($arc)]} {
9156             set aend $arcend($arc)
9157         } else {
9158             set aend {}
9159         }
9160         set a $arcstart($arc)
9161     } else {
9162         set aend $a
9163     }
9164     if {![info exists arcout($b)]} {
9165         set arc [lindex $arcnos($b) 0]
9166         if {[info exists arcend($arc)]} {
9167             set bend $arcend($arc)
9168         } else {
9169             set bend {}
9170         }
9171         set b $arcstart($arc)
9172     } else {
9173         set bend $b
9174     }
9175     if {$a eq $bend} {
9176         return 1
9177     }
9178     if {$b eq $aend} {
9179         return -1
9180     }
9181     if {[info exists cached_isanc($a,$bend)]} {
9182         if {$cached_isanc($a,$bend)} {
9183             return 1
9184         }
9185     }
9186     if {[info exists cached_isanc($b,$aend)]} {
9187         if {$cached_isanc($b,$aend)} {
9188             return -1
9189         }
9190         if {[info exists cached_isanc($a,$bend)]} {
9191             return 0
9192         }
9193     }
9194
9195     set todo [list $a $b]
9196     set anc($a) a
9197     set anc($b) b
9198     for {set i 0} {$i < [llength $todo]} {incr i} {
9199         set x [lindex $todo $i]
9200         if {$anc($x) eq {}} {
9201             continue
9202         }
9203         foreach arc $arcnos($x) {
9204             set xd $arcstart($arc)
9205             if {$xd eq $bend} {
9206                 set cached_isanc($a,$bend) 1
9207                 set cached_isanc($b,$aend) 0
9208                 return 1
9209             } elseif {$xd eq $aend} {
9210                 set cached_isanc($b,$aend) 1
9211                 set cached_isanc($a,$bend) 0
9212                 return -1
9213             }
9214             if {![info exists anc($xd)]} {
9215                 set anc($xd) $anc($x)
9216                 lappend todo $xd
9217             } elseif {$anc($xd) ne $anc($x)} {
9218                 set anc($xd) {}
9219             }
9220         }
9221     }
9222     set cached_isanc($a,$bend) 0
9223     set cached_isanc($b,$aend) 0
9224     return 0
9225 }
9226
9227 # This identifies whether $desc has an ancestor that is
9228 # a growing tip of the graph and which is not an ancestor of $anc
9229 # and returns 0 if so and 1 if not.
9230 # If we subsequently discover a tag on such a growing tip, and that
9231 # turns out to be a descendent of $anc (which it could, since we
9232 # don't necessarily see children before parents), then $desc
9233 # isn't a good choice to display as a descendent tag of
9234 # $anc (since it is the descendent of another tag which is
9235 # a descendent of $anc).  Similarly, $anc isn't a good choice to
9236 # display as a ancestor tag of $desc.
9237 #
9238 proc is_certain {desc anc} {
9239     global arcnos arcout arcstart arcend growing problems
9240
9241     set certain {}
9242     if {[llength $arcnos($anc)] == 1} {
9243         # tags on the same arc are certain
9244         if {$arcnos($desc) eq $arcnos($anc)} {
9245             return 1
9246         }
9247         if {![info exists arcout($anc)]} {
9248             # if $anc is partway along an arc, use the start of the arc instead
9249             set a [lindex $arcnos($anc) 0]
9250             set anc $arcstart($a)
9251         }
9252     }
9253     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
9254         set x $desc
9255     } else {
9256         set a [lindex $arcnos($desc) 0]
9257         set x $arcend($a)
9258     }
9259     if {$x == $anc} {
9260         return 1
9261     }
9262     set anclist [list $x]
9263     set dl($x) 1
9264     set nnh 1
9265     set ngrowanc 0
9266     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
9267         set x [lindex $anclist $i]
9268         if {$dl($x)} {
9269             incr nnh -1
9270         }
9271         set done($x) 1
9272         foreach a $arcout($x) {
9273             if {[info exists growing($a)]} {
9274                 if {![info exists growanc($x)] && $dl($x)} {
9275                     set growanc($x) 1
9276                     incr ngrowanc
9277                 }
9278             } else {
9279                 set y $arcend($a)
9280                 if {[info exists dl($y)]} {
9281                     if {$dl($y)} {
9282                         if {!$dl($x)} {
9283                             set dl($y) 0
9284                             if {![info exists done($y)]} {
9285                                 incr nnh -1
9286                             }
9287                             if {[info exists growanc($x)]} {
9288                                 incr ngrowanc -1
9289                             }
9290                             set xl [list $y]
9291                             for {set k 0} {$k < [llength $xl]} {incr k} {
9292                                 set z [lindex $xl $k]
9293                                 foreach c $arcout($z) {
9294                                     if {[info exists arcend($c)]} {
9295                                         set v $arcend($c)
9296                                         if {[info exists dl($v)] && $dl($v)} {
9297                                             set dl($v) 0
9298                                             if {![info exists done($v)]} {
9299                                                 incr nnh -1
9300                                             }
9301                                             if {[info exists growanc($v)]} {
9302                                                 incr ngrowanc -1
9303                                             }
9304                                             lappend xl $v
9305                                         }
9306                                     }
9307                                 }
9308                             }
9309                         }
9310                     }
9311                 } elseif {$y eq $anc || !$dl($x)} {
9312                     set dl($y) 0
9313                     lappend anclist $y
9314                 } else {
9315                     set dl($y) 1
9316                     lappend anclist $y
9317                     incr nnh
9318                 }
9319             }
9320         }
9321     }
9322     foreach x [array names growanc] {
9323         if {$dl($x)} {
9324             return 0
9325         }
9326         return 0
9327     }
9328     return 1
9329 }
9330
9331 proc validate_arctags {a} {
9332     global arctags idtags
9333
9334     set i -1
9335     set na $arctags($a)
9336     foreach id $arctags($a) {
9337         incr i
9338         if {![info exists idtags($id)]} {
9339             set na [lreplace $na $i $i]
9340             incr i -1
9341         }
9342     }
9343     set arctags($a) $na
9344 }
9345
9346 proc validate_archeads {a} {
9347     global archeads idheads
9348
9349     set i -1
9350     set na $archeads($a)
9351     foreach id $archeads($a) {
9352         incr i
9353         if {![info exists idheads($id)]} {
9354             set na [lreplace $na $i $i]
9355             incr i -1
9356         }
9357     }
9358     set archeads($a) $na
9359 }
9360
9361 # Return the list of IDs that have tags that are descendents of id,
9362 # ignoring IDs that are descendents of IDs already reported.
9363 proc desctags {id} {
9364     global arcnos arcstart arcids arctags idtags allparents
9365     global growing cached_dtags
9366
9367     if {![info exists allparents($id)]} {
9368         return {}
9369     }
9370     set t1 [clock clicks -milliseconds]
9371     set argid $id
9372     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9373         # part-way along an arc; check that arc first
9374         set a [lindex $arcnos($id) 0]
9375         if {$arctags($a) ne {}} {
9376             validate_arctags $a
9377             set i [lsearch -exact $arcids($a) $id]
9378             set tid {}
9379             foreach t $arctags($a) {
9380                 set j [lsearch -exact $arcids($a) $t]
9381                 if {$j >= $i} break
9382                 set tid $t
9383             }
9384             if {$tid ne {}} {
9385                 return $tid
9386             }
9387         }
9388         set id $arcstart($a)
9389         if {[info exists idtags($id)]} {
9390             return $id
9391         }
9392     }
9393     if {[info exists cached_dtags($id)]} {
9394         return $cached_dtags($id)
9395     }
9396
9397     set origid $id
9398     set todo [list $id]
9399     set queued($id) 1
9400     set nc 1
9401     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9402         set id [lindex $todo $i]
9403         set done($id) 1
9404         set ta [info exists hastaggedancestor($id)]
9405         if {!$ta} {
9406             incr nc -1
9407         }
9408         # ignore tags on starting node
9409         if {!$ta && $i > 0} {
9410             if {[info exists idtags($id)]} {
9411                 set tagloc($id) $id
9412                 set ta 1
9413             } elseif {[info exists cached_dtags($id)]} {
9414                 set tagloc($id) $cached_dtags($id)
9415                 set ta 1
9416             }
9417         }
9418         foreach a $arcnos($id) {
9419             set d $arcstart($a)
9420             if {!$ta && $arctags($a) ne {}} {
9421                 validate_arctags $a
9422                 if {$arctags($a) ne {}} {
9423                     lappend tagloc($id) [lindex $arctags($a) end]
9424                 }
9425             }
9426             if {$ta || $arctags($a) ne {}} {
9427                 set tomark [list $d]
9428                 for {set j 0} {$j < [llength $tomark]} {incr j} {
9429                     set dd [lindex $tomark $j]
9430                     if {![info exists hastaggedancestor($dd)]} {
9431                         if {[info exists done($dd)]} {
9432                             foreach b $arcnos($dd) {
9433                                 lappend tomark $arcstart($b)
9434                             }
9435                             if {[info exists tagloc($dd)]} {
9436                                 unset tagloc($dd)
9437                             }
9438                         } elseif {[info exists queued($dd)]} {
9439                             incr nc -1
9440                         }
9441                         set hastaggedancestor($dd) 1
9442                     }
9443                 }
9444             }
9445             if {![info exists queued($d)]} {
9446                 lappend todo $d
9447                 set queued($d) 1
9448                 if {![info exists hastaggedancestor($d)]} {
9449                     incr nc
9450                 }
9451             }
9452         }
9453     }
9454     set tags {}
9455     foreach id [array names tagloc] {
9456         if {![info exists hastaggedancestor($id)]} {
9457             foreach t $tagloc($id) {
9458                 if {[lsearch -exact $tags $t] < 0} {
9459                     lappend tags $t
9460                 }
9461             }
9462         }
9463     }
9464     set t2 [clock clicks -milliseconds]
9465     set loopix $i
9466
9467     # remove tags that are descendents of other tags
9468     for {set i 0} {$i < [llength $tags]} {incr i} {
9469         set a [lindex $tags $i]
9470         for {set j 0} {$j < $i} {incr j} {
9471             set b [lindex $tags $j]
9472             set r [anc_or_desc $a $b]
9473             if {$r == 1} {
9474                 set tags [lreplace $tags $j $j]
9475                 incr j -1
9476                 incr i -1
9477             } elseif {$r == -1} {
9478                 set tags [lreplace $tags $i $i]
9479                 incr i -1
9480                 break
9481             }
9482         }
9483     }
9484
9485     if {[array names growing] ne {}} {
9486         # graph isn't finished, need to check if any tag could get
9487         # eclipsed by another tag coming later.  Simply ignore any
9488         # tags that could later get eclipsed.
9489         set ctags {}
9490         foreach t $tags {
9491             if {[is_certain $t $origid]} {
9492                 lappend ctags $t
9493             }
9494         }
9495         if {$tags eq $ctags} {
9496             set cached_dtags($origid) $tags
9497         } else {
9498             set tags $ctags
9499         }
9500     } else {
9501         set cached_dtags($origid) $tags
9502     }
9503     set t3 [clock clicks -milliseconds]
9504     if {0 && $t3 - $t1 >= 100} {
9505         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
9506             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9507     }
9508     return $tags
9509 }
9510
9511 proc anctags {id} {
9512     global arcnos arcids arcout arcend arctags idtags allparents
9513     global growing cached_atags
9514
9515     if {![info exists allparents($id)]} {
9516         return {}
9517     }
9518     set t1 [clock clicks -milliseconds]
9519     set argid $id
9520     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9521         # part-way along an arc; check that arc first
9522         set a [lindex $arcnos($id) 0]
9523         if {$arctags($a) ne {}} {
9524             validate_arctags $a
9525             set i [lsearch -exact $arcids($a) $id]
9526             foreach t $arctags($a) {
9527                 set j [lsearch -exact $arcids($a) $t]
9528                 if {$j > $i} {
9529                     return $t
9530                 }
9531             }
9532         }
9533         if {![info exists arcend($a)]} {
9534             return {}
9535         }
9536         set id $arcend($a)
9537         if {[info exists idtags($id)]} {
9538             return $id
9539         }
9540     }
9541     if {[info exists cached_atags($id)]} {
9542         return $cached_atags($id)
9543     }
9544
9545     set origid $id
9546     set todo [list $id]
9547     set queued($id) 1
9548     set taglist {}
9549     set nc 1
9550     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9551         set id [lindex $todo $i]
9552         set done($id) 1
9553         set td [info exists hastaggeddescendent($id)]
9554         if {!$td} {
9555             incr nc -1
9556         }
9557         # ignore tags on starting node
9558         if {!$td && $i > 0} {
9559             if {[info exists idtags($id)]} {
9560                 set tagloc($id) $id
9561                 set td 1
9562             } elseif {[info exists cached_atags($id)]} {
9563                 set tagloc($id) $cached_atags($id)
9564                 set td 1
9565             }
9566         }
9567         foreach a $arcout($id) {
9568             if {!$td && $arctags($a) ne {}} {
9569                 validate_arctags $a
9570                 if {$arctags($a) ne {}} {
9571                     lappend tagloc($id) [lindex $arctags($a) 0]
9572                 }
9573             }
9574             if {![info exists arcend($a)]} continue
9575             set d $arcend($a)
9576             if {$td || $arctags($a) ne {}} {
9577                 set tomark [list $d]
9578                 for {set j 0} {$j < [llength $tomark]} {incr j} {
9579                     set dd [lindex $tomark $j]
9580                     if {![info exists hastaggeddescendent($dd)]} {
9581                         if {[info exists done($dd)]} {
9582                             foreach b $arcout($dd) {
9583                                 if {[info exists arcend($b)]} {
9584                                     lappend tomark $arcend($b)
9585                                 }
9586                             }
9587                             if {[info exists tagloc($dd)]} {
9588                                 unset tagloc($dd)
9589                             }
9590                         } elseif {[info exists queued($dd)]} {
9591                             incr nc -1
9592                         }
9593                         set hastaggeddescendent($dd) 1
9594                     }
9595                 }
9596             }
9597             if {![info exists queued($d)]} {
9598                 lappend todo $d
9599                 set queued($d) 1
9600                 if {![info exists hastaggeddescendent($d)]} {
9601                     incr nc
9602                 }
9603             }
9604         }
9605     }
9606     set t2 [clock clicks -milliseconds]
9607     set loopix $i
9608     set tags {}
9609     foreach id [array names tagloc] {
9610         if {![info exists hastaggeddescendent($id)]} {
9611             foreach t $tagloc($id) {
9612                 if {[lsearch -exact $tags $t] < 0} {
9613                     lappend tags $t
9614                 }
9615             }
9616         }
9617     }
9618
9619     # remove tags that are ancestors of other tags
9620     for {set i 0} {$i < [llength $tags]} {incr i} {
9621         set a [lindex $tags $i]
9622         for {set j 0} {$j < $i} {incr j} {
9623             set b [lindex $tags $j]
9624             set r [anc_or_desc $a $b]
9625             if {$r == -1} {
9626                 set tags [lreplace $tags $j $j]
9627                 incr j -1
9628                 incr i -1
9629             } elseif {$r == 1} {
9630                 set tags [lreplace $tags $i $i]
9631                 incr i -1
9632                 break
9633             }
9634         }
9635     }
9636
9637     if {[array names growing] ne {}} {
9638         # graph isn't finished, need to check if any tag could get
9639         # eclipsed by another tag coming later.  Simply ignore any
9640         # tags that could later get eclipsed.
9641         set ctags {}
9642         foreach t $tags {
9643             if {[is_certain $origid $t]} {
9644                 lappend ctags $t
9645             }
9646         }
9647         if {$tags eq $ctags} {
9648             set cached_atags($origid) $tags
9649         } else {
9650             set tags $ctags
9651         }
9652     } else {
9653         set cached_atags($origid) $tags
9654     }
9655     set t3 [clock clicks -milliseconds]
9656     if {0 && $t3 - $t1 >= 100} {
9657         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
9658             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9659     }
9660     return $tags
9661 }
9662
9663 # Return the list of IDs that have heads that are descendents of id,
9664 # including id itself if it has a head.
9665 proc descheads {id} {
9666     global arcnos arcstart arcids archeads idheads cached_dheads
9667     global allparents
9668
9669     if {![info exists allparents($id)]} {
9670         return {}
9671     }
9672     set aret {}
9673     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9674         # part-way along an arc; check it first
9675         set a [lindex $arcnos($id) 0]
9676         if {$archeads($a) ne {}} {
9677             validate_archeads $a
9678             set i [lsearch -exact $arcids($a) $id]
9679             foreach t $archeads($a) {
9680                 set j [lsearch -exact $arcids($a) $t]
9681                 if {$j > $i} break
9682                 lappend aret $t
9683             }
9684         }
9685         set id $arcstart($a)
9686     }
9687     set origid $id
9688     set todo [list $id]
9689     set seen($id) 1
9690     set ret {}
9691     for {set i 0} {$i < [llength $todo]} {incr i} {
9692         set id [lindex $todo $i]
9693         if {[info exists cached_dheads($id)]} {
9694             set ret [concat $ret $cached_dheads($id)]
9695         } else {
9696             if {[info exists idheads($id)]} {
9697                 lappend ret $id
9698             }
9699             foreach a $arcnos($id) {
9700                 if {$archeads($a) ne {}} {
9701                     validate_archeads $a
9702                     if {$archeads($a) ne {}} {
9703                         set ret [concat $ret $archeads($a)]
9704                     }
9705                 }
9706                 set d $arcstart($a)
9707                 if {![info exists seen($d)]} {
9708                     lappend todo $d
9709                     set seen($d) 1
9710                 }
9711             }
9712         }
9713     }
9714     set ret [lsort -unique $ret]
9715     set cached_dheads($origid) $ret
9716     return [concat $ret $aret]
9717 }
9718
9719 proc addedtag {id} {
9720     global arcnos arcout cached_dtags cached_atags
9721
9722     if {![info exists arcnos($id)]} return
9723     if {![info exists arcout($id)]} {
9724         recalcarc [lindex $arcnos($id) 0]
9725     }
9726     catch {unset cached_dtags}
9727     catch {unset cached_atags}
9728 }
9729
9730 proc addedhead {hid head} {
9731     global arcnos arcout cached_dheads
9732
9733     if {![info exists arcnos($hid)]} return
9734     if {![info exists arcout($hid)]} {
9735         recalcarc [lindex $arcnos($hid) 0]
9736     }
9737     catch {unset cached_dheads}
9738 }
9739
9740 proc removedhead {hid head} {
9741     global cached_dheads
9742
9743     catch {unset cached_dheads}
9744 }
9745
9746 proc movedhead {hid head} {
9747     global arcnos arcout cached_dheads
9748
9749     if {![info exists arcnos($hid)]} return
9750     if {![info exists arcout($hid)]} {
9751         recalcarc [lindex $arcnos($hid) 0]
9752     }
9753     catch {unset cached_dheads}
9754 }
9755
9756 proc changedrefs {} {
9757     global cached_dheads cached_dtags cached_atags
9758     global arctags archeads arcnos arcout idheads idtags
9759
9760     foreach id [concat [array names idheads] [array names idtags]] {
9761         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
9762             set a [lindex $arcnos($id) 0]
9763             if {![info exists donearc($a)]} {
9764                 recalcarc $a
9765                 set donearc($a) 1
9766             }
9767         }
9768     }
9769     catch {unset cached_dtags}
9770     catch {unset cached_atags}
9771     catch {unset cached_dheads}
9772 }
9773
9774 proc rereadrefs {} {
9775     global idtags idheads idotherrefs mainheadid
9776
9777     set refids [concat [array names idtags] \
9778                     [array names idheads] [array names idotherrefs]]
9779     foreach id $refids {
9780         if {![info exists ref($id)]} {
9781             set ref($id) [listrefs $id]
9782         }
9783     }
9784     set oldmainhead $mainheadid
9785     readrefs
9786     changedrefs
9787     set refids [lsort -unique [concat $refids [array names idtags] \
9788                         [array names idheads] [array names idotherrefs]]]
9789     foreach id $refids {
9790         set v [listrefs $id]
9791         if {![info exists ref($id)] || $ref($id) != $v} {
9792             redrawtags $id
9793         }
9794     }
9795     if {$oldmainhead ne $mainheadid} {
9796         redrawtags $oldmainhead
9797         redrawtags $mainheadid
9798     }
9799     run refill_reflist
9800 }
9801
9802 proc listrefs {id} {
9803     global idtags idheads idotherrefs
9804
9805     set x {}
9806     if {[info exists idtags($id)]} {
9807         set x $idtags($id)
9808     }
9809     set y {}
9810     if {[info exists idheads($id)]} {
9811         set y $idheads($id)
9812     }
9813     set z {}
9814     if {[info exists idotherrefs($id)]} {
9815         set z $idotherrefs($id)
9816     }
9817     return [list $x $y $z]
9818 }
9819
9820 proc showtag {tag isnew} {
9821     global ctext tagcontents tagids linknum tagobjid
9822
9823     if {$isnew} {
9824         addtohistory [list showtag $tag 0]
9825     }
9826     $ctext conf -state normal
9827     clear_ctext
9828     settabs 0
9829     set linknum 0
9830     if {![info exists tagcontents($tag)]} {
9831         catch {
9832             set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
9833         }
9834     }
9835     if {[info exists tagcontents($tag)]} {
9836         set text $tagcontents($tag)
9837     } else {
9838         set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
9839     }
9840     appendwithlinks $text {}
9841     $ctext conf -state disabled
9842     init_flist {}
9843 }
9844
9845 proc doquit {} {
9846     global stopped
9847     global gitktmpdir
9848
9849     set stopped 100
9850     savestuff .
9851     destroy .
9852
9853     if {[info exists gitktmpdir]} {
9854         catch {file delete -force $gitktmpdir}
9855     }
9856 }
9857
9858 proc mkfontdisp {font top which} {
9859     global fontattr fontpref $font
9860
9861     set fontpref($font) [set $font]
9862     button $top.${font}but -text $which -font optionfont \
9863         -command [list choosefont $font $which]
9864     label $top.$font -relief flat -font $font \
9865         -text $fontattr($font,family) -justify left
9866     grid x $top.${font}but $top.$font -sticky w
9867 }
9868
9869 proc choosefont {font which} {
9870     global fontparam fontlist fonttop fontattr
9871     global prefstop
9872
9873     set fontparam(which) $which
9874     set fontparam(font) $font
9875     set fontparam(family) [font actual $font -family]
9876     set fontparam(size) $fontattr($font,size)
9877     set fontparam(weight) $fontattr($font,weight)
9878     set fontparam(slant) $fontattr($font,slant)
9879     set top .gitkfont
9880     set fonttop $top
9881     if {![winfo exists $top]} {
9882         font create sample
9883         eval font config sample [font actual $font]
9884         toplevel $top
9885         make_transient $top $prefstop
9886         wm title $top [mc "Gitk font chooser"]
9887         label $top.l -textvariable fontparam(which)
9888         pack $top.l -side top
9889         set fontlist [lsort [font families]]
9890         frame $top.f
9891         listbox $top.f.fam -listvariable fontlist \
9892             -yscrollcommand [list $top.f.sb set]
9893         bind $top.f.fam <<ListboxSelect>> selfontfam
9894         scrollbar $top.f.sb -command [list $top.f.fam yview]
9895         pack $top.f.sb -side right -fill y
9896         pack $top.f.fam -side left -fill both -expand 1
9897         pack $top.f -side top -fill both -expand 1
9898         frame $top.g
9899         spinbox $top.g.size -from 4 -to 40 -width 4 \
9900             -textvariable fontparam(size) \
9901             -validatecommand {string is integer -strict %s}
9902         checkbutton $top.g.bold -padx 5 \
9903             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
9904             -variable fontparam(weight) -onvalue bold -offvalue normal
9905         checkbutton $top.g.ital -padx 5 \
9906             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
9907             -variable fontparam(slant) -onvalue italic -offvalue roman
9908         pack $top.g.size $top.g.bold $top.g.ital -side left
9909         pack $top.g -side top
9910         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
9911             -background white
9912         $top.c create text 100 25 -anchor center -text $which -font sample \
9913             -fill black -tags text
9914         bind $top.c <Configure> [list centertext $top.c]
9915         pack $top.c -side top -fill x
9916         frame $top.buts
9917         button $top.buts.ok -text [mc "OK"] -command fontok -default active
9918         button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
9919         bind $top <Key-Return> fontok
9920         bind $top <Key-Escape> fontcan
9921         grid $top.buts.ok $top.buts.can
9922         grid columnconfigure $top.buts 0 -weight 1 -uniform a
9923         grid columnconfigure $top.buts 1 -weight 1 -uniform a
9924         pack $top.buts -side bottom -fill x
9925         trace add variable fontparam write chg_fontparam
9926     } else {
9927         raise $top
9928         $top.c itemconf text -text $which
9929     }
9930     set i [lsearch -exact $fontlist $fontparam(family)]
9931     if {$i >= 0} {
9932         $top.f.fam selection set $i
9933         $top.f.fam see $i
9934     }
9935 }
9936
9937 proc centertext {w} {
9938     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
9939 }
9940
9941 proc fontok {} {
9942     global fontparam fontpref prefstop
9943
9944     set f $fontparam(font)
9945     set fontpref($f) [list $fontparam(family) $fontparam(size)]
9946     if {$fontparam(weight) eq "bold"} {
9947         lappend fontpref($f) "bold"
9948     }
9949     if {$fontparam(slant) eq "italic"} {
9950         lappend fontpref($f) "italic"
9951     }
9952     set w $prefstop.$f
9953     $w conf -text $fontparam(family) -font $fontpref($f)
9954
9955     fontcan
9956 }
9957
9958 proc fontcan {} {
9959     global fonttop fontparam
9960
9961     if {[info exists fonttop]} {
9962         catch {destroy $fonttop}
9963         catch {font delete sample}
9964         unset fonttop
9965         unset fontparam
9966     }
9967 }
9968
9969 proc selfontfam {} {
9970     global fonttop fontparam
9971
9972     set i [$fonttop.f.fam curselection]
9973     if {$i ne {}} {
9974         set fontparam(family) [$fonttop.f.fam get $i]
9975     }
9976 }
9977
9978 proc chg_fontparam {v sub op} {
9979     global fontparam
9980
9981     font config sample -$sub $fontparam($sub)
9982 }
9983
9984 proc doprefs {} {
9985     global maxwidth maxgraphpct
9986     global oldprefs prefstop showneartags showlocalchanges
9987     global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
9988     global tabstop limitdiffs autoselect extdifftool perfile_attrs
9989
9990     set top .gitkprefs
9991     set prefstop $top
9992     if {[winfo exists $top]} {
9993         raise $top
9994         return
9995     }
9996     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9997                    limitdiffs tabstop perfile_attrs} {
9998         set oldprefs($v) [set $v]
9999     }
10000     toplevel $top
10001     wm title $top [mc "Gitk preferences"]
10002     make_transient $top .
10003     label $top.ldisp -text [mc "Commit list display options"]
10004     grid $top.ldisp - -sticky w -pady 10
10005     label $top.spacer -text " "
10006     label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
10007         -font optionfont
10008     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10009     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
10010     label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
10011         -font optionfont
10012     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10013     grid x $top.maxpctl $top.maxpct -sticky w
10014     frame $top.showlocal
10015     label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
10016     checkbutton $top.showlocal.b -variable showlocalchanges
10017     pack $top.showlocal.b $top.showlocal.l -side left
10018     grid x $top.showlocal -sticky w
10019     frame $top.autoselect
10020     label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont
10021     checkbutton $top.autoselect.b -variable autoselect
10022     pack $top.autoselect.b $top.autoselect.l -side left
10023     grid x $top.autoselect -sticky w
10024
10025     label $top.ddisp -text [mc "Diff display options"]
10026     grid $top.ddisp - -sticky w -pady 10
10027     label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
10028     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10029     grid x $top.tabstopl $top.tabstop -sticky w
10030     frame $top.ntag
10031     label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
10032     checkbutton $top.ntag.b -variable showneartags
10033     pack $top.ntag.b $top.ntag.l -side left
10034     grid x $top.ntag -sticky w
10035     frame $top.ldiff
10036     label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
10037     checkbutton $top.ldiff.b -variable limitdiffs
10038     pack $top.ldiff.b $top.ldiff.l -side left
10039     grid x $top.ldiff -sticky w
10040     frame $top.lattr
10041     label $top.lattr.l -text [mc "Support per-file encodings"] -font optionfont
10042     checkbutton $top.lattr.b -variable perfile_attrs
10043     pack $top.lattr.b $top.lattr.l -side left
10044     grid x $top.lattr -sticky w
10045
10046     entry $top.extdifft -textvariable extdifftool
10047     frame $top.extdifff
10048     label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
10049         -padx 10
10050     button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
10051         -command choose_extdiff
10052     pack $top.extdifff.l $top.extdifff.b -side left
10053     grid x $top.extdifff $top.extdifft -sticky w
10054
10055     label $top.cdisp -text [mc "Colors: press to choose"]
10056     grid $top.cdisp - -sticky w -pady 10
10057     label $top.bg -padx 40 -relief sunk -background $bgcolor
10058     button $top.bgbut -text [mc "Background"] -font optionfont \
10059         -command [list choosecolor bgcolor {} $top.bg background setbg]
10060     grid x $top.bgbut $top.bg -sticky w
10061     label $top.fg -padx 40 -relief sunk -background $fgcolor
10062     button $top.fgbut -text [mc "Foreground"] -font optionfont \
10063         -command [list choosecolor fgcolor {} $top.fg foreground setfg]
10064     grid x $top.fgbut $top.fg -sticky w
10065     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10066     button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
10067         -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
10068                       [list $ctext tag conf d0 -foreground]]
10069     grid x $top.diffoldbut $top.diffold -sticky w
10070     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10071     button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
10072         -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
10073                       [list $ctext tag conf dresult -foreground]]
10074     grid x $top.diffnewbut $top.diffnew -sticky w
10075     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10076     button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
10077         -command [list choosecolor diffcolors 2 $top.hunksep \
10078                       "diff hunk header" \
10079                       [list $ctext tag conf hunksep -foreground]]
10080     grid x $top.hunksepbut $top.hunksep -sticky w
10081     label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
10082     button $top.markbgbut -text [mc "Marked line bg"] -font optionfont \
10083         -command [list choosecolor markbgcolor {} $top.markbgsep \
10084                       [mc "marked line background"] \
10085                       [list $ctext tag conf omark -background]]
10086     grid x $top.markbgbut $top.markbgsep -sticky w
10087     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10088     button $top.selbgbut -text [mc "Select bg"] -font optionfont \
10089         -command [list choosecolor selectbgcolor {} $top.selbgsep background setselbg]
10090     grid x $top.selbgbut $top.selbgsep -sticky w
10091
10092     label $top.cfont -text [mc "Fonts: press to choose"]
10093     grid $top.cfont - -sticky w -pady 10
10094     mkfontdisp mainfont $top [mc "Main font"]
10095     mkfontdisp textfont $top [mc "Diff display font"]
10096     mkfontdisp uifont $top [mc "User interface font"]
10097
10098     frame $top.buts
10099     button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10100     button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10101     bind $top <Key-Return> prefsok
10102     bind $top <Key-Escape> prefscan
10103     grid $top.buts.ok $top.buts.can
10104     grid columnconfigure $top.buts 0 -weight 1 -uniform a
10105     grid columnconfigure $top.buts 1 -weight 1 -uniform a
10106     grid $top.buts - - -pady 10 -sticky ew
10107     bind $top <Visibility> "focus $top.buts.ok"
10108 }
10109
10110 proc choose_extdiff {} {
10111     global extdifftool
10112
10113     set prog [tk_getOpenFile -title "External diff tool" -multiple false]
10114     if {$prog ne {}} {
10115         set extdifftool $prog
10116     }
10117 }
10118
10119 proc choosecolor {v vi w x cmd} {
10120     global $v
10121
10122     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
10123                -title [mc "Gitk: choose color for %s" $x]]
10124     if {$c eq {}} return
10125     $w conf -background $c
10126     lset $v $vi $c
10127     eval $cmd $c
10128 }
10129
10130 proc setselbg {c} {
10131     global bglist cflist
10132     foreach w $bglist {
10133         $w configure -selectbackground $c
10134     }
10135     $cflist tag configure highlight \
10136         -background [$cflist cget -selectbackground]
10137     allcanvs itemconf secsel -fill $c
10138 }
10139
10140 proc setbg {c} {
10141     global bglist
10142
10143     foreach w $bglist {
10144         $w conf -background $c
10145     }
10146 }
10147
10148 proc setfg {c} {
10149     global fglist canv
10150
10151     foreach w $fglist {
10152         $w conf -foreground $c
10153     }
10154     allcanvs itemconf text -fill $c
10155     $canv itemconf circle -outline $c
10156 }
10157
10158 proc prefscan {} {
10159     global oldprefs prefstop
10160
10161     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10162                    limitdiffs tabstop perfile_attrs} {
10163         global $v
10164         set $v $oldprefs($v)
10165     }
10166     catch {destroy $prefstop}
10167     unset prefstop
10168     fontcan
10169 }
10170
10171 proc prefsok {} {
10172     global maxwidth maxgraphpct
10173     global oldprefs prefstop showneartags showlocalchanges
10174     global fontpref mainfont textfont uifont
10175     global limitdiffs treediffs perfile_attrs
10176
10177     catch {destroy $prefstop}
10178     unset prefstop
10179     fontcan
10180     set fontchanged 0
10181     if {$mainfont ne $fontpref(mainfont)} {
10182         set mainfont $fontpref(mainfont)
10183         parsefont mainfont $mainfont
10184         eval font configure mainfont [fontflags mainfont]
10185         eval font configure mainfontbold [fontflags mainfont 1]
10186         setcoords
10187         set fontchanged 1
10188     }
10189     if {$textfont ne $fontpref(textfont)} {
10190         set textfont $fontpref(textfont)
10191         parsefont textfont $textfont
10192         eval font configure textfont [fontflags textfont]
10193         eval font configure textfontbold [fontflags textfont 1]
10194     }
10195     if {$uifont ne $fontpref(uifont)} {
10196         set uifont $fontpref(uifont)
10197         parsefont uifont $uifont
10198         eval font configure uifont [fontflags uifont]
10199     }
10200     settabs
10201     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
10202         if {$showlocalchanges} {
10203             doshowlocalchanges
10204         } else {
10205             dohidelocalchanges
10206         }
10207     }
10208     if {$limitdiffs != $oldprefs(limitdiffs) ||
10209         ($perfile_attrs && !$oldprefs(perfile_attrs))} {
10210         # treediffs elements are limited by path;
10211         # won't have encodings cached if perfile_attrs was just turned on
10212         catch {unset treediffs}
10213     }
10214     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
10215         || $maxgraphpct != $oldprefs(maxgraphpct)} {
10216         redisplay
10217     } elseif {$showneartags != $oldprefs(showneartags) ||
10218           $limitdiffs != $oldprefs(limitdiffs)} {
10219         reselectline
10220     }
10221 }
10222
10223 proc formatdate {d} {
10224     global datetimeformat
10225     if {$d ne {}} {
10226         set d [clock format $d -format $datetimeformat]
10227     }
10228     return $d
10229 }
10230
10231 # This list of encoding names and aliases is distilled from
10232 # http://www.iana.org/assignments/character-sets.
10233 # Not all of them are supported by Tcl.
10234 set encoding_aliases {
10235     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
10236       ISO646-US US-ASCII us IBM367 cp367 csASCII }
10237     { ISO-10646-UTF-1 csISO10646UTF1 }
10238     { ISO_646.basic:1983 ref csISO646basic1983 }
10239     { INVARIANT csINVARIANT }
10240     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
10241     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
10242     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
10243     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
10244     { NATS-DANO iso-ir-9-1 csNATSDANO }
10245     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
10246     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
10247     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
10248     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
10249     { ISO-2022-KR csISO2022KR }
10250     { EUC-KR csEUCKR }
10251     { ISO-2022-JP csISO2022JP }
10252     { ISO-2022-JP-2 csISO2022JP2 }
10253     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
10254       csISO13JISC6220jp }
10255     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
10256     { IT iso-ir-15 ISO646-IT csISO15Italian }
10257     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
10258     { ES iso-ir-17 ISO646-ES csISO17Spanish }
10259     { greek7-old iso-ir-18 csISO18Greek7Old }
10260     { latin-greek iso-ir-19 csISO19LatinGreek }
10261     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
10262     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
10263     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
10264     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
10265     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
10266     { BS_viewdata iso-ir-47 csISO47BSViewdata }
10267     { INIS iso-ir-49 csISO49INIS }
10268     { INIS-8 iso-ir-50 csISO50INIS8 }
10269     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
10270     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
10271     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
10272     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
10273     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
10274     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
10275       csISO60Norwegian1 }
10276     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
10277     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
10278     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
10279     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
10280     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
10281     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
10282     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
10283     { greek7 iso-ir-88 csISO88Greek7 }
10284     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
10285     { iso-ir-90 csISO90 }
10286     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
10287     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
10288       csISO92JISC62991984b }
10289     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
10290     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
10291     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
10292       csISO95JIS62291984handadd }
10293     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
10294     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
10295     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
10296     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
10297       CP819 csISOLatin1 }
10298     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
10299     { T.61-7bit iso-ir-102 csISO102T617bit }
10300     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
10301     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
10302     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
10303     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
10304     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
10305     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
10306     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
10307     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
10308       arabic csISOLatinArabic }
10309     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
10310     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
10311     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
10312       greek greek8 csISOLatinGreek }
10313     { T.101-G2 iso-ir-128 csISO128T101G2 }
10314     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
10315       csISOLatinHebrew }
10316     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
10317     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
10318     { CSN_369103 iso-ir-139 csISO139CSN369103 }
10319     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
10320     { ISO_6937-2-add iso-ir-142 csISOTextComm }
10321     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
10322     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
10323       csISOLatinCyrillic }
10324     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
10325     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
10326     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
10327     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
10328     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
10329     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
10330     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
10331     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
10332     { ISO_10367-box iso-ir-155 csISO10367Box }
10333     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
10334     { latin-lap lap iso-ir-158 csISO158Lap }
10335     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
10336     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
10337     { us-dk csUSDK }
10338     { dk-us csDKUS }
10339     { JIS_X0201 X0201 csHalfWidthKatakana }
10340     { KSC5636 ISO646-KR csKSC5636 }
10341     { ISO-10646-UCS-2 csUnicode }
10342     { ISO-10646-UCS-4 csUCS4 }
10343     { DEC-MCS dec csDECMCS }
10344     { hp-roman8 roman8 r8 csHPRoman8 }
10345     { macintosh mac csMacintosh }
10346     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
10347       csIBM037 }
10348     { IBM038 EBCDIC-INT cp038 csIBM038 }
10349     { IBM273 CP273 csIBM273 }
10350     { IBM274 EBCDIC-BE CP274 csIBM274 }
10351     { IBM275 EBCDIC-BR cp275 csIBM275 }
10352     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
10353     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
10354     { IBM280 CP280 ebcdic-cp-it csIBM280 }
10355     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
10356     { IBM284 CP284 ebcdic-cp-es csIBM284 }
10357     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
10358     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
10359     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
10360     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
10361     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
10362     { IBM424 cp424 ebcdic-cp-he csIBM424 }
10363     { IBM437 cp437 437 csPC8CodePage437 }
10364     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
10365     { IBM775 cp775 csPC775Baltic }
10366     { IBM850 cp850 850 csPC850Multilingual }
10367     { IBM851 cp851 851 csIBM851 }
10368     { IBM852 cp852 852 csPCp852 }
10369     { IBM855 cp855 855 csIBM855 }
10370     { IBM857 cp857 857 csIBM857 }
10371     { IBM860 cp860 860 csIBM860 }
10372     { IBM861 cp861 861 cp-is csIBM861 }
10373     { IBM862 cp862 862 csPC862LatinHebrew }
10374     { IBM863 cp863 863 csIBM863 }
10375     { IBM864 cp864 csIBM864 }
10376     { IBM865 cp865 865 csIBM865 }
10377     { IBM866 cp866 866 csIBM866 }
10378     { IBM868 CP868 cp-ar csIBM868 }
10379     { IBM869 cp869 869 cp-gr csIBM869 }
10380     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
10381     { IBM871 CP871 ebcdic-cp-is csIBM871 }
10382     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
10383     { IBM891 cp891 csIBM891 }
10384     { IBM903 cp903 csIBM903 }
10385     { IBM904 cp904 904 csIBBM904 }
10386     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
10387     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
10388     { IBM1026 CP1026 csIBM1026 }
10389     { EBCDIC-AT-DE csIBMEBCDICATDE }
10390     { EBCDIC-AT-DE-A csEBCDICATDEA }
10391     { EBCDIC-CA-FR csEBCDICCAFR }
10392     { EBCDIC-DK-NO csEBCDICDKNO }
10393     { EBCDIC-DK-NO-A csEBCDICDKNOA }
10394     { EBCDIC-FI-SE csEBCDICFISE }
10395     { EBCDIC-FI-SE-A csEBCDICFISEA }
10396     { EBCDIC-FR csEBCDICFR }
10397     { EBCDIC-IT csEBCDICIT }
10398     { EBCDIC-PT csEBCDICPT }
10399     { EBCDIC-ES csEBCDICES }
10400     { EBCDIC-ES-A csEBCDICESA }
10401     { EBCDIC-ES-S csEBCDICESS }
10402     { EBCDIC-UK csEBCDICUK }
10403     { EBCDIC-US csEBCDICUS }
10404     { UNKNOWN-8BIT csUnknown8BiT }
10405     { MNEMONIC csMnemonic }
10406     { MNEM csMnem }
10407     { VISCII csVISCII }
10408     { VIQR csVIQR }
10409     { KOI8-R csKOI8R }
10410     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
10411     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
10412     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
10413     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
10414     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
10415     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
10416     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
10417     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
10418     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
10419     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
10420     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
10421     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
10422     { IBM1047 IBM-1047 }
10423     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
10424     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
10425     { UNICODE-1-1 csUnicode11 }
10426     { CESU-8 csCESU-8 }
10427     { BOCU-1 csBOCU-1 }
10428     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
10429     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
10430       l8 }
10431     { ISO-8859-15 ISO_8859-15 Latin-9 }
10432     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
10433     { GBK CP936 MS936 windows-936 }
10434     { JIS_Encoding csJISEncoding }
10435     { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
10436     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
10437       EUC-JP }
10438     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
10439     { ISO-10646-UCS-Basic csUnicodeASCII }
10440     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
10441     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
10442     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
10443     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
10444     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
10445     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
10446     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
10447     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
10448     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
10449     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
10450     { Adobe-Standard-Encoding csAdobeStandardEncoding }
10451     { Ventura-US csVenturaUS }
10452     { Ventura-International csVenturaInternational }
10453     { PC8-Danish-Norwegian csPC8DanishNorwegian }
10454     { PC8-Turkish csPC8Turkish }
10455     { IBM-Symbols csIBMSymbols }
10456     { IBM-Thai csIBMThai }
10457     { HP-Legal csHPLegal }
10458     { HP-Pi-font csHPPiFont }
10459     { HP-Math8 csHPMath8 }
10460     { Adobe-Symbol-Encoding csHPPSMath }
10461     { HP-DeskTop csHPDesktop }
10462     { Ventura-Math csVenturaMath }
10463     { Microsoft-Publishing csMicrosoftPublishing }
10464     { Windows-31J csWindows31J }
10465     { GB2312 csGB2312 }
10466     { Big5 csBig5 }
10467 }
10468
10469 proc tcl_encoding {enc} {
10470     global encoding_aliases tcl_encoding_cache
10471     if {[info exists tcl_encoding_cache($enc)]} {
10472         return $tcl_encoding_cache($enc)
10473     }
10474     set names [encoding names]
10475     set lcnames [string tolower $names]
10476     set enc [string tolower $enc]
10477     set i [lsearch -exact $lcnames $enc]
10478     if {$i < 0} {
10479         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
10480         if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
10481             set i [lsearch -exact $lcnames $encx]
10482         }
10483     }
10484     if {$i < 0} {
10485         foreach l $encoding_aliases {
10486             set ll [string tolower $l]
10487             if {[lsearch -exact $ll $enc] < 0} continue
10488             # look through the aliases for one that tcl knows about
10489             foreach e $ll {
10490                 set i [lsearch -exact $lcnames $e]
10491                 if {$i < 0} {
10492                     if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
10493                         set i [lsearch -exact $lcnames $ex]
10494                     }
10495                 }
10496                 if {$i >= 0} break
10497             }
10498             break
10499         }
10500     }
10501     set tclenc {}
10502     if {$i >= 0} {
10503         set tclenc [lindex $names $i]
10504     }
10505     set tcl_encoding_cache($enc) $tclenc
10506     return $tclenc
10507 }
10508
10509 proc gitattr {path attr default} {
10510     global path_attr_cache
10511     if {[info exists path_attr_cache($attr,$path)]} {
10512         set r $path_attr_cache($attr,$path)
10513     } else {
10514         set r "unspecified"
10515         if {![catch {set line [exec git check-attr $attr -- $path]}]} {
10516             regexp "(.*): encoding: (.*)" $line m f r
10517         }
10518         set path_attr_cache($attr,$path) $r
10519     }
10520     if {$r eq "unspecified"} {
10521         return $default
10522     }
10523     return $r
10524 }
10525
10526 proc cache_gitattr {attr pathlist} {
10527     global path_attr_cache
10528     set newlist {}
10529     foreach path $pathlist {
10530         if {![info exists path_attr_cache($attr,$path)]} {
10531             lappend newlist $path
10532         }
10533     }
10534     set lim 1000
10535     if {[tk windowingsystem] == "win32"} {
10536         # windows has a 32k limit on the arguments to a command...
10537         set lim 30
10538     }
10539     while {$newlist ne {}} {
10540         set head [lrange $newlist 0 [expr {$lim - 1}]]
10541         set newlist [lrange $newlist $lim end]
10542         if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
10543             foreach row [split $rlist "\n"] {
10544                 if {[regexp "(.*): encoding: (.*)" $row m path value]} {
10545                     if {[string index $path 0] eq "\""} {
10546                         set path [encoding convertfrom [lindex $path 0]]
10547                     }
10548                     set path_attr_cache($attr,$path) $value
10549                 }
10550             }
10551         }
10552     }
10553 }
10554
10555 proc get_path_encoding {path} {
10556     global gui_encoding perfile_attrs
10557     set tcl_enc $gui_encoding
10558     if {$path ne {} && $perfile_attrs} {
10559         set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
10560         if {$enc2 ne {}} {
10561             set tcl_enc $enc2
10562         }
10563     }
10564     return $tcl_enc
10565 }
10566
10567 # First check that Tcl/Tk is recent enough
10568 if {[catch {package require Tk 8.4} err]} {
10569     show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
10570                      Gitk requires at least Tcl/Tk 8.4."]
10571     exit 1
10572 }
10573
10574 # defaults...
10575 set wrcomcmd "git diff-tree --stdin -p --pretty"
10576
10577 set gitencoding {}
10578 catch {
10579     set gitencoding [exec git config --get i18n.commitencoding]
10580 }
10581 catch {
10582     set gitencoding [exec git config --get i18n.logoutputencoding]
10583 }
10584 if {$gitencoding == ""} {
10585     set gitencoding "utf-8"
10586 }
10587 set tclencoding [tcl_encoding $gitencoding]
10588 if {$tclencoding == {}} {
10589     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
10590 }
10591
10592 set gui_encoding [encoding system]
10593 catch {
10594     set enc [exec git config --get gui.encoding]
10595     if {$enc ne {}} {
10596         set tclenc [tcl_encoding $enc]
10597         if {$tclenc ne {}} {
10598             set gui_encoding $tclenc
10599         } else {
10600             puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
10601         }
10602     }
10603 }
10604
10605 set mainfont {Helvetica 9}
10606 set textfont {Courier 9}
10607 set uifont {Helvetica 9 bold}
10608 set tabstop 8
10609 set findmergefiles 0
10610 set maxgraphpct 50
10611 set maxwidth 16
10612 set revlistorder 0
10613 set fastdate 0
10614 set uparrowlen 5
10615 set downarrowlen 5
10616 set mingaplen 100
10617 set cmitmode "patch"
10618 set wrapcomment "none"
10619 set showneartags 1
10620 set maxrefs 20
10621 set maxlinelen 200
10622 set showlocalchanges 1
10623 set limitdiffs 1
10624 set datetimeformat "%Y-%m-%d %H:%M:%S"
10625 set autoselect 1
10626 set perfile_attrs 0
10627
10628 set extdifftool "meld"
10629
10630 set colors {green red blue magenta darkgrey brown orange}
10631 set bgcolor white
10632 set fgcolor black
10633 set diffcolors {red "#00a000" blue}
10634 set diffcontext 3
10635 set ignorespace 0
10636 set selectbgcolor gray85
10637 set markbgcolor "#e0e0ff"
10638
10639 set circlecolors {white blue gray blue blue}
10640
10641 # button for popping up context menus
10642 if {[tk windowingsystem] eq "aqua"} {
10643     set ctxbut <Button-2>
10644 } else {
10645     set ctxbut <Button-3>
10646 }
10647
10648 ## For msgcat loading, first locate the installation location.
10649 if { [info exists ::env(GITK_MSGSDIR)] } {
10650     ## Msgsdir was manually set in the environment.
10651     set gitk_msgsdir $::env(GITK_MSGSDIR)
10652 } else {
10653     ## Let's guess the prefix from argv0.
10654     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
10655     set gitk_libdir [file join $gitk_prefix share gitk lib]
10656     set gitk_msgsdir [file join $gitk_libdir msgs]
10657     unset gitk_prefix
10658 }
10659
10660 ## Internationalization (i18n) through msgcat and gettext. See
10661 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
10662 package require msgcat
10663 namespace import ::msgcat::mc
10664 ## And eventually load the actual message catalog
10665 ::msgcat::mcload $gitk_msgsdir
10666
10667 catch {source ~/.gitk}
10668
10669 font create optionfont -family sans-serif -size -12
10670
10671 parsefont mainfont $mainfont
10672 eval font create mainfont [fontflags mainfont]
10673 eval font create mainfontbold [fontflags mainfont 1]
10674
10675 parsefont textfont $textfont
10676 eval font create textfont [fontflags textfont]
10677 eval font create textfontbold [fontflags textfont 1]
10678
10679 parsefont uifont $uifont
10680 eval font create uifont [fontflags uifont]
10681
10682 setoptions
10683
10684 # check that we can find a .git directory somewhere...
10685 if {[catch {set gitdir [gitdir]}]} {
10686     show_error {} . [mc "Cannot find a git repository here."]
10687     exit 1
10688 }
10689 if {![file isdirectory $gitdir]} {
10690     show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
10691     exit 1
10692 }
10693
10694 set selecthead {}
10695 set selectheadid {}
10696
10697 set revtreeargs {}
10698 set cmdline_files {}
10699 set i 0
10700 set revtreeargscmd {}
10701 foreach arg $argv {
10702     switch -glob -- $arg {
10703         "" { }
10704         "--" {
10705             set cmdline_files [lrange $argv [expr {$i + 1}] end]
10706             break
10707         }
10708         "--select-commit=*" {
10709             set selecthead [string range $arg 16 end]
10710         }
10711         "--argscmd=*" {
10712             set revtreeargscmd [string range $arg 10 end]
10713         }
10714         default {
10715             lappend revtreeargs $arg
10716         }
10717     }
10718     incr i
10719 }
10720
10721 if {$selecthead eq "HEAD"} {
10722     set selecthead {}
10723 }
10724
10725 if {$i >= [llength $argv] && $revtreeargs ne {}} {
10726     # no -- on command line, but some arguments (other than --argscmd)
10727     if {[catch {
10728         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
10729         set cmdline_files [split $f "\n"]
10730         set n [llength $cmdline_files]
10731         set revtreeargs [lrange $revtreeargs 0 end-$n]
10732         # Unfortunately git rev-parse doesn't produce an error when
10733         # something is both a revision and a filename.  To be consistent
10734         # with git log and git rev-list, check revtreeargs for filenames.
10735         foreach arg $revtreeargs {
10736             if {[file exists $arg]} {
10737                 show_error {} . [mc "Ambiguous argument '%s': both revision\
10738                                  and filename" $arg]
10739                 exit 1
10740             }
10741         }
10742     } err]} {
10743         # unfortunately we get both stdout and stderr in $err,
10744         # so look for "fatal:".
10745         set i [string first "fatal:" $err]
10746         if {$i > 0} {
10747             set err [string range $err [expr {$i + 6}] end]
10748         }
10749         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
10750         exit 1
10751     }
10752 }
10753
10754 set nullid "0000000000000000000000000000000000000000"
10755 set nullid2 "0000000000000000000000000000000000000001"
10756 set nullfile "/dev/null"
10757
10758 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
10759
10760 set runq {}
10761 set history {}
10762 set historyindex 0
10763 set fh_serial 0
10764 set nhl_names {}
10765 set highlight_paths {}
10766 set findpattern {}
10767 set searchdirn -forwards
10768 set boldids {}
10769 set boldnameids {}
10770 set diffelide {0 0}
10771 set markingmatches 0
10772 set linkentercount 0
10773 set need_redisplay 0
10774 set nrows_drawn 0
10775 set firsttabstop 0
10776
10777 set nextviewnum 1
10778 set curview 0
10779 set selectedview 0
10780 set selectedhlview [mc "None"]
10781 set highlight_related [mc "None"]
10782 set highlight_files {}
10783 set viewfiles(0) {}
10784 set viewperm(0) 0
10785 set viewargs(0) {}
10786 set viewargscmd(0) {}
10787
10788 set selectedline {}
10789 set numcommits 0
10790 set loginstance 0
10791 set cmdlineok 0
10792 set stopped 0
10793 set stuffsaved 0
10794 set patchnum 0
10795 set lserial 0
10796 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
10797 setcoords
10798 makewindow
10799 # wait for the window to become visible
10800 tkwait visibility .
10801 wm title . "[file tail $argv0]: [file tail [pwd]]"
10802 readrefs
10803
10804 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
10805     # create a view for the files/dirs specified on the command line
10806     set curview 1
10807     set selectedview 1
10808     set nextviewnum 2
10809     set viewname(1) [mc "Command line"]
10810     set viewfiles(1) $cmdline_files
10811     set viewargs(1) $revtreeargs
10812     set viewargscmd(1) $revtreeargscmd
10813     set viewperm(1) 0
10814     set vdatemode(1) 0
10815     addviewmenu 1
10816     .bar.view entryconf [mca "Edit view..."] -state normal
10817     .bar.view entryconf [mca "Delete view"] -state normal
10818 }
10819
10820 if {[info exists permviews]} {
10821     foreach v $permviews {
10822         set n $nextviewnum
10823         incr nextviewnum
10824         set viewname($n) [lindex $v 0]
10825         set viewfiles($n) [lindex $v 1]
10826         set viewargs($n) [lindex $v 2]
10827         set viewargscmd($n) [lindex $v 3]
10828         set viewperm($n) 1
10829         addviewmenu $n
10830     }
10831 }
10832 getcommits {}