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