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 0] savecmitpos
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 {saveproc {}}} {
6774     global history historyindex curview
6775
6776     unset_posvars
6777     save_position
6778     set elt [list $curview $cmd $saveproc {}]
6779     if {$historyindex > 0
6780         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
6781         return
6782     }
6783
6784     if {$historyindex < [llength $history]} {
6785         set history [lreplace $history $historyindex end $elt]
6786     } else {
6787         lappend history $elt
6788     }
6789     incr historyindex
6790     if {$historyindex > 1} {
6791         .tf.bar.leftbut conf -state normal
6792     } else {
6793         .tf.bar.leftbut conf -state disabled
6794     }
6795     .tf.bar.rightbut conf -state disabled
6796 }
6797
6798 # save the scrolling position of the diff display pane
6799 proc save_position {} {
6800     global historyindex history
6801
6802     if {$historyindex < 1} return
6803     set hi [expr {$historyindex - 1}]
6804     set fn [lindex $history $hi 2]
6805     if {$fn ne {}} {
6806         lset history $hi 3 [eval $fn]
6807     }
6808 }
6809
6810 proc unset_posvars {} {
6811     global last_posvars
6812
6813     if {[info exists last_posvars]} {
6814         foreach {var val} $last_posvars {
6815             global $var
6816             catch {unset $var}
6817         }
6818         unset last_posvars
6819     }
6820 }
6821
6822 proc godo {elt} {
6823     global curview last_posvars
6824
6825     set view [lindex $elt 0]
6826     set cmd [lindex $elt 1]
6827     set pv [lindex $elt 3]
6828     if {$curview != $view} {
6829         showview $view
6830     }
6831     unset_posvars
6832     foreach {var val} $pv {
6833         global $var
6834         set $var $val
6835     }
6836     set last_posvars $pv
6837     eval $cmd
6838 }
6839
6840 proc goback {} {
6841     global history historyindex
6842     focus .
6843
6844     if {$historyindex > 1} {
6845         save_position
6846         incr historyindex -1
6847         godo [lindex $history [expr {$historyindex - 1}]]
6848         .tf.bar.rightbut conf -state normal
6849     }
6850     if {$historyindex <= 1} {
6851         .tf.bar.leftbut conf -state disabled
6852     }
6853 }
6854
6855 proc goforw {} {
6856     global history historyindex
6857     focus .
6858
6859     if {$historyindex < [llength $history]} {
6860         save_position
6861         set cmd [lindex $history $historyindex]
6862         incr historyindex
6863         godo $cmd
6864         .tf.bar.leftbut conf -state normal
6865     }
6866     if {$historyindex >= [llength $history]} {
6867         .tf.bar.rightbut conf -state disabled
6868     }
6869 }
6870
6871 proc gettree {id} {
6872     global treefilelist treeidlist diffids diffmergeid treepending
6873     global nullid nullid2
6874
6875     set diffids $id
6876     catch {unset diffmergeid}
6877     if {![info exists treefilelist($id)]} {
6878         if {![info exists treepending]} {
6879             if {$id eq $nullid} {
6880                 set cmd [list | git ls-files]
6881             } elseif {$id eq $nullid2} {
6882                 set cmd [list | git ls-files --stage -t]
6883             } else {
6884                 set cmd [list | git ls-tree -r $id]
6885             }
6886             if {[catch {set gtf [open $cmd r]}]} {
6887                 return
6888             }
6889             set treepending $id
6890             set treefilelist($id) {}
6891             set treeidlist($id) {}
6892             fconfigure $gtf -blocking 0 -encoding binary
6893             filerun $gtf [list gettreeline $gtf $id]
6894         }
6895     } else {
6896         setfilelist $id
6897     }
6898 }
6899
6900 proc gettreeline {gtf id} {
6901     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
6902
6903     set nl 0
6904     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
6905         if {$diffids eq $nullid} {
6906             set fname $line
6907         } else {
6908             set i [string first "\t" $line]
6909             if {$i < 0} continue
6910             set fname [string range $line [expr {$i+1}] end]
6911             set line [string range $line 0 [expr {$i-1}]]
6912             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
6913             set sha1 [lindex $line 2]
6914             lappend treeidlist($id) $sha1
6915         }
6916         if {[string index $fname 0] eq "\""} {
6917             set fname [lindex $fname 0]
6918         }
6919         set fname [encoding convertfrom $fname]
6920         lappend treefilelist($id) $fname
6921     }
6922     if {![eof $gtf]} {
6923         return [expr {$nl >= 1000? 2: 1}]
6924     }
6925     close $gtf
6926     unset treepending
6927     if {$cmitmode ne "tree"} {
6928         if {![info exists diffmergeid]} {
6929             gettreediffs $diffids
6930         }
6931     } elseif {$id ne $diffids} {
6932         gettree $diffids
6933     } else {
6934         setfilelist $id
6935     }
6936     return 0
6937 }
6938
6939 proc showfile {f} {
6940     global treefilelist treeidlist diffids nullid nullid2
6941     global ctext_file_names ctext_file_lines
6942     global ctext commentend
6943
6944     set i [lsearch -exact $treefilelist($diffids) $f]
6945     if {$i < 0} {
6946         puts "oops, $f not in list for id $diffids"
6947         return
6948     }
6949     if {$diffids eq $nullid} {
6950         if {[catch {set bf [open $f r]} err]} {
6951             puts "oops, can't read $f: $err"
6952             return
6953         }
6954     } else {
6955         set blob [lindex $treeidlist($diffids) $i]
6956         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
6957             puts "oops, error reading blob $blob: $err"
6958             return
6959         }
6960     }
6961     fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
6962     filerun $bf [list getblobline $bf $diffids]
6963     $ctext config -state normal
6964     clear_ctext $commentend
6965     lappend ctext_file_names $f
6966     lappend ctext_file_lines [lindex [split $commentend "."] 0]
6967     $ctext insert end "\n"
6968     $ctext insert end "$f\n" filesep
6969     $ctext config -state disabled
6970     $ctext yview $commentend
6971     settabs 0
6972 }
6973
6974 proc getblobline {bf id} {
6975     global diffids cmitmode ctext
6976
6977     if {$id ne $diffids || $cmitmode ne "tree"} {
6978         catch {close $bf}
6979         return 0
6980     }
6981     $ctext config -state normal
6982     set nl 0
6983     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
6984         $ctext insert end "$line\n"
6985     }
6986     if {[eof $bf]} {
6987         global jump_to_here ctext_file_names commentend
6988
6989         # delete last newline
6990         $ctext delete "end - 2c" "end - 1c"
6991         close $bf
6992         if {$jump_to_here ne {} &&
6993             [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
6994             set lnum [expr {[lindex $jump_to_here 1] +
6995                             [lindex [split $commentend .] 0]}]
6996             mark_ctext_line $lnum
6997         }
6998         return 0
6999     }
7000     $ctext config -state disabled
7001     return [expr {$nl >= 1000? 2: 1}]
7002 }
7003
7004 proc mark_ctext_line {lnum} {
7005     global ctext markbgcolor
7006
7007     $ctext tag delete omark
7008     $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7009     $ctext tag conf omark -background $markbgcolor
7010     $ctext see $lnum.0
7011 }
7012
7013 proc mergediff {id} {
7014     global diffmergeid
7015     global diffids treediffs
7016     global parents curview
7017
7018     set diffmergeid $id
7019     set diffids $id
7020     set treediffs($id) {}
7021     set np [llength $parents($curview,$id)]
7022     settabs $np
7023     getblobdiffs $id
7024 }
7025
7026 proc startdiff {ids} {
7027     global treediffs diffids treepending diffmergeid nullid nullid2
7028
7029     settabs 1
7030     set diffids $ids
7031     catch {unset diffmergeid}
7032     if {![info exists treediffs($ids)] ||
7033         [lsearch -exact $ids $nullid] >= 0 ||
7034         [lsearch -exact $ids $nullid2] >= 0} {
7035         if {![info exists treepending]} {
7036             gettreediffs $ids
7037         }
7038     } else {
7039         addtocflist $ids
7040     }
7041 }
7042
7043 proc path_filter {filter name} {
7044     foreach p $filter {
7045         set l [string length $p]
7046         if {[string index $p end] eq "/"} {
7047             if {[string compare -length $l $p $name] == 0} {
7048                 return 1
7049             }
7050         } else {
7051             if {[string compare -length $l $p $name] == 0 &&
7052                 ([string length $name] == $l ||
7053                  [string index $name $l] eq "/")} {
7054                 return 1
7055             }
7056         }
7057     }
7058     return 0
7059 }
7060
7061 proc addtocflist {ids} {
7062     global treediffs
7063
7064     add_flist $treediffs($ids)
7065     getblobdiffs $ids
7066 }
7067
7068 proc diffcmd {ids flags} {
7069     global nullid nullid2
7070
7071     set i [lsearch -exact $ids $nullid]
7072     set j [lsearch -exact $ids $nullid2]
7073     if {$i >= 0} {
7074         if {[llength $ids] > 1 && $j < 0} {
7075             # comparing working directory with some specific revision
7076             set cmd [concat | git diff-index $flags]
7077             if {$i == 0} {
7078                 lappend cmd -R [lindex $ids 1]
7079             } else {
7080                 lappend cmd [lindex $ids 0]
7081             }
7082         } else {
7083             # comparing working directory with index
7084             set cmd [concat | git diff-files $flags]
7085             if {$j == 1} {
7086                 lappend cmd -R
7087             }
7088         }
7089     } elseif {$j >= 0} {
7090         set cmd [concat | git diff-index --cached $flags]
7091         if {[llength $ids] > 1} {
7092             # comparing index with specific revision
7093             if {$i == 0} {
7094                 lappend cmd -R [lindex $ids 1]
7095             } else {
7096                 lappend cmd [lindex $ids 0]
7097             }
7098         } else {
7099             # comparing index with HEAD
7100             lappend cmd HEAD
7101         }
7102     } else {
7103         set cmd [concat | git diff-tree -r $flags $ids]
7104     }
7105     return $cmd
7106 }
7107
7108 proc gettreediffs {ids} {
7109     global treediff treepending
7110
7111     if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7112
7113     set treepending $ids
7114     set treediff {}
7115     fconfigure $gdtf -blocking 0 -encoding binary
7116     filerun $gdtf [list gettreediffline $gdtf $ids]
7117 }
7118
7119 proc gettreediffline {gdtf ids} {
7120     global treediff treediffs treepending diffids diffmergeid
7121     global cmitmode vfilelimit curview limitdiffs perfile_attrs
7122
7123     set nr 0
7124     set sublist {}
7125     set max 1000
7126     if {$perfile_attrs} {
7127         # cache_gitattr is slow, and even slower on win32 where we
7128         # have to invoke it for only about 30 paths at a time
7129         set max 500
7130         if {[tk windowingsystem] == "win32"} {
7131             set max 120
7132         }
7133     }
7134     while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7135         set i [string first "\t" $line]
7136         if {$i >= 0} {
7137             set file [string range $line [expr {$i+1}] end]
7138             if {[string index $file 0] eq "\""} {
7139                 set file [lindex $file 0]
7140             }
7141             set file [encoding convertfrom $file]
7142             if {$file ne [lindex $treediff end]} {
7143                 lappend treediff $file
7144                 lappend sublist $file
7145             }
7146         }
7147     }
7148     if {$perfile_attrs} {
7149         cache_gitattr encoding $sublist
7150     }
7151     if {![eof $gdtf]} {
7152         return [expr {$nr >= $max? 2: 1}]
7153     }
7154     close $gdtf
7155     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7156         set flist {}
7157         foreach f $treediff {
7158             if {[path_filter $vfilelimit($curview) $f]} {
7159                 lappend flist $f
7160             }
7161         }
7162         set treediffs($ids) $flist
7163     } else {
7164         set treediffs($ids) $treediff
7165     }
7166     unset treepending
7167     if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7168         gettree $diffids
7169     } elseif {$ids != $diffids} {
7170         if {![info exists diffmergeid]} {
7171             gettreediffs $diffids
7172         }
7173     } else {
7174         addtocflist $ids
7175     }
7176     return 0
7177 }
7178
7179 # empty string or positive integer
7180 proc diffcontextvalidate {v} {
7181     return [regexp {^(|[1-9][0-9]*)$} $v]
7182 }
7183
7184 proc diffcontextchange {n1 n2 op} {
7185     global diffcontextstring diffcontext
7186
7187     if {[string is integer -strict $diffcontextstring]} {
7188         if {$diffcontextstring > 0} {
7189             set diffcontext $diffcontextstring
7190             reselectline
7191         }
7192     }
7193 }
7194
7195 proc changeignorespace {} {
7196     reselectline
7197 }
7198
7199 proc getblobdiffs {ids} {
7200     global blobdifffd diffids env
7201     global diffinhdr treediffs
7202     global diffcontext
7203     global ignorespace
7204     global limitdiffs vfilelimit curview
7205     global diffencoding targetline diffnparents
7206
7207     set cmd [diffcmd $ids "-p -C --cc --no-commit-id -U$diffcontext"]
7208     if {$ignorespace} {
7209         append cmd " -w"
7210     }
7211     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7212         set cmd [concat $cmd -- $vfilelimit($curview)]
7213     }
7214     if {[catch {set bdf [open $cmd r]} err]} {
7215         error_popup [mc "Error getting diffs: %s" $err]
7216         return
7217     }
7218     set targetline {}
7219     set diffnparents 0
7220     set diffinhdr 0
7221     set diffencoding [get_path_encoding {}]
7222     fconfigure $bdf -blocking 0 -encoding binary
7223     set blobdifffd($ids) $bdf
7224     filerun $bdf [list getblobdiffline $bdf $diffids]
7225 }
7226
7227 proc savecmitpos {} {
7228     global ctext cmitmode
7229
7230     if {$cmitmode eq "tree"} {
7231         return {}
7232     }
7233     return [list target_scrollpos [$ctext index @0,0]]
7234 }
7235
7236 proc savectextpos {} {
7237     global ctext
7238
7239     return [list target_scrollpos [$ctext index @0,0]]
7240 }
7241
7242 proc maybe_scroll_ctext {ateof} {
7243     global ctext target_scrollpos
7244
7245     if {![info exists target_scrollpos]} return
7246     if {!$ateof} {
7247         set nlines [expr {[winfo height $ctext]
7248                           / [font metrics textfont -linespace]}]
7249         if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7250     }
7251     $ctext yview $target_scrollpos
7252     unset target_scrollpos
7253 }
7254
7255 proc setinlist {var i val} {
7256     global $var
7257
7258     while {[llength [set $var]] < $i} {
7259         lappend $var {}
7260     }
7261     if {[llength [set $var]] == $i} {
7262         lappend $var $val
7263     } else {
7264         lset $var $i $val
7265     }
7266 }
7267
7268 proc makediffhdr {fname ids} {
7269     global ctext curdiffstart treediffs diffencoding
7270     global ctext_file_names jump_to_here targetline diffline
7271
7272     set fname [encoding convertfrom $fname]
7273     set diffencoding [get_path_encoding $fname]
7274     set i [lsearch -exact $treediffs($ids) $fname]
7275     if {$i >= 0} {
7276         setinlist difffilestart $i $curdiffstart
7277     }
7278     lset ctext_file_names end $fname
7279     set l [expr {(78 - [string length $fname]) / 2}]
7280     set pad [string range "----------------------------------------" 1 $l]
7281     $ctext insert $curdiffstart "$pad $fname $pad" filesep
7282     set targetline {}
7283     if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7284         set targetline [lindex $jump_to_here 1]
7285     }
7286     set diffline 0
7287 }
7288
7289 proc getblobdiffline {bdf ids} {
7290     global diffids blobdifffd ctext curdiffstart
7291     global diffnexthead diffnextnote difffilestart
7292     global ctext_file_names ctext_file_lines
7293     global diffinhdr treediffs mergemax diffnparents
7294     global diffencoding jump_to_here targetline diffline
7295
7296     set nr 0
7297     $ctext conf -state normal
7298     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7299         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7300             close $bdf
7301             return 0
7302         }
7303         if {![string compare -length 5 "diff " $line]} {
7304             if {![regexp {^diff (--cc|--git) } $line m type]} {
7305                 set line [encoding convertfrom $line]
7306                 $ctext insert end "$line\n" hunksep
7307                 continue
7308             }
7309             # start of a new file
7310             set diffinhdr 1
7311             $ctext insert end "\n"
7312             set curdiffstart [$ctext index "end - 1c"]
7313             lappend ctext_file_names ""
7314             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7315             $ctext insert end "\n" filesep
7316
7317             if {$type eq "--cc"} {
7318                 # start of a new file in a merge diff
7319                 set fname [string range $line 10 end]
7320                 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7321                     lappend treediffs($ids) $fname
7322                     add_flist [list $fname]
7323                 }
7324
7325             } else {
7326                 set line [string range $line 11 end]
7327                 # If the name hasn't changed the length will be odd,
7328                 # the middle char will be a space, and the two bits either
7329                 # side will be a/name and b/name, or "a/name" and "b/name".
7330                 # If the name has changed we'll get "rename from" and
7331                 # "rename to" or "copy from" and "copy to" lines following
7332                 # this, and we'll use them to get the filenames.
7333                 # This complexity is necessary because spaces in the
7334                 # filename(s) don't get escaped.
7335                 set l [string length $line]
7336                 set i [expr {$l / 2}]
7337                 if {!(($l & 1) && [string index $line $i] eq " " &&
7338                       [string range $line 2 [expr {$i - 1}]] eq \
7339                           [string range $line [expr {$i + 3}] end])} {
7340                     continue
7341                 }
7342                 # unescape if quoted and chop off the a/ from the front
7343                 if {[string index $line 0] eq "\""} {
7344                     set fname [string range [lindex $line 0] 2 end]
7345                 } else {
7346                     set fname [string range $line 2 [expr {$i - 1}]]
7347                 }
7348             }
7349             makediffhdr $fname $ids
7350
7351         } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7352             set fname [encoding convertfrom [string range $line 16 end]]
7353             $ctext insert end "\n"
7354             set curdiffstart [$ctext index "end - 1c"]
7355             lappend ctext_file_names $fname
7356             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7357             $ctext insert end "$line\n" filesep
7358             set i [lsearch -exact $treediffs($ids) $fname]
7359             if {$i >= 0} {
7360                 setinlist difffilestart $i $curdiffstart
7361             }
7362
7363         } elseif {![string compare -length 2 "@@" $line]} {
7364             regexp {^@@+} $line ats
7365             set line [encoding convertfrom $diffencoding $line]
7366             $ctext insert end "$line\n" hunksep
7367             if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7368                 set diffline $nl
7369             }
7370             set diffnparents [expr {[string length $ats] - 1}]
7371             set diffinhdr 0
7372
7373         } elseif {$diffinhdr} {
7374             if {![string compare -length 12 "rename from " $line]} {
7375                 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7376                 if {[string index $fname 0] eq "\""} {
7377                     set fname [lindex $fname 0]
7378                 }
7379                 set fname [encoding convertfrom $fname]
7380                 set i [lsearch -exact $treediffs($ids) $fname]
7381                 if {$i >= 0} {
7382                     setinlist difffilestart $i $curdiffstart
7383                 }
7384             } elseif {![string compare -length 10 $line "rename to "] ||
7385                       ![string compare -length 8 $line "copy to "]} {
7386                 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7387                 if {[string index $fname 0] eq "\""} {
7388                     set fname [lindex $fname 0]
7389                 }
7390                 makediffhdr $fname $ids
7391             } elseif {[string compare -length 3 $line "---"] == 0} {
7392                 # do nothing
7393                 continue
7394             } elseif {[string compare -length 3 $line "+++"] == 0} {
7395                 set diffinhdr 0
7396                 continue
7397             }
7398             $ctext insert end "$line\n" filesep
7399
7400         } else {
7401             set line [encoding convertfrom $diffencoding $line]
7402             # parse the prefix - one ' ', '-' or '+' for each parent
7403             set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7404             set tag [expr {$diffnparents > 1? "m": "d"}]
7405             if {[string trim $prefix " -+"] eq {}} {
7406                 # prefix only has " ", "-" and "+" in it: normal diff line
7407                 set num [string first "-" $prefix]
7408                 if {$num >= 0} {
7409                     # removed line, first parent with line is $num
7410                     if {$num >= $mergemax} {
7411                         set num "max"
7412                     }
7413                     $ctext insert end "$line\n" $tag$num
7414                 } else {
7415                     set tags {}
7416                     if {[string first "+" $prefix] >= 0} {
7417                         # added line
7418                         lappend tags ${tag}result
7419                         if {$diffnparents > 1} {
7420                             set num [string first " " $prefix]
7421                             if {$num >= 0} {
7422                                 if {$num >= $mergemax} {
7423                                     set num "max"
7424                                 }
7425                                 lappend tags m$num
7426                             }
7427                         }
7428                     }
7429                     if {$targetline ne {}} {
7430                         if {$diffline == $targetline} {
7431                             set seehere [$ctext index "end - 1 chars"]
7432                             set targetline {}
7433                         } else {
7434                             incr diffline
7435                         }
7436                     }
7437                     $ctext insert end "$line\n" $tags
7438                 }
7439             } else {
7440                 # "\ No newline at end of file",
7441                 # or something else we don't recognize
7442                 $ctext insert end "$line\n" hunksep
7443             }
7444         }
7445     }
7446     if {[info exists seehere]} {
7447         mark_ctext_line [lindex [split $seehere .] 0]
7448     }
7449     maybe_scroll_ctext [eof $bdf]
7450     $ctext conf -state disabled
7451     if {[eof $bdf]} {
7452         close $bdf
7453         return 0
7454     }
7455     return [expr {$nr >= 1000? 2: 1}]
7456 }
7457
7458 proc changediffdisp {} {
7459     global ctext diffelide
7460
7461     $ctext tag conf d0 -elide [lindex $diffelide 0]
7462     $ctext tag conf dresult -elide [lindex $diffelide 1]
7463 }
7464
7465 proc highlightfile {loc cline} {
7466     global ctext cflist cflist_top
7467
7468     $ctext yview $loc
7469     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7470     $cflist tag add highlight $cline.0 "$cline.0 lineend"
7471     $cflist see $cline.0
7472     set cflist_top $cline
7473 }
7474
7475 proc prevfile {} {
7476     global difffilestart ctext cmitmode
7477
7478     if {$cmitmode eq "tree"} return
7479     set prev 0.0
7480     set prevline 1
7481     set here [$ctext index @0,0]
7482     foreach loc $difffilestart {
7483         if {[$ctext compare $loc >= $here]} {
7484             highlightfile $prev $prevline
7485             return
7486         }
7487         set prev $loc
7488         incr prevline
7489     }
7490     highlightfile $prev $prevline
7491 }
7492
7493 proc nextfile {} {
7494     global difffilestart ctext cmitmode
7495
7496     if {$cmitmode eq "tree"} return
7497     set here [$ctext index @0,0]
7498     set line 1
7499     foreach loc $difffilestart {
7500         incr line
7501         if {[$ctext compare $loc > $here]} {
7502             highlightfile $loc $line
7503             return
7504         }
7505     }
7506 }
7507
7508 proc clear_ctext {{first 1.0}} {
7509     global ctext smarktop smarkbot
7510     global ctext_file_names ctext_file_lines
7511     global pendinglinks
7512
7513     set l [lindex [split $first .] 0]
7514     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7515         set smarktop $l
7516     }
7517     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7518         set smarkbot $l
7519     }
7520     $ctext delete $first end
7521     if {$first eq "1.0"} {
7522         catch {unset pendinglinks}
7523     }
7524     set ctext_file_names {}
7525     set ctext_file_lines {}
7526 }
7527
7528 proc settabs {{firstab {}}} {
7529     global firsttabstop tabstop ctext have_tk85
7530
7531     if {$firstab ne {} && $have_tk85} {
7532         set firsttabstop $firstab
7533     }
7534     set w [font measure textfont "0"]
7535     if {$firsttabstop != 0} {
7536         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7537                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7538     } elseif {$have_tk85 || $tabstop != 8} {
7539         $ctext conf -tabs [expr {$tabstop * $w}]
7540     } else {
7541         $ctext conf -tabs {}
7542     }
7543 }
7544
7545 proc incrsearch {name ix op} {
7546     global ctext searchstring searchdirn
7547
7548     $ctext tag remove found 1.0 end
7549     if {[catch {$ctext index anchor}]} {
7550         # no anchor set, use start of selection, or of visible area
7551         set sel [$ctext tag ranges sel]
7552         if {$sel ne {}} {
7553             $ctext mark set anchor [lindex $sel 0]
7554         } elseif {$searchdirn eq "-forwards"} {
7555             $ctext mark set anchor @0,0
7556         } else {
7557             $ctext mark set anchor @0,[winfo height $ctext]
7558         }
7559     }
7560     if {$searchstring ne {}} {
7561         set here [$ctext search $searchdirn -- $searchstring anchor]
7562         if {$here ne {}} {
7563             $ctext see $here
7564         }
7565         searchmarkvisible 1
7566     }
7567 }
7568
7569 proc dosearch {} {
7570     global sstring ctext searchstring searchdirn
7571
7572     focus $sstring
7573     $sstring icursor end
7574     set searchdirn -forwards
7575     if {$searchstring ne {}} {
7576         set sel [$ctext tag ranges sel]
7577         if {$sel ne {}} {
7578             set start "[lindex $sel 0] + 1c"
7579         } elseif {[catch {set start [$ctext index anchor]}]} {
7580             set start "@0,0"
7581         }
7582         set match [$ctext search -count mlen -- $searchstring $start]
7583         $ctext tag remove sel 1.0 end
7584         if {$match eq {}} {
7585             bell
7586             return
7587         }
7588         $ctext see $match
7589         set mend "$match + $mlen c"
7590         $ctext tag add sel $match $mend
7591         $ctext mark unset anchor
7592     }
7593 }
7594
7595 proc dosearchback {} {
7596     global sstring ctext searchstring searchdirn
7597
7598     focus $sstring
7599     $sstring icursor end
7600     set searchdirn -backwards
7601     if {$searchstring ne {}} {
7602         set sel [$ctext tag ranges sel]
7603         if {$sel ne {}} {
7604             set start [lindex $sel 0]
7605         } elseif {[catch {set start [$ctext index anchor]}]} {
7606             set start @0,[winfo height $ctext]
7607         }
7608         set match [$ctext search -backwards -count ml -- $searchstring $start]
7609         $ctext tag remove sel 1.0 end
7610         if {$match eq {}} {
7611             bell
7612             return
7613         }
7614         $ctext see $match
7615         set mend "$match + $ml c"
7616         $ctext tag add sel $match $mend
7617         $ctext mark unset anchor
7618     }
7619 }
7620
7621 proc searchmark {first last} {
7622     global ctext searchstring
7623
7624     set mend $first.0
7625     while {1} {
7626         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
7627         if {$match eq {}} break
7628         set mend "$match + $mlen c"
7629         $ctext tag add found $match $mend
7630     }
7631 }
7632
7633 proc searchmarkvisible {doall} {
7634     global ctext smarktop smarkbot
7635
7636     set topline [lindex [split [$ctext index @0,0] .] 0]
7637     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
7638     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
7639         # no overlap with previous
7640         searchmark $topline $botline
7641         set smarktop $topline
7642         set smarkbot $botline
7643     } else {
7644         if {$topline < $smarktop} {
7645             searchmark $topline [expr {$smarktop-1}]
7646             set smarktop $topline
7647         }
7648         if {$botline > $smarkbot} {
7649             searchmark [expr {$smarkbot+1}] $botline
7650             set smarkbot $botline
7651         }
7652     }
7653 }
7654
7655 proc scrolltext {f0 f1} {
7656     global searchstring
7657
7658     .bleft.bottom.sb set $f0 $f1
7659     if {$searchstring ne {}} {
7660         searchmarkvisible 0
7661     }
7662 }
7663
7664 proc setcoords {} {
7665     global linespc charspc canvx0 canvy0
7666     global xspc1 xspc2 lthickness
7667
7668     set linespc [font metrics mainfont -linespace]
7669     set charspc [font measure mainfont "m"]
7670     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
7671     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
7672     set lthickness [expr {int($linespc / 9) + 1}]
7673     set xspc1(0) $linespc
7674     set xspc2 $linespc
7675 }
7676
7677 proc redisplay {} {
7678     global canv
7679     global selectedline
7680
7681     set ymax [lindex [$canv cget -scrollregion] 3]
7682     if {$ymax eq {} || $ymax == 0} return
7683     set span [$canv yview]
7684     clear_display
7685     setcanvscroll
7686     allcanvs yview moveto [lindex $span 0]
7687     drawvisible
7688     if {$selectedline ne {}} {
7689         selectline $selectedline 0
7690         allcanvs yview moveto [lindex $span 0]
7691     }
7692 }
7693
7694 proc parsefont {f n} {
7695     global fontattr
7696
7697     set fontattr($f,family) [lindex $n 0]
7698     set s [lindex $n 1]
7699     if {$s eq {} || $s == 0} {
7700         set s 10
7701     } elseif {$s < 0} {
7702         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
7703     }
7704     set fontattr($f,size) $s
7705     set fontattr($f,weight) normal
7706     set fontattr($f,slant) roman
7707     foreach style [lrange $n 2 end] {
7708         switch -- $style {
7709             "normal" -
7710             "bold"   {set fontattr($f,weight) $style}
7711             "roman" -
7712             "italic" {set fontattr($f,slant) $style}
7713         }
7714     }
7715 }
7716
7717 proc fontflags {f {isbold 0}} {
7718     global fontattr
7719
7720     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
7721                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
7722                 -slant $fontattr($f,slant)]
7723 }
7724
7725 proc fontname {f} {
7726     global fontattr
7727
7728     set n [list $fontattr($f,family) $fontattr($f,size)]
7729     if {$fontattr($f,weight) eq "bold"} {
7730         lappend n "bold"
7731     }
7732     if {$fontattr($f,slant) eq "italic"} {
7733         lappend n "italic"
7734     }
7735     return $n
7736 }
7737
7738 proc incrfont {inc} {
7739     global mainfont textfont ctext canv cflist showrefstop
7740     global stopped entries fontattr
7741
7742     unmarkmatches
7743     set s $fontattr(mainfont,size)
7744     incr s $inc
7745     if {$s < 1} {
7746         set s 1
7747     }
7748     set fontattr(mainfont,size) $s
7749     font config mainfont -size $s
7750     font config mainfontbold -size $s
7751     set mainfont [fontname mainfont]
7752     set s $fontattr(textfont,size)
7753     incr s $inc
7754     if {$s < 1} {
7755         set s 1
7756     }
7757     set fontattr(textfont,size) $s
7758     font config textfont -size $s
7759     font config textfontbold -size $s
7760     set textfont [fontname textfont]
7761     setcoords
7762     settabs
7763     redisplay
7764 }
7765
7766 proc clearsha1 {} {
7767     global sha1entry sha1string
7768     if {[string length $sha1string] == 40} {
7769         $sha1entry delete 0 end
7770     }
7771 }
7772
7773 proc sha1change {n1 n2 op} {
7774     global sha1string currentid sha1but
7775     if {$sha1string == {}
7776         || ([info exists currentid] && $sha1string == $currentid)} {
7777         set state disabled
7778     } else {
7779         set state normal
7780     }
7781     if {[$sha1but cget -state] == $state} return
7782     if {$state == "normal"} {
7783         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
7784     } else {
7785         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
7786     }
7787 }
7788
7789 proc gotocommit {} {
7790     global sha1string tagids headids curview varcid
7791
7792     if {$sha1string == {}
7793         || ([info exists currentid] && $sha1string == $currentid)} return
7794     if {[info exists tagids($sha1string)]} {
7795         set id $tagids($sha1string)
7796     } elseif {[info exists headids($sha1string)]} {
7797         set id $headids($sha1string)
7798     } else {
7799         set id [string tolower $sha1string]
7800         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
7801             set matches [longid $id]
7802             if {$matches ne {}} {
7803                 if {[llength $matches] > 1} {
7804                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
7805                     return
7806                 }
7807                 set id [lindex $matches 0]
7808             }
7809         }
7810     }
7811     if {[commitinview $id $curview]} {
7812         selectline [rowofcommit $id] 1
7813         return
7814     }
7815     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
7816         set msg [mc "SHA1 id %s is not known" $sha1string]
7817     } else {
7818         set msg [mc "Tag/Head %s is not known" $sha1string]
7819     }
7820     error_popup $msg
7821 }
7822
7823 proc lineenter {x y id} {
7824     global hoverx hovery hoverid hovertimer
7825     global commitinfo canv
7826
7827     if {![info exists commitinfo($id)] && ![getcommit $id]} return
7828     set hoverx $x
7829     set hovery $y
7830     set hoverid $id
7831     if {[info exists hovertimer]} {
7832         after cancel $hovertimer
7833     }
7834     set hovertimer [after 500 linehover]
7835     $canv delete hover
7836 }
7837
7838 proc linemotion {x y id} {
7839     global hoverx hovery hoverid hovertimer
7840
7841     if {[info exists hoverid] && $id == $hoverid} {
7842         set hoverx $x
7843         set hovery $y
7844         if {[info exists hovertimer]} {
7845             after cancel $hovertimer
7846         }
7847         set hovertimer [after 500 linehover]
7848     }
7849 }
7850
7851 proc lineleave {id} {
7852     global hoverid hovertimer canv
7853
7854     if {[info exists hoverid] && $id == $hoverid} {
7855         $canv delete hover
7856         if {[info exists hovertimer]} {
7857             after cancel $hovertimer
7858             unset hovertimer
7859         }
7860         unset hoverid
7861     }
7862 }
7863
7864 proc linehover {} {
7865     global hoverx hovery hoverid hovertimer
7866     global canv linespc lthickness
7867     global commitinfo
7868
7869     set text [lindex $commitinfo($hoverid) 0]
7870     set ymax [lindex [$canv cget -scrollregion] 3]
7871     if {$ymax == {}} return
7872     set yfrac [lindex [$canv yview] 0]
7873     set x [expr {$hoverx + 2 * $linespc}]
7874     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
7875     set x0 [expr {$x - 2 * $lthickness}]
7876     set y0 [expr {$y - 2 * $lthickness}]
7877     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
7878     set y1 [expr {$y + $linespc + 2 * $lthickness}]
7879     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
7880                -fill \#ffff80 -outline black -width 1 -tags hover]
7881     $canv raise $t
7882     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
7883                -font mainfont]
7884     $canv raise $t
7885 }
7886
7887 proc clickisonarrow {id y} {
7888     global lthickness
7889
7890     set ranges [rowranges $id]
7891     set thresh [expr {2 * $lthickness + 6}]
7892     set n [expr {[llength $ranges] - 1}]
7893     for {set i 1} {$i < $n} {incr i} {
7894         set row [lindex $ranges $i]
7895         if {abs([yc $row] - $y) < $thresh} {
7896             return $i
7897         }
7898     }
7899     return {}
7900 }
7901
7902 proc arrowjump {id n y} {
7903     global canv
7904
7905     # 1 <-> 2, 3 <-> 4, etc...
7906     set n [expr {(($n - 1) ^ 1) + 1}]
7907     set row [lindex [rowranges $id] $n]
7908     set yt [yc $row]
7909     set ymax [lindex [$canv cget -scrollregion] 3]
7910     if {$ymax eq {} || $ymax <= 0} return
7911     set view [$canv yview]
7912     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
7913     set yfrac [expr {$yt / $ymax - $yspan / 2}]
7914     if {$yfrac < 0} {
7915         set yfrac 0
7916     }
7917     allcanvs yview moveto $yfrac
7918 }
7919
7920 proc lineclick {x y id isnew} {
7921     global ctext commitinfo children canv thickerline curview
7922
7923     if {![info exists commitinfo($id)] && ![getcommit $id]} return
7924     unmarkmatches
7925     unselectline
7926     normalline
7927     $canv delete hover
7928     # draw this line thicker than normal
7929     set thickerline $id
7930     drawlines $id
7931     if {$isnew} {
7932         set ymax [lindex [$canv cget -scrollregion] 3]
7933         if {$ymax eq {}} return
7934         set yfrac [lindex [$canv yview] 0]
7935         set y [expr {$y + $yfrac * $ymax}]
7936     }
7937     set dirn [clickisonarrow $id $y]
7938     if {$dirn ne {}} {
7939         arrowjump $id $dirn $y
7940         return
7941     }
7942
7943     if {$isnew} {
7944         addtohistory [list lineclick $x $y $id 0] savectextpos
7945     }
7946     # fill the details pane with info about this line
7947     $ctext conf -state normal
7948     clear_ctext
7949     settabs 0
7950     $ctext insert end "[mc "Parent"]:\t"
7951     $ctext insert end $id link0
7952     setlink $id link0
7953     set info $commitinfo($id)
7954     $ctext insert end "\n\t[lindex $info 0]\n"
7955     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
7956     set date [formatdate [lindex $info 2]]
7957     $ctext insert end "\t[mc "Date"]:\t$date\n"
7958     set kids $children($curview,$id)
7959     if {$kids ne {}} {
7960         $ctext insert end "\n[mc "Children"]:"
7961         set i 0
7962         foreach child $kids {
7963             incr i
7964             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
7965             set info $commitinfo($child)
7966             $ctext insert end "\n\t"
7967             $ctext insert end $child link$i
7968             setlink $child link$i
7969             $ctext insert end "\n\t[lindex $info 0]"
7970             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
7971             set date [formatdate [lindex $info 2]]
7972             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
7973         }
7974     }
7975     maybe_scroll_ctext 1
7976     $ctext conf -state disabled
7977     init_flist {}
7978 }
7979
7980 proc normalline {} {
7981     global thickerline
7982     if {[info exists thickerline]} {
7983         set id $thickerline
7984         unset thickerline
7985         drawlines $id
7986     }
7987 }
7988
7989 proc selbyid {id {isnew 1}} {
7990     global curview
7991     if {[commitinview $id $curview]} {
7992         selectline [rowofcommit $id] $isnew
7993     }
7994 }
7995
7996 proc mstime {} {
7997     global startmstime
7998     if {![info exists startmstime]} {
7999         set startmstime [clock clicks -milliseconds]
8000     }
8001     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8002 }
8003
8004 proc rowmenu {x y id} {
8005     global rowctxmenu selectedline rowmenuid curview
8006     global nullid nullid2 fakerowmenu mainhead
8007
8008     stopfinding
8009     set rowmenuid $id
8010     if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8011         set state disabled
8012     } else {
8013         set state normal
8014     }
8015     if {$id ne $nullid && $id ne $nullid2} {
8016         set menu $rowctxmenu
8017         if {$mainhead ne {}} {
8018             $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
8019         } else {
8020             $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8021         }
8022     } else {
8023         set menu $fakerowmenu
8024     }
8025     $menu entryconfigure [mca "Diff this -> selected"] -state $state
8026     $menu entryconfigure [mca "Diff selected -> this"] -state $state
8027     $menu entryconfigure [mca "Make patch"] -state $state
8028     tk_popup $menu $x $y
8029 }
8030
8031 proc diffvssel {dirn} {
8032     global rowmenuid selectedline
8033
8034     if {$selectedline eq {}} return
8035     if {$dirn} {
8036         set oldid [commitonrow $selectedline]
8037         set newid $rowmenuid
8038     } else {
8039         set oldid $rowmenuid
8040         set newid [commitonrow $selectedline]
8041     }
8042     addtohistory [list doseldiff $oldid $newid] savectextpos
8043     doseldiff $oldid $newid
8044 }
8045
8046 proc doseldiff {oldid newid} {
8047     global ctext
8048     global commitinfo
8049
8050     $ctext conf -state normal
8051     clear_ctext
8052     init_flist [mc "Top"]
8053     $ctext insert end "[mc "From"] "
8054     $ctext insert end $oldid link0
8055     setlink $oldid link0
8056     $ctext insert end "\n     "
8057     $ctext insert end [lindex $commitinfo($oldid) 0]
8058     $ctext insert end "\n\n[mc "To"]   "
8059     $ctext insert end $newid link1
8060     setlink $newid link1
8061     $ctext insert end "\n     "
8062     $ctext insert end [lindex $commitinfo($newid) 0]
8063     $ctext insert end "\n"
8064     $ctext conf -state disabled
8065     $ctext tag remove found 1.0 end
8066     startdiff [list $oldid $newid]
8067 }
8068
8069 proc mkpatch {} {
8070     global rowmenuid currentid commitinfo patchtop patchnum
8071
8072     if {![info exists currentid]} return
8073     set oldid $currentid
8074     set oldhead [lindex $commitinfo($oldid) 0]
8075     set newid $rowmenuid
8076     set newhead [lindex $commitinfo($newid) 0]
8077     set top .patch
8078     set patchtop $top
8079     catch {destroy $top}
8080     toplevel $top
8081     make_transient $top .
8082     label $top.title -text [mc "Generate patch"]
8083     grid $top.title - -pady 10
8084     label $top.from -text [mc "From:"]
8085     entry $top.fromsha1 -width 40 -relief flat
8086     $top.fromsha1 insert 0 $oldid
8087     $top.fromsha1 conf -state readonly
8088     grid $top.from $top.fromsha1 -sticky w
8089     entry $top.fromhead -width 60 -relief flat
8090     $top.fromhead insert 0 $oldhead
8091     $top.fromhead conf -state readonly
8092     grid x $top.fromhead -sticky w
8093     label $top.to -text [mc "To:"]
8094     entry $top.tosha1 -width 40 -relief flat
8095     $top.tosha1 insert 0 $newid
8096     $top.tosha1 conf -state readonly
8097     grid $top.to $top.tosha1 -sticky w
8098     entry $top.tohead -width 60 -relief flat
8099     $top.tohead insert 0 $newhead
8100     $top.tohead conf -state readonly
8101     grid x $top.tohead -sticky w
8102     button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
8103     grid $top.rev x -pady 10
8104     label $top.flab -text [mc "Output file:"]
8105     entry $top.fname -width 60
8106     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8107     incr patchnum
8108     grid $top.flab $top.fname -sticky w
8109     frame $top.buts
8110     button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8111     button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8112     bind $top <Key-Return> mkpatchgo
8113     bind $top <Key-Escape> mkpatchcan
8114     grid $top.buts.gen $top.buts.can
8115     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8116     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8117     grid $top.buts - -pady 10 -sticky ew
8118     focus $top.fname
8119 }
8120
8121 proc mkpatchrev {} {
8122     global patchtop
8123
8124     set oldid [$patchtop.fromsha1 get]
8125     set oldhead [$patchtop.fromhead get]
8126     set newid [$patchtop.tosha1 get]
8127     set newhead [$patchtop.tohead get]
8128     foreach e [list fromsha1 fromhead tosha1 tohead] \
8129             v [list $newid $newhead $oldid $oldhead] {
8130         $patchtop.$e conf -state normal
8131         $patchtop.$e delete 0 end
8132         $patchtop.$e insert 0 $v
8133         $patchtop.$e conf -state readonly
8134     }
8135 }
8136
8137 proc mkpatchgo {} {
8138     global patchtop nullid nullid2
8139
8140     set oldid [$patchtop.fromsha1 get]
8141     set newid [$patchtop.tosha1 get]
8142     set fname [$patchtop.fname get]
8143     set cmd [diffcmd [list $oldid $newid] -p]
8144     # trim off the initial "|"
8145     set cmd [lrange $cmd 1 end]
8146     lappend cmd >$fname &
8147     if {[catch {eval exec $cmd} err]} {
8148         error_popup "[mc "Error creating patch:"] $err" $patchtop
8149     }
8150     catch {destroy $patchtop}
8151     unset patchtop
8152 }
8153
8154 proc mkpatchcan {} {
8155     global patchtop
8156
8157     catch {destroy $patchtop}
8158     unset patchtop
8159 }
8160
8161 proc mktag {} {
8162     global rowmenuid mktagtop commitinfo
8163
8164     set top .maketag
8165     set mktagtop $top
8166     catch {destroy $top}
8167     toplevel $top
8168     make_transient $top .
8169     label $top.title -text [mc "Create tag"]
8170     grid $top.title - -pady 10
8171     label $top.id -text [mc "ID:"]
8172     entry $top.sha1 -width 40 -relief flat
8173     $top.sha1 insert 0 $rowmenuid
8174     $top.sha1 conf -state readonly
8175     grid $top.id $top.sha1 -sticky w
8176     entry $top.head -width 60 -relief flat
8177     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8178     $top.head conf -state readonly
8179     grid x $top.head -sticky w
8180     label $top.tlab -text [mc "Tag name:"]
8181     entry $top.tag -width 60
8182     grid $top.tlab $top.tag -sticky w
8183     frame $top.buts
8184     button $top.buts.gen -text [mc "Create"] -command mktaggo
8185     button $top.buts.can -text [mc "Cancel"] -command mktagcan
8186     bind $top <Key-Return> mktaggo
8187     bind $top <Key-Escape> mktagcan
8188     grid $top.buts.gen $top.buts.can
8189     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8190     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8191     grid $top.buts - -pady 10 -sticky ew
8192     focus $top.tag
8193 }
8194
8195 proc domktag {} {
8196     global mktagtop env tagids idtags
8197
8198     set id [$mktagtop.sha1 get]
8199     set tag [$mktagtop.tag get]
8200     if {$tag == {}} {
8201         error_popup [mc "No tag name specified"] $mktagtop
8202         return 0
8203     }
8204     if {[info exists tagids($tag)]} {
8205         error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8206         return 0
8207     }
8208     if {[catch {
8209         exec git tag $tag $id
8210     } err]} {
8211         error_popup "[mc "Error creating tag:"] $err" $mktagtop
8212         return 0
8213     }
8214
8215     set tagids($tag) $id
8216     lappend idtags($id) $tag
8217     redrawtags $id
8218     addedtag $id
8219     dispneartags 0
8220     run refill_reflist
8221     return 1
8222 }
8223
8224 proc redrawtags {id} {
8225     global canv linehtag idpos currentid curview cmitlisted
8226     global canvxmax iddrawn circleitem mainheadid circlecolors
8227
8228     if {![commitinview $id $curview]} return
8229     if {![info exists iddrawn($id)]} return
8230     set row [rowofcommit $id]
8231     if {$id eq $mainheadid} {
8232         set ofill yellow
8233     } else {
8234         set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8235     }
8236     $canv itemconf $circleitem($row) -fill $ofill
8237     $canv delete tag.$id
8238     set xt [eval drawtags $id $idpos($id)]
8239     $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8240     set text [$canv itemcget $linehtag($id) -text]
8241     set font [$canv itemcget $linehtag($id) -font]
8242     set xr [expr {$xt + [font measure $font $text]}]
8243     if {$xr > $canvxmax} {
8244         set canvxmax $xr
8245         setcanvscroll
8246     }
8247     if {[info exists currentid] && $currentid == $id} {
8248         make_secsel $id
8249     }
8250 }
8251
8252 proc mktagcan {} {
8253     global mktagtop
8254
8255     catch {destroy $mktagtop}
8256     unset mktagtop
8257 }
8258
8259 proc mktaggo {} {
8260     if {![domktag]} return
8261     mktagcan
8262 }
8263
8264 proc writecommit {} {
8265     global rowmenuid wrcomtop commitinfo wrcomcmd
8266
8267     set top .writecommit
8268     set wrcomtop $top
8269     catch {destroy $top}
8270     toplevel $top
8271     make_transient $top .
8272     label $top.title -text [mc "Write commit to file"]
8273     grid $top.title - -pady 10
8274     label $top.id -text [mc "ID:"]
8275     entry $top.sha1 -width 40 -relief flat
8276     $top.sha1 insert 0 $rowmenuid
8277     $top.sha1 conf -state readonly
8278     grid $top.id $top.sha1 -sticky w
8279     entry $top.head -width 60 -relief flat
8280     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8281     $top.head conf -state readonly
8282     grid x $top.head -sticky w
8283     label $top.clab -text [mc "Command:"]
8284     entry $top.cmd -width 60 -textvariable wrcomcmd
8285     grid $top.clab $top.cmd -sticky w -pady 10
8286     label $top.flab -text [mc "Output file:"]
8287     entry $top.fname -width 60
8288     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8289     grid $top.flab $top.fname -sticky w
8290     frame $top.buts
8291     button $top.buts.gen -text [mc "Write"] -command wrcomgo
8292     button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8293     bind $top <Key-Return> wrcomgo
8294     bind $top <Key-Escape> wrcomcan
8295     grid $top.buts.gen $top.buts.can
8296     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8297     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8298     grid $top.buts - -pady 10 -sticky ew
8299     focus $top.fname
8300 }
8301
8302 proc wrcomgo {} {
8303     global wrcomtop
8304
8305     set id [$wrcomtop.sha1 get]
8306     set cmd "echo $id | [$wrcomtop.cmd get]"
8307     set fname [$wrcomtop.fname get]
8308     if {[catch {exec sh -c $cmd >$fname &} err]} {
8309         error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8310     }
8311     catch {destroy $wrcomtop}
8312     unset wrcomtop
8313 }
8314
8315 proc wrcomcan {} {
8316     global wrcomtop
8317
8318     catch {destroy $wrcomtop}
8319     unset wrcomtop
8320 }
8321
8322 proc mkbranch {} {
8323     global rowmenuid mkbrtop
8324
8325     set top .makebranch
8326     catch {destroy $top}
8327     toplevel $top
8328     make_transient $top .
8329     label $top.title -text [mc "Create new branch"]
8330     grid $top.title - -pady 10
8331     label $top.id -text [mc "ID:"]
8332     entry $top.sha1 -width 40 -relief flat
8333     $top.sha1 insert 0 $rowmenuid
8334     $top.sha1 conf -state readonly
8335     grid $top.id $top.sha1 -sticky w
8336     label $top.nlab -text [mc "Name:"]
8337     entry $top.name -width 40
8338     grid $top.nlab $top.name -sticky w
8339     frame $top.buts
8340     button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
8341     button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
8342     bind $top <Key-Return> [list mkbrgo $top]
8343     bind $top <Key-Escape> "catch {destroy $top}"
8344     grid $top.buts.go $top.buts.can
8345     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8346     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8347     grid $top.buts - -pady 10 -sticky ew
8348     focus $top.name
8349 }
8350
8351 proc mkbrgo {top} {
8352     global headids idheads
8353
8354     set name [$top.name get]
8355     set id [$top.sha1 get]
8356     set cmdargs {}
8357     set old_id {}
8358     if {$name eq {}} {
8359         error_popup [mc "Please specify a name for the new branch"] $top
8360         return
8361     }
8362     if {[info exists headids($name)]} {
8363         if {![confirm_popup [mc \
8364                 "Branch '%s' already exists. Overwrite?" $name] $top]} {
8365             return
8366         }
8367         set old_id $headids($name)
8368         lappend cmdargs -f
8369     }
8370     catch {destroy $top}
8371     lappend cmdargs $name $id
8372     nowbusy newbranch
8373     update
8374     if {[catch {
8375         eval exec git branch $cmdargs
8376     } err]} {
8377         notbusy newbranch
8378         error_popup $err
8379     } else {
8380         notbusy newbranch
8381         if {$old_id ne {}} {
8382             movehead $id $name
8383             movedhead $id $name
8384             redrawtags $old_id
8385             redrawtags $id
8386         } else {
8387             set headids($name) $id
8388             lappend idheads($id) $name
8389             addedhead $id $name
8390             redrawtags $id
8391         }
8392         dispneartags 0
8393         run refill_reflist
8394     }
8395 }
8396
8397 proc exec_citool {tool_args {baseid {}}} {
8398     global commitinfo env
8399
8400     set save_env [array get env GIT_AUTHOR_*]
8401
8402     if {$baseid ne {}} {
8403         if {![info exists commitinfo($baseid)]} {
8404             getcommit $baseid
8405         }
8406         set author [lindex $commitinfo($baseid) 1]
8407         set date [lindex $commitinfo($baseid) 2]
8408         if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
8409                     $author author name email]
8410             && $date ne {}} {
8411             set env(GIT_AUTHOR_NAME) $name
8412             set env(GIT_AUTHOR_EMAIL) $email
8413             set env(GIT_AUTHOR_DATE) $date
8414         }
8415     }
8416
8417     eval exec git citool $tool_args &
8418
8419     array unset env GIT_AUTHOR_*
8420     array set env $save_env
8421 }
8422
8423 proc cherrypick {} {
8424     global rowmenuid curview
8425     global mainhead mainheadid
8426
8427     set oldhead [exec git rev-parse HEAD]
8428     set dheads [descheads $rowmenuid]
8429     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
8430         set ok [confirm_popup [mc "Commit %s is already\
8431                 included in branch %s -- really re-apply it?" \
8432                                    [string range $rowmenuid 0 7] $mainhead]]
8433         if {!$ok} return
8434     }
8435     nowbusy cherrypick [mc "Cherry-picking"]
8436     update
8437     # Unfortunately git-cherry-pick writes stuff to stderr even when
8438     # no error occurs, and exec takes that as an indication of error...
8439     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
8440         notbusy cherrypick
8441         if {[regexp -line \
8442                  {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
8443                  $err msg fname]} {
8444             error_popup [mc "Cherry-pick failed because of local changes\
8445                         to file '%s'.\nPlease commit, reset or stash\
8446                         your changes and try again." $fname]
8447         } elseif {[regexp -line \
8448                        {^(CONFLICT \(.*\):|Automatic cherry-pick failed)} \
8449                        $err]} {
8450             if {[confirm_popup [mc "Cherry-pick failed because of merge\
8451                         conflict.\nDo you wish to run git citool to\
8452                         resolve it?"]]} {
8453                 # Force citool to read MERGE_MSG
8454                 file delete [file join [gitdir] "GITGUI_MSG"]
8455                 exec_citool {} $rowmenuid
8456             }
8457         } else {
8458             error_popup $err
8459         }
8460         run updatecommits
8461         return
8462     }
8463     set newhead [exec git rev-parse HEAD]
8464     if {$newhead eq $oldhead} {
8465         notbusy cherrypick
8466         error_popup [mc "No changes committed"]
8467         return
8468     }
8469     addnewchild $newhead $oldhead
8470     if {[commitinview $oldhead $curview]} {
8471         # XXX this isn't right if we have a path limit...
8472         insertrow $newhead $oldhead $curview
8473         if {$mainhead ne {}} {
8474             movehead $newhead $mainhead
8475             movedhead $newhead $mainhead
8476         }
8477         set mainheadid $newhead
8478         redrawtags $oldhead
8479         redrawtags $newhead
8480         selbyid $newhead
8481     }
8482     notbusy cherrypick
8483 }
8484
8485 proc resethead {} {
8486     global mainhead rowmenuid confirm_ok resettype
8487
8488     set confirm_ok 0
8489     set w ".confirmreset"
8490     toplevel $w
8491     make_transient $w .
8492     wm title $w [mc "Confirm reset"]
8493     message $w.m -text \
8494         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
8495         -justify center -aspect 1000
8496     pack $w.m -side top -fill x -padx 20 -pady 20
8497     frame $w.f -relief sunken -border 2
8498     message $w.f.rt -text [mc "Reset type:"] -aspect 1000
8499     grid $w.f.rt -sticky w
8500     set resettype mixed
8501     radiobutton $w.f.soft -value soft -variable resettype -justify left \
8502         -text [mc "Soft: Leave working tree and index untouched"]
8503     grid $w.f.soft -sticky w
8504     radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
8505         -text [mc "Mixed: Leave working tree untouched, reset index"]
8506     grid $w.f.mixed -sticky w
8507     radiobutton $w.f.hard -value hard -variable resettype -justify left \
8508         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
8509     grid $w.f.hard -sticky w
8510     pack $w.f -side top -fill x
8511     button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
8512     pack $w.ok -side left -fill x -padx 20 -pady 20
8513     button $w.cancel -text [mc Cancel] -command "destroy $w"
8514     bind $w <Key-Escape> [list destroy $w]
8515     pack $w.cancel -side right -fill x -padx 20 -pady 20
8516     bind $w <Visibility> "grab $w; focus $w"
8517     tkwait window $w
8518     if {!$confirm_ok} return
8519     if {[catch {set fd [open \
8520             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
8521         error_popup $err
8522     } else {
8523         dohidelocalchanges
8524         filerun $fd [list readresetstat $fd]
8525         nowbusy reset [mc "Resetting"]
8526         selbyid $rowmenuid
8527     }
8528 }
8529
8530 proc readresetstat {fd} {
8531     global mainhead mainheadid showlocalchanges rprogcoord
8532
8533     if {[gets $fd line] >= 0} {
8534         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8535             set rprogcoord [expr {1.0 * $m / $n}]
8536             adjustprogress
8537         }
8538         return 1
8539     }
8540     set rprogcoord 0
8541     adjustprogress
8542     notbusy reset
8543     if {[catch {close $fd} err]} {
8544         error_popup $err
8545     }
8546     set oldhead $mainheadid
8547     set newhead [exec git rev-parse HEAD]
8548     if {$newhead ne $oldhead} {
8549         movehead $newhead $mainhead
8550         movedhead $newhead $mainhead
8551         set mainheadid $newhead
8552         redrawtags $oldhead
8553         redrawtags $newhead
8554     }
8555     if {$showlocalchanges} {
8556         doshowlocalchanges
8557     }
8558     return 0
8559 }
8560
8561 # context menu for a head
8562 proc headmenu {x y id head} {
8563     global headmenuid headmenuhead headctxmenu mainhead
8564
8565     stopfinding
8566     set headmenuid $id
8567     set headmenuhead $head
8568     set state normal
8569     if {$head eq $mainhead} {
8570         set state disabled
8571     }
8572     $headctxmenu entryconfigure 0 -state $state
8573     $headctxmenu entryconfigure 1 -state $state
8574     tk_popup $headctxmenu $x $y
8575 }
8576
8577 proc cobranch {} {
8578     global headmenuid headmenuhead headids
8579     global showlocalchanges
8580
8581     # check the tree is clean first??
8582     nowbusy checkout [mc "Checking out"]
8583     update
8584     dohidelocalchanges
8585     if {[catch {
8586         set fd [open [list | git checkout $headmenuhead 2>@1] r]
8587     } err]} {
8588         notbusy checkout
8589         error_popup $err
8590         if {$showlocalchanges} {
8591             dodiffindex
8592         }
8593     } else {
8594         filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
8595     }
8596 }
8597
8598 proc readcheckoutstat {fd newhead newheadid} {
8599     global mainhead mainheadid headids showlocalchanges progresscoords
8600     global viewmainheadid curview
8601
8602     if {[gets $fd line] >= 0} {
8603         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8604             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
8605             adjustprogress
8606         }
8607         return 1
8608     }
8609     set progresscoords {0 0}
8610     adjustprogress
8611     notbusy checkout
8612     if {[catch {close $fd} err]} {
8613         error_popup $err
8614     }
8615     set oldmainid $mainheadid
8616     set mainhead $newhead
8617     set mainheadid $newheadid
8618     set viewmainheadid($curview) $newheadid
8619     redrawtags $oldmainid
8620     redrawtags $newheadid
8621     selbyid $newheadid
8622     if {$showlocalchanges} {
8623         dodiffindex
8624     }
8625 }
8626
8627 proc rmbranch {} {
8628     global headmenuid headmenuhead mainhead
8629     global idheads
8630
8631     set head $headmenuhead
8632     set id $headmenuid
8633     # this check shouldn't be needed any more...
8634     if {$head eq $mainhead} {
8635         error_popup [mc "Cannot delete the currently checked-out branch"]
8636         return
8637     }
8638     set dheads [descheads $id]
8639     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
8640         # the stuff on this branch isn't on any other branch
8641         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
8642                         branch.\nReally delete branch %s?" $head $head]]} return
8643     }
8644     nowbusy rmbranch
8645     update
8646     if {[catch {exec git branch -D $head} err]} {
8647         notbusy rmbranch
8648         error_popup $err
8649         return
8650     }
8651     removehead $id $head
8652     removedhead $id $head
8653     redrawtags $id
8654     notbusy rmbranch
8655     dispneartags 0
8656     run refill_reflist
8657 }
8658
8659 # Display a list of tags and heads
8660 proc showrefs {} {
8661     global showrefstop bgcolor fgcolor selectbgcolor
8662     global bglist fglist reflistfilter reflist maincursor
8663
8664     set top .showrefs
8665     set showrefstop $top
8666     if {[winfo exists $top]} {
8667         raise $top
8668         refill_reflist
8669         return
8670     }
8671     toplevel $top
8672     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
8673     make_transient $top .
8674     text $top.list -background $bgcolor -foreground $fgcolor \
8675         -selectbackground $selectbgcolor -font mainfont \
8676         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
8677         -width 30 -height 20 -cursor $maincursor \
8678         -spacing1 1 -spacing3 1 -state disabled
8679     $top.list tag configure highlight -background $selectbgcolor
8680     lappend bglist $top.list
8681     lappend fglist $top.list
8682     scrollbar $top.ysb -command "$top.list yview" -orient vertical
8683     scrollbar $top.xsb -command "$top.list xview" -orient horizontal
8684     grid $top.list $top.ysb -sticky nsew
8685     grid $top.xsb x -sticky ew
8686     frame $top.f
8687     label $top.f.l -text "[mc "Filter"]: "
8688     entry $top.f.e -width 20 -textvariable reflistfilter
8689     set reflistfilter "*"
8690     trace add variable reflistfilter write reflistfilter_change
8691     pack $top.f.e -side right -fill x -expand 1
8692     pack $top.f.l -side left
8693     grid $top.f - -sticky ew -pady 2
8694     button $top.close -command [list destroy $top] -text [mc "Close"]
8695     bind $top <Key-Escape> [list destroy $top]
8696     grid $top.close -
8697     grid columnconfigure $top 0 -weight 1
8698     grid rowconfigure $top 0 -weight 1
8699     bind $top.list <1> {break}
8700     bind $top.list <B1-Motion> {break}
8701     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
8702     set reflist {}
8703     refill_reflist
8704 }
8705
8706 proc sel_reflist {w x y} {
8707     global showrefstop reflist headids tagids otherrefids
8708
8709     if {![winfo exists $showrefstop]} return
8710     set l [lindex [split [$w index "@$x,$y"] "."] 0]
8711     set ref [lindex $reflist [expr {$l-1}]]
8712     set n [lindex $ref 0]
8713     switch -- [lindex $ref 1] {
8714         "H" {selbyid $headids($n)}
8715         "T" {selbyid $tagids($n)}
8716         "o" {selbyid $otherrefids($n)}
8717     }
8718     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
8719 }
8720
8721 proc unsel_reflist {} {
8722     global showrefstop
8723
8724     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8725     $showrefstop.list tag remove highlight 0.0 end
8726 }
8727
8728 proc reflistfilter_change {n1 n2 op} {
8729     global reflistfilter
8730
8731     after cancel refill_reflist
8732     after 200 refill_reflist
8733 }
8734
8735 proc refill_reflist {} {
8736     global reflist reflistfilter showrefstop headids tagids otherrefids
8737     global curview
8738
8739     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8740     set refs {}
8741     foreach n [array names headids] {
8742         if {[string match $reflistfilter $n]} {
8743             if {[commitinview $headids($n) $curview]} {
8744                 lappend refs [list $n H]
8745             } else {
8746                 interestedin $headids($n) {run refill_reflist}
8747             }
8748         }
8749     }
8750     foreach n [array names tagids] {
8751         if {[string match $reflistfilter $n]} {
8752             if {[commitinview $tagids($n) $curview]} {
8753                 lappend refs [list $n T]
8754             } else {
8755                 interestedin $tagids($n) {run refill_reflist}
8756             }
8757         }
8758     }
8759     foreach n [array names otherrefids] {
8760         if {[string match $reflistfilter $n]} {
8761             if {[commitinview $otherrefids($n) $curview]} {
8762                 lappend refs [list $n o]
8763             } else {
8764                 interestedin $otherrefids($n) {run refill_reflist}
8765             }
8766         }
8767     }
8768     set refs [lsort -index 0 $refs]
8769     if {$refs eq $reflist} return
8770
8771     # Update the contents of $showrefstop.list according to the
8772     # differences between $reflist (old) and $refs (new)
8773     $showrefstop.list conf -state normal
8774     $showrefstop.list insert end "\n"
8775     set i 0
8776     set j 0
8777     while {$i < [llength $reflist] || $j < [llength $refs]} {
8778         if {$i < [llength $reflist]} {
8779             if {$j < [llength $refs]} {
8780                 set cmp [string compare [lindex $reflist $i 0] \
8781                              [lindex $refs $j 0]]
8782                 if {$cmp == 0} {
8783                     set cmp [string compare [lindex $reflist $i 1] \
8784                                  [lindex $refs $j 1]]
8785                 }
8786             } else {
8787                 set cmp -1
8788             }
8789         } else {
8790             set cmp 1
8791         }
8792         switch -- $cmp {
8793             -1 {
8794                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
8795                 incr i
8796             }
8797             0 {
8798                 incr i
8799                 incr j
8800             }
8801             1 {
8802                 set l [expr {$j + 1}]
8803                 $showrefstop.list image create $l.0 -align baseline \
8804                     -image reficon-[lindex $refs $j 1] -padx 2
8805                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
8806                 incr j
8807             }
8808         }
8809     }
8810     set reflist $refs
8811     # delete last newline
8812     $showrefstop.list delete end-2c end-1c
8813     $showrefstop.list conf -state disabled
8814 }
8815
8816 # Stuff for finding nearby tags
8817 proc getallcommits {} {
8818     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
8819     global idheads idtags idotherrefs allparents tagobjid
8820
8821     if {![info exists allcommits]} {
8822         set nextarc 0
8823         set allcommits 0
8824         set seeds {}
8825         set allcwait 0
8826         set cachedarcs 0
8827         set allccache [file join [gitdir] "gitk.cache"]
8828         if {![catch {
8829             set f [open $allccache r]
8830             set allcwait 1
8831             getcache $f
8832         }]} return
8833     }
8834
8835     if {$allcwait} {
8836         return
8837     }
8838     set cmd [list | git rev-list --parents]
8839     set allcupdate [expr {$seeds ne {}}]
8840     if {!$allcupdate} {
8841         set ids "--all"
8842     } else {
8843         set refs [concat [array names idheads] [array names idtags] \
8844                       [array names idotherrefs]]
8845         set ids {}
8846         set tagobjs {}
8847         foreach name [array names tagobjid] {
8848             lappend tagobjs $tagobjid($name)
8849         }
8850         foreach id [lsort -unique $refs] {
8851             if {![info exists allparents($id)] &&
8852                 [lsearch -exact $tagobjs $id] < 0} {
8853                 lappend ids $id
8854             }
8855         }
8856         if {$ids ne {}} {
8857             foreach id $seeds {
8858                 lappend ids "^$id"
8859             }
8860         }
8861     }
8862     if {$ids ne {}} {
8863         set fd [open [concat $cmd $ids] r]
8864         fconfigure $fd -blocking 0
8865         incr allcommits
8866         nowbusy allcommits
8867         filerun $fd [list getallclines $fd]
8868     } else {
8869         dispneartags 0
8870     }
8871 }
8872
8873 # Since most commits have 1 parent and 1 child, we group strings of
8874 # such commits into "arcs" joining branch/merge points (BMPs), which
8875 # are commits that either don't have 1 parent or don't have 1 child.
8876 #
8877 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
8878 # arcout(id) - outgoing arcs for BMP
8879 # arcids(a) - list of IDs on arc including end but not start
8880 # arcstart(a) - BMP ID at start of arc
8881 # arcend(a) - BMP ID at end of arc
8882 # growing(a) - arc a is still growing
8883 # arctags(a) - IDs out of arcids (excluding end) that have tags
8884 # archeads(a) - IDs out of arcids (excluding end) that have heads
8885 # The start of an arc is at the descendent end, so "incoming" means
8886 # coming from descendents, and "outgoing" means going towards ancestors.
8887
8888 proc getallclines {fd} {
8889     global allparents allchildren idtags idheads nextarc
8890     global arcnos arcids arctags arcout arcend arcstart archeads growing
8891     global seeds allcommits cachedarcs allcupdate
8892
8893     set nid 0
8894     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
8895         set id [lindex $line 0]
8896         if {[info exists allparents($id)]} {
8897             # seen it already
8898             continue
8899         }
8900         set cachedarcs 0
8901         set olds [lrange $line 1 end]
8902         set allparents($id) $olds
8903         if {![info exists allchildren($id)]} {
8904             set allchildren($id) {}
8905             set arcnos($id) {}
8906             lappend seeds $id
8907         } else {
8908             set a $arcnos($id)
8909             if {[llength $olds] == 1 && [llength $a] == 1} {
8910                 lappend arcids($a) $id
8911                 if {[info exists idtags($id)]} {
8912                     lappend arctags($a) $id
8913                 }
8914                 if {[info exists idheads($id)]} {
8915                     lappend archeads($a) $id
8916                 }
8917                 if {[info exists allparents($olds)]} {
8918                     # seen parent already
8919                     if {![info exists arcout($olds)]} {
8920                         splitarc $olds
8921                     }
8922                     lappend arcids($a) $olds
8923                     set arcend($a) $olds
8924                     unset growing($a)
8925                 }
8926                 lappend allchildren($olds) $id
8927                 lappend arcnos($olds) $a
8928                 continue
8929             }
8930         }
8931         foreach a $arcnos($id) {
8932             lappend arcids($a) $id
8933             set arcend($a) $id
8934             unset growing($a)
8935         }
8936
8937         set ao {}
8938         foreach p $olds {
8939             lappend allchildren($p) $id
8940             set a [incr nextarc]
8941             set arcstart($a) $id
8942             set archeads($a) {}
8943             set arctags($a) {}
8944             set archeads($a) {}
8945             set arcids($a) {}
8946             lappend ao $a
8947             set growing($a) 1
8948             if {[info exists allparents($p)]} {
8949                 # seen it already, may need to make a new branch
8950                 if {![info exists arcout($p)]} {
8951                     splitarc $p
8952                 }
8953                 lappend arcids($a) $p
8954                 set arcend($a) $p
8955                 unset growing($a)
8956             }
8957             lappend arcnos($p) $a
8958         }
8959         set arcout($id) $ao
8960     }
8961     if {$nid > 0} {
8962         global cached_dheads cached_dtags cached_atags
8963         catch {unset cached_dheads}
8964         catch {unset cached_dtags}
8965         catch {unset cached_atags}
8966     }
8967     if {![eof $fd]} {
8968         return [expr {$nid >= 1000? 2: 1}]
8969     }
8970     set cacheok 1
8971     if {[catch {
8972         fconfigure $fd -blocking 1
8973         close $fd
8974     } err]} {
8975         # got an error reading the list of commits
8976         # if we were updating, try rereading the whole thing again
8977         if {$allcupdate} {
8978             incr allcommits -1
8979             dropcache $err
8980             return
8981         }
8982         error_popup "[mc "Error reading commit topology information;\
8983                 branch and preceding/following tag information\
8984                 will be incomplete."]\n($err)"
8985         set cacheok 0
8986     }
8987     if {[incr allcommits -1] == 0} {
8988         notbusy allcommits
8989         if {$cacheok} {
8990             run savecache
8991         }
8992     }
8993     dispneartags 0
8994     return 0
8995 }
8996
8997 proc recalcarc {a} {
8998     global arctags archeads arcids idtags idheads
8999
9000     set at {}
9001     set ah {}
9002     foreach id [lrange $arcids($a) 0 end-1] {
9003         if {[info exists idtags($id)]} {
9004             lappend at $id
9005         }
9006         if {[info exists idheads($id)]} {
9007             lappend ah $id
9008         }
9009     }
9010     set arctags($a) $at
9011     set archeads($a) $ah
9012 }
9013
9014 proc splitarc {p} {
9015     global arcnos arcids nextarc arctags archeads idtags idheads
9016     global arcstart arcend arcout allparents growing
9017
9018     set a $arcnos($p)
9019     if {[llength $a] != 1} {
9020         puts "oops splitarc called but [llength $a] arcs already"
9021         return
9022     }
9023     set a [lindex $a 0]
9024     set i [lsearch -exact $arcids($a) $p]
9025     if {$i < 0} {
9026         puts "oops splitarc $p not in arc $a"
9027         return
9028     }
9029     set na [incr nextarc]
9030     if {[info exists arcend($a)]} {
9031         set arcend($na) $arcend($a)
9032     } else {
9033         set l [lindex $allparents([lindex $arcids($a) end]) 0]
9034         set j [lsearch -exact $arcnos($l) $a]
9035         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9036     }
9037     set tail [lrange $arcids($a) [expr {$i+1}] end]
9038     set arcids($a) [lrange $arcids($a) 0 $i]
9039     set arcend($a) $p
9040     set arcstart($na) $p
9041     set arcout($p) $na
9042     set arcids($na) $tail
9043     if {[info exists growing($a)]} {
9044         set growing($na) 1
9045         unset growing($a)
9046     }
9047
9048     foreach id $tail {
9049         if {[llength $arcnos($id)] == 1} {
9050             set arcnos($id) $na
9051         } else {
9052             set j [lsearch -exact $arcnos($id) $a]
9053             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
9054         }
9055     }
9056
9057     # reconstruct tags and heads lists
9058     if {$arctags($a) ne {} || $archeads($a) ne {}} {
9059         recalcarc $a
9060         recalcarc $na
9061     } else {
9062         set arctags($na) {}
9063         set archeads($na) {}
9064     }
9065 }
9066
9067 # Update things for a new commit added that is a child of one
9068 # existing commit.  Used when cherry-picking.
9069 proc addnewchild {id p} {
9070     global allparents allchildren idtags nextarc
9071     global arcnos arcids arctags arcout arcend arcstart archeads growing
9072     global seeds allcommits
9073
9074     if {![info exists allcommits] || ![info exists arcnos($p)]} return
9075     set allparents($id) [list $p]
9076     set allchildren($id) {}
9077     set arcnos($id) {}
9078     lappend seeds $id
9079     lappend allchildren($p) $id
9080     set a [incr nextarc]
9081     set arcstart($a) $id
9082     set archeads($a) {}
9083     set arctags($a) {}
9084     set arcids($a) [list $p]
9085     set arcend($a) $p
9086     if {![info exists arcout($p)]} {
9087         splitarc $p
9088     }
9089     lappend arcnos($p) $a
9090     set arcout($id) [list $a]
9091 }
9092
9093 # This implements a cache for the topology information.
9094 # The cache saves, for each arc, the start and end of the arc,
9095 # the ids on the arc, and the outgoing arcs from the end.
9096 proc readcache {f} {
9097     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9098     global idtags idheads allparents cachedarcs possible_seeds seeds growing
9099     global allcwait
9100
9101     set a $nextarc
9102     set lim $cachedarcs
9103     if {$lim - $a > 500} {
9104         set lim [expr {$a + 500}]
9105     }
9106     if {[catch {
9107         if {$a == $lim} {
9108             # finish reading the cache and setting up arctags, etc.
9109             set line [gets $f]
9110             if {$line ne "1"} {error "bad final version"}
9111             close $f
9112             foreach id [array names idtags] {
9113                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9114                     [llength $allparents($id)] == 1} {
9115                     set a [lindex $arcnos($id) 0]
9116                     if {$arctags($a) eq {}} {
9117                         recalcarc $a
9118                     }
9119                 }
9120             }
9121             foreach id [array names idheads] {
9122                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9123                     [llength $allparents($id)] == 1} {
9124                     set a [lindex $arcnos($id) 0]
9125                     if {$archeads($a) eq {}} {
9126                         recalcarc $a
9127                     }
9128                 }
9129             }
9130             foreach id [lsort -unique $possible_seeds] {
9131                 if {$arcnos($id) eq {}} {
9132                     lappend seeds $id
9133                 }
9134             }
9135             set allcwait 0
9136         } else {
9137             while {[incr a] <= $lim} {
9138                 set line [gets $f]
9139                 if {[llength $line] != 3} {error "bad line"}
9140                 set s [lindex $line 0]
9141                 set arcstart($a) $s
9142                 lappend arcout($s) $a
9143                 if {![info exists arcnos($s)]} {
9144                     lappend possible_seeds $s
9145                     set arcnos($s) {}
9146                 }
9147                 set e [lindex $line 1]
9148                 if {$e eq {}} {
9149                     set growing($a) 1
9150                 } else {
9151                     set arcend($a) $e
9152                     if {![info exists arcout($e)]} {
9153                         set arcout($e) {}
9154                     }
9155                 }
9156                 set arcids($a) [lindex $line 2]
9157                 foreach id $arcids($a) {
9158                     lappend allparents($s) $id
9159                     set s $id
9160                     lappend arcnos($id) $a
9161                 }
9162                 if {![info exists allparents($s)]} {
9163                     set allparents($s) {}
9164                 }
9165                 set arctags($a) {}
9166                 set archeads($a) {}
9167             }
9168             set nextarc [expr {$a - 1}]
9169         }
9170     } err]} {
9171         dropcache $err
9172         return 0
9173     }
9174     if {!$allcwait} {
9175         getallcommits
9176     }
9177     return $allcwait
9178 }
9179
9180 proc getcache {f} {
9181     global nextarc cachedarcs possible_seeds
9182
9183     if {[catch {
9184         set line [gets $f]
9185         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9186         # make sure it's an integer
9187         set cachedarcs [expr {int([lindex $line 1])}]
9188         if {$cachedarcs < 0} {error "bad number of arcs"}
9189         set nextarc 0
9190         set possible_seeds {}
9191         run readcache $f
9192     } err]} {
9193         dropcache $err
9194     }
9195     return 0
9196 }
9197
9198 proc dropcache {err} {
9199     global allcwait nextarc cachedarcs seeds
9200
9201     #puts "dropping cache ($err)"
9202     foreach v {arcnos arcout arcids arcstart arcend growing \
9203                    arctags archeads allparents allchildren} {
9204         global $v
9205         catch {unset $v}
9206     }
9207     set allcwait 0
9208     set nextarc 0
9209     set cachedarcs 0
9210     set seeds {}
9211     getallcommits
9212 }
9213
9214 proc writecache {f} {
9215     global cachearc cachedarcs allccache
9216     global arcstart arcend arcnos arcids arcout
9217
9218     set a $cachearc
9219     set lim $cachedarcs
9220     if {$lim - $a > 1000} {
9221         set lim [expr {$a + 1000}]
9222     }
9223     if {[catch {
9224         while {[incr a] <= $lim} {
9225             if {[info exists arcend($a)]} {
9226                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9227             } else {
9228                 puts $f [list $arcstart($a) {} $arcids($a)]
9229             }
9230         }
9231     } err]} {
9232         catch {close $f}
9233         catch {file delete $allccache}
9234         #puts "writing cache failed ($err)"
9235         return 0
9236     }
9237     set cachearc [expr {$a - 1}]
9238     if {$a > $cachedarcs} {
9239         puts $f "1"
9240         close $f
9241         return 0
9242     }
9243     return 1
9244 }
9245
9246 proc savecache {} {
9247     global nextarc cachedarcs cachearc allccache
9248
9249     if {$nextarc == $cachedarcs} return
9250     set cachearc 0
9251     set cachedarcs $nextarc
9252     catch {
9253         set f [open $allccache w]
9254         puts $f [list 1 $cachedarcs]
9255         run writecache $f
9256     }
9257 }
9258
9259 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9260 # or 0 if neither is true.
9261 proc anc_or_desc {a b} {
9262     global arcout arcstart arcend arcnos cached_isanc
9263
9264     if {$arcnos($a) eq $arcnos($b)} {
9265         # Both are on the same arc(s); either both are the same BMP,
9266         # or if one is not a BMP, the other is also not a BMP or is
9267         # the BMP at end of the arc (and it only has 1 incoming arc).
9268         # Or both can be BMPs with no incoming arcs.
9269         if {$a eq $b || $arcnos($a) eq {}} {
9270             return 0
9271         }
9272         # assert {[llength $arcnos($a)] == 1}
9273         set arc [lindex $arcnos($a) 0]
9274         set i [lsearch -exact $arcids($arc) $a]
9275         set j [lsearch -exact $arcids($arc) $b]
9276         if {$i < 0 || $i > $j} {
9277             return 1
9278         } else {
9279             return -1
9280         }
9281     }
9282
9283     if {![info exists arcout($a)]} {
9284         set arc [lindex $arcnos($a) 0]
9285         if {[info exists arcend($arc)]} {
9286             set aend $arcend($arc)
9287         } else {
9288             set aend {}
9289         }
9290         set a $arcstart($arc)
9291     } else {
9292         set aend $a
9293     }
9294     if {![info exists arcout($b)]} {
9295         set arc [lindex $arcnos($b) 0]
9296         if {[info exists arcend($arc)]} {
9297             set bend $arcend($arc)
9298         } else {
9299             set bend {}
9300         }
9301         set b $arcstart($arc)
9302     } else {
9303         set bend $b
9304     }
9305     if {$a eq $bend} {
9306         return 1
9307     }
9308     if {$b eq $aend} {
9309         return -1
9310     }
9311     if {[info exists cached_isanc($a,$bend)]} {
9312         if {$cached_isanc($a,$bend)} {
9313             return 1
9314         }
9315     }
9316     if {[info exists cached_isanc($b,$aend)]} {
9317         if {$cached_isanc($b,$aend)} {
9318             return -1
9319         }
9320         if {[info exists cached_isanc($a,$bend)]} {
9321             return 0
9322         }
9323     }
9324
9325     set todo [list $a $b]
9326     set anc($a) a
9327     set anc($b) b
9328     for {set i 0} {$i < [llength $todo]} {incr i} {
9329         set x [lindex $todo $i]
9330         if {$anc($x) eq {}} {
9331             continue
9332         }
9333         foreach arc $arcnos($x) {
9334             set xd $arcstart($arc)
9335             if {$xd eq $bend} {
9336                 set cached_isanc($a,$bend) 1
9337                 set cached_isanc($b,$aend) 0
9338                 return 1
9339             } elseif {$xd eq $aend} {
9340                 set cached_isanc($b,$aend) 1
9341                 set cached_isanc($a,$bend) 0
9342                 return -1
9343             }
9344             if {![info exists anc($xd)]} {
9345                 set anc($xd) $anc($x)
9346                 lappend todo $xd
9347             } elseif {$anc($xd) ne $anc($x)} {
9348                 set anc($xd) {}
9349             }
9350         }
9351     }
9352     set cached_isanc($a,$bend) 0
9353     set cached_isanc($b,$aend) 0
9354     return 0
9355 }
9356
9357 # This identifies whether $desc has an ancestor that is
9358 # a growing tip of the graph and which is not an ancestor of $anc
9359 # and returns 0 if so and 1 if not.
9360 # If we subsequently discover a tag on such a growing tip, and that
9361 # turns out to be a descendent of $anc (which it could, since we
9362 # don't necessarily see children before parents), then $desc
9363 # isn't a good choice to display as a descendent tag of
9364 # $anc (since it is the descendent of another tag which is
9365 # a descendent of $anc).  Similarly, $anc isn't a good choice to
9366 # display as a ancestor tag of $desc.
9367 #
9368 proc is_certain {desc anc} {
9369     global arcnos arcout arcstart arcend growing problems
9370
9371     set certain {}
9372     if {[llength $arcnos($anc)] == 1} {
9373         # tags on the same arc are certain
9374         if {$arcnos($desc) eq $arcnos($anc)} {
9375             return 1
9376         }
9377         if {![info exists arcout($anc)]} {
9378             # if $anc is partway along an arc, use the start of the arc instead
9379             set a [lindex $arcnos($anc) 0]
9380             set anc $arcstart($a)
9381         }
9382     }
9383     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
9384         set x $desc
9385     } else {
9386         set a [lindex $arcnos($desc) 0]
9387         set x $arcend($a)
9388     }
9389     if {$x == $anc} {
9390         return 1
9391     }
9392     set anclist [list $x]
9393     set dl($x) 1
9394     set nnh 1
9395     set ngrowanc 0
9396     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
9397         set x [lindex $anclist $i]
9398         if {$dl($x)} {
9399             incr nnh -1
9400         }
9401         set done($x) 1
9402         foreach a $arcout($x) {
9403             if {[info exists growing($a)]} {
9404                 if {![info exists growanc($x)] && $dl($x)} {
9405                     set growanc($x) 1
9406                     incr ngrowanc
9407                 }
9408             } else {
9409                 set y $arcend($a)
9410                 if {[info exists dl($y)]} {
9411                     if {$dl($y)} {
9412                         if {!$dl($x)} {
9413                             set dl($y) 0
9414                             if {![info exists done($y)]} {
9415                                 incr nnh -1
9416                             }
9417                             if {[info exists growanc($x)]} {
9418                                 incr ngrowanc -1
9419                             }
9420                             set xl [list $y]
9421                             for {set k 0} {$k < [llength $xl]} {incr k} {
9422                                 set z [lindex $xl $k]
9423                                 foreach c $arcout($z) {
9424                                     if {[info exists arcend($c)]} {
9425                                         set v $arcend($c)
9426                                         if {[info exists dl($v)] && $dl($v)} {
9427                                             set dl($v) 0
9428                                             if {![info exists done($v)]} {
9429                                                 incr nnh -1
9430                                             }
9431                                             if {[info exists growanc($v)]} {
9432                                                 incr ngrowanc -1
9433                                             }
9434                                             lappend xl $v
9435                                         }
9436                                     }
9437                                 }
9438                             }
9439                         }
9440                     }
9441                 } elseif {$y eq $anc || !$dl($x)} {
9442                     set dl($y) 0
9443                     lappend anclist $y
9444                 } else {
9445                     set dl($y) 1
9446                     lappend anclist $y
9447                     incr nnh
9448                 }
9449             }
9450         }
9451     }
9452     foreach x [array names growanc] {
9453         if {$dl($x)} {
9454             return 0
9455         }
9456         return 0
9457     }
9458     return 1
9459 }
9460
9461 proc validate_arctags {a} {
9462     global arctags idtags
9463
9464     set i -1
9465     set na $arctags($a)
9466     foreach id $arctags($a) {
9467         incr i
9468         if {![info exists idtags($id)]} {
9469             set na [lreplace $na $i $i]
9470             incr i -1
9471         }
9472     }
9473     set arctags($a) $na
9474 }
9475
9476 proc validate_archeads {a} {
9477     global archeads idheads
9478
9479     set i -1
9480     set na $archeads($a)
9481     foreach id $archeads($a) {
9482         incr i
9483         if {![info exists idheads($id)]} {
9484             set na [lreplace $na $i $i]
9485             incr i -1
9486         }
9487     }
9488     set archeads($a) $na
9489 }
9490
9491 # Return the list of IDs that have tags that are descendents of id,
9492 # ignoring IDs that are descendents of IDs already reported.
9493 proc desctags {id} {
9494     global arcnos arcstart arcids arctags idtags allparents
9495     global growing cached_dtags
9496
9497     if {![info exists allparents($id)]} {
9498         return {}
9499     }
9500     set t1 [clock clicks -milliseconds]
9501     set argid $id
9502     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9503         # part-way along an arc; check that arc first
9504         set a [lindex $arcnos($id) 0]
9505         if {$arctags($a) ne {}} {
9506             validate_arctags $a
9507             set i [lsearch -exact $arcids($a) $id]
9508             set tid {}
9509             foreach t $arctags($a) {
9510                 set j [lsearch -exact $arcids($a) $t]
9511                 if {$j >= $i} break
9512                 set tid $t
9513             }
9514             if {$tid ne {}} {
9515                 return $tid
9516             }
9517         }
9518         set id $arcstart($a)
9519         if {[info exists idtags($id)]} {
9520             return $id
9521         }
9522     }
9523     if {[info exists cached_dtags($id)]} {
9524         return $cached_dtags($id)
9525     }
9526
9527     set origid $id
9528     set todo [list $id]
9529     set queued($id) 1
9530     set nc 1
9531     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9532         set id [lindex $todo $i]
9533         set done($id) 1
9534         set ta [info exists hastaggedancestor($id)]
9535         if {!$ta} {
9536             incr nc -1
9537         }
9538         # ignore tags on starting node
9539         if {!$ta && $i > 0} {
9540             if {[info exists idtags($id)]} {
9541                 set tagloc($id) $id
9542                 set ta 1
9543             } elseif {[info exists cached_dtags($id)]} {
9544                 set tagloc($id) $cached_dtags($id)
9545                 set ta 1
9546             }
9547         }
9548         foreach a $arcnos($id) {
9549             set d $arcstart($a)
9550             if {!$ta && $arctags($a) ne {}} {
9551                 validate_arctags $a
9552                 if {$arctags($a) ne {}} {
9553                     lappend tagloc($id) [lindex $arctags($a) end]
9554                 }
9555             }
9556             if {$ta || $arctags($a) ne {}} {
9557                 set tomark [list $d]
9558                 for {set j 0} {$j < [llength $tomark]} {incr j} {
9559                     set dd [lindex $tomark $j]
9560                     if {![info exists hastaggedancestor($dd)]} {
9561                         if {[info exists done($dd)]} {
9562                             foreach b $arcnos($dd) {
9563                                 lappend tomark $arcstart($b)
9564                             }
9565                             if {[info exists tagloc($dd)]} {
9566                                 unset tagloc($dd)
9567                             }
9568                         } elseif {[info exists queued($dd)]} {
9569                             incr nc -1
9570                         }
9571                         set hastaggedancestor($dd) 1
9572                     }
9573                 }
9574             }
9575             if {![info exists queued($d)]} {
9576                 lappend todo $d
9577                 set queued($d) 1
9578                 if {![info exists hastaggedancestor($d)]} {
9579                     incr nc
9580                 }
9581             }
9582         }
9583     }
9584     set tags {}
9585     foreach id [array names tagloc] {
9586         if {![info exists hastaggedancestor($id)]} {
9587             foreach t $tagloc($id) {
9588                 if {[lsearch -exact $tags $t] < 0} {
9589                     lappend tags $t
9590                 }
9591             }
9592         }
9593     }
9594     set t2 [clock clicks -milliseconds]
9595     set loopix $i
9596
9597     # remove tags that are descendents of other tags
9598     for {set i 0} {$i < [llength $tags]} {incr i} {
9599         set a [lindex $tags $i]
9600         for {set j 0} {$j < $i} {incr j} {
9601             set b [lindex $tags $j]
9602             set r [anc_or_desc $a $b]
9603             if {$r == 1} {
9604                 set tags [lreplace $tags $j $j]
9605                 incr j -1
9606                 incr i -1
9607             } elseif {$r == -1} {
9608                 set tags [lreplace $tags $i $i]
9609                 incr i -1
9610                 break
9611             }
9612         }
9613     }
9614
9615     if {[array names growing] ne {}} {
9616         # graph isn't finished, need to check if any tag could get
9617         # eclipsed by another tag coming later.  Simply ignore any
9618         # tags that could later get eclipsed.
9619         set ctags {}
9620         foreach t $tags {
9621             if {[is_certain $t $origid]} {
9622                 lappend ctags $t
9623             }
9624         }
9625         if {$tags eq $ctags} {
9626             set cached_dtags($origid) $tags
9627         } else {
9628             set tags $ctags
9629         }
9630     } else {
9631         set cached_dtags($origid) $tags
9632     }
9633     set t3 [clock clicks -milliseconds]
9634     if {0 && $t3 - $t1 >= 100} {
9635         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
9636             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9637     }
9638     return $tags
9639 }
9640
9641 proc anctags {id} {
9642     global arcnos arcids arcout arcend arctags idtags allparents
9643     global growing cached_atags
9644
9645     if {![info exists allparents($id)]} {
9646         return {}
9647     }
9648     set t1 [clock clicks -milliseconds]
9649     set argid $id
9650     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9651         # part-way along an arc; check that arc first
9652         set a [lindex $arcnos($id) 0]
9653         if {$arctags($a) ne {}} {
9654             validate_arctags $a
9655             set i [lsearch -exact $arcids($a) $id]
9656             foreach t $arctags($a) {
9657                 set j [lsearch -exact $arcids($a) $t]
9658                 if {$j > $i} {
9659                     return $t
9660                 }
9661             }
9662         }
9663         if {![info exists arcend($a)]} {
9664             return {}
9665         }
9666         set id $arcend($a)
9667         if {[info exists idtags($id)]} {
9668             return $id
9669         }
9670     }
9671     if {[info exists cached_atags($id)]} {
9672         return $cached_atags($id)
9673     }
9674
9675     set origid $id
9676     set todo [list $id]
9677     set queued($id) 1
9678     set taglist {}
9679     set nc 1
9680     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9681         set id [lindex $todo $i]
9682         set done($id) 1
9683         set td [info exists hastaggeddescendent($id)]
9684         if {!$td} {
9685             incr nc -1
9686         }
9687         # ignore tags on starting node
9688         if {!$td && $i > 0} {
9689             if {[info exists idtags($id)]} {
9690                 set tagloc($id) $id
9691                 set td 1
9692             } elseif {[info exists cached_atags($id)]} {
9693                 set tagloc($id) $cached_atags($id)
9694                 set td 1
9695             }
9696         }
9697         foreach a $arcout($id) {
9698             if {!$td && $arctags($a) ne {}} {
9699                 validate_arctags $a
9700                 if {$arctags($a) ne {}} {
9701                     lappend tagloc($id) [lindex $arctags($a) 0]
9702                 }
9703             }
9704             if {![info exists arcend($a)]} continue
9705             set d $arcend($a)
9706             if {$td || $arctags($a) ne {}} {
9707                 set tomark [list $d]
9708                 for {set j 0} {$j < [llength $tomark]} {incr j} {
9709                     set dd [lindex $tomark $j]
9710                     if {![info exists hastaggeddescendent($dd)]} {
9711                         if {[info exists done($dd)]} {
9712                             foreach b $arcout($dd) {
9713                                 if {[info exists arcend($b)]} {
9714                                     lappend tomark $arcend($b)
9715                                 }
9716                             }
9717                             if {[info exists tagloc($dd)]} {
9718                                 unset tagloc($dd)
9719                             }
9720                         } elseif {[info exists queued($dd)]} {
9721                             incr nc -1
9722                         }
9723                         set hastaggeddescendent($dd) 1
9724                     }
9725                 }
9726             }
9727             if {![info exists queued($d)]} {
9728                 lappend todo $d
9729                 set queued($d) 1
9730                 if {![info exists hastaggeddescendent($d)]} {
9731                     incr nc
9732                 }
9733             }
9734         }
9735     }
9736     set t2 [clock clicks -milliseconds]
9737     set loopix $i
9738     set tags {}
9739     foreach id [array names tagloc] {
9740         if {![info exists hastaggeddescendent($id)]} {
9741             foreach t $tagloc($id) {
9742                 if {[lsearch -exact $tags $t] < 0} {
9743                     lappend tags $t
9744                 }
9745             }
9746         }
9747     }
9748
9749     # remove tags that are ancestors of other tags
9750     for {set i 0} {$i < [llength $tags]} {incr i} {
9751         set a [lindex $tags $i]
9752         for {set j 0} {$j < $i} {incr j} {
9753             set b [lindex $tags $j]
9754             set r [anc_or_desc $a $b]
9755             if {$r == -1} {
9756                 set tags [lreplace $tags $j $j]
9757                 incr j -1
9758                 incr i -1
9759             } elseif {$r == 1} {
9760                 set tags [lreplace $tags $i $i]
9761                 incr i -1
9762                 break
9763             }
9764         }
9765     }
9766
9767     if {[array names growing] ne {}} {
9768         # graph isn't finished, need to check if any tag could get
9769         # eclipsed by another tag coming later.  Simply ignore any
9770         # tags that could later get eclipsed.
9771         set ctags {}
9772         foreach t $tags {
9773             if {[is_certain $origid $t]} {
9774                 lappend ctags $t
9775             }
9776         }
9777         if {$tags eq $ctags} {
9778             set cached_atags($origid) $tags
9779         } else {
9780             set tags $ctags
9781         }
9782     } else {
9783         set cached_atags($origid) $tags
9784     }
9785     set t3 [clock clicks -milliseconds]
9786     if {0 && $t3 - $t1 >= 100} {
9787         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
9788             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9789     }
9790     return $tags
9791 }
9792
9793 # Return the list of IDs that have heads that are descendents of id,
9794 # including id itself if it has a head.
9795 proc descheads {id} {
9796     global arcnos arcstart arcids archeads idheads cached_dheads
9797     global allparents
9798
9799     if {![info exists allparents($id)]} {
9800         return {}
9801     }
9802     set aret {}
9803     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9804         # part-way along an arc; check it first
9805         set a [lindex $arcnos($id) 0]
9806         if {$archeads($a) ne {}} {
9807             validate_archeads $a
9808             set i [lsearch -exact $arcids($a) $id]
9809             foreach t $archeads($a) {
9810                 set j [lsearch -exact $arcids($a) $t]
9811                 if {$j > $i} break
9812                 lappend aret $t
9813             }
9814         }
9815         set id $arcstart($a)
9816     }
9817     set origid $id
9818     set todo [list $id]
9819     set seen($id) 1
9820     set ret {}
9821     for {set i 0} {$i < [llength $todo]} {incr i} {
9822         set id [lindex $todo $i]
9823         if {[info exists cached_dheads($id)]} {
9824             set ret [concat $ret $cached_dheads($id)]
9825         } else {
9826             if {[info exists idheads($id)]} {
9827                 lappend ret $id
9828             }
9829             foreach a $arcnos($id) {
9830                 if {$archeads($a) ne {}} {
9831                     validate_archeads $a
9832                     if {$archeads($a) ne {}} {
9833                         set ret [concat $ret $archeads($a)]
9834                     }
9835                 }
9836                 set d $arcstart($a)
9837                 if {![info exists seen($d)]} {
9838                     lappend todo $d
9839                     set seen($d) 1
9840                 }
9841             }
9842         }
9843     }
9844     set ret [lsort -unique $ret]
9845     set cached_dheads($origid) $ret
9846     return [concat $ret $aret]
9847 }
9848
9849 proc addedtag {id} {
9850     global arcnos arcout cached_dtags cached_atags
9851
9852     if {![info exists arcnos($id)]} return
9853     if {![info exists arcout($id)]} {
9854         recalcarc [lindex $arcnos($id) 0]
9855     }
9856     catch {unset cached_dtags}
9857     catch {unset cached_atags}
9858 }
9859
9860 proc addedhead {hid head} {
9861     global arcnos arcout cached_dheads
9862
9863     if {![info exists arcnos($hid)]} return
9864     if {![info exists arcout($hid)]} {
9865         recalcarc [lindex $arcnos($hid) 0]
9866     }
9867     catch {unset cached_dheads}
9868 }
9869
9870 proc removedhead {hid head} {
9871     global cached_dheads
9872
9873     catch {unset cached_dheads}
9874 }
9875
9876 proc movedhead {hid head} {
9877     global arcnos arcout cached_dheads
9878
9879     if {![info exists arcnos($hid)]} return
9880     if {![info exists arcout($hid)]} {
9881         recalcarc [lindex $arcnos($hid) 0]
9882     }
9883     catch {unset cached_dheads}
9884 }
9885
9886 proc changedrefs {} {
9887     global cached_dheads cached_dtags cached_atags
9888     global arctags archeads arcnos arcout idheads idtags
9889
9890     foreach id [concat [array names idheads] [array names idtags]] {
9891         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
9892             set a [lindex $arcnos($id) 0]
9893             if {![info exists donearc($a)]} {
9894                 recalcarc $a
9895                 set donearc($a) 1
9896             }
9897         }
9898     }
9899     catch {unset cached_dtags}
9900     catch {unset cached_atags}
9901     catch {unset cached_dheads}
9902 }
9903
9904 proc rereadrefs {} {
9905     global idtags idheads idotherrefs mainheadid
9906
9907     set refids [concat [array names idtags] \
9908                     [array names idheads] [array names idotherrefs]]
9909     foreach id $refids {
9910         if {![info exists ref($id)]} {
9911             set ref($id) [listrefs $id]
9912         }
9913     }
9914     set oldmainhead $mainheadid
9915     readrefs
9916     changedrefs
9917     set refids [lsort -unique [concat $refids [array names idtags] \
9918                         [array names idheads] [array names idotherrefs]]]
9919     foreach id $refids {
9920         set v [listrefs $id]
9921         if {![info exists ref($id)] || $ref($id) != $v} {
9922             redrawtags $id
9923         }
9924     }
9925     if {$oldmainhead ne $mainheadid} {
9926         redrawtags $oldmainhead
9927         redrawtags $mainheadid
9928     }
9929     run refill_reflist
9930 }
9931
9932 proc listrefs {id} {
9933     global idtags idheads idotherrefs
9934
9935     set x {}
9936     if {[info exists idtags($id)]} {
9937         set x $idtags($id)
9938     }
9939     set y {}
9940     if {[info exists idheads($id)]} {
9941         set y $idheads($id)
9942     }
9943     set z {}
9944     if {[info exists idotherrefs($id)]} {
9945         set z $idotherrefs($id)
9946     }
9947     return [list $x $y $z]
9948 }
9949
9950 proc showtag {tag isnew} {
9951     global ctext tagcontents tagids linknum tagobjid
9952
9953     if {$isnew} {
9954         addtohistory [list showtag $tag 0] savectextpos
9955     }
9956     $ctext conf -state normal
9957     clear_ctext
9958     settabs 0
9959     set linknum 0
9960     if {![info exists tagcontents($tag)]} {
9961         catch {
9962             set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
9963         }
9964     }
9965     if {[info exists tagcontents($tag)]} {
9966         set text $tagcontents($tag)
9967     } else {
9968         set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
9969     }
9970     appendwithlinks $text {}
9971     maybe_scroll_ctext
9972     $ctext conf -state disabled
9973     init_flist {}
9974 }
9975
9976 proc doquit {} {
9977     global stopped
9978     global gitktmpdir
9979
9980     set stopped 100
9981     savestuff .
9982     destroy .
9983
9984     if {[info exists gitktmpdir]} {
9985         catch {file delete -force $gitktmpdir}
9986     }
9987 }
9988
9989 proc mkfontdisp {font top which} {
9990     global fontattr fontpref $font
9991
9992     set fontpref($font) [set $font]
9993     button $top.${font}but -text $which -font optionfont \
9994         -command [list choosefont $font $which]
9995     label $top.$font -relief flat -font $font \
9996         -text $fontattr($font,family) -justify left
9997     grid x $top.${font}but $top.$font -sticky w
9998 }
9999
10000 proc choosefont {font which} {
10001     global fontparam fontlist fonttop fontattr
10002     global prefstop
10003
10004     set fontparam(which) $which
10005     set fontparam(font) $font
10006     set fontparam(family) [font actual $font -family]
10007     set fontparam(size) $fontattr($font,size)
10008     set fontparam(weight) $fontattr($font,weight)
10009     set fontparam(slant) $fontattr($font,slant)
10010     set top .gitkfont
10011     set fonttop $top
10012     if {![winfo exists $top]} {
10013         font create sample
10014         eval font config sample [font actual $font]
10015         toplevel $top
10016         make_transient $top $prefstop
10017         wm title $top [mc "Gitk font chooser"]
10018         label $top.l -textvariable fontparam(which)
10019         pack $top.l -side top
10020         set fontlist [lsort [font families]]
10021         frame $top.f
10022         listbox $top.f.fam -listvariable fontlist \
10023             -yscrollcommand [list $top.f.sb set]
10024         bind $top.f.fam <<ListboxSelect>> selfontfam
10025         scrollbar $top.f.sb -command [list $top.f.fam yview]
10026         pack $top.f.sb -side right -fill y
10027         pack $top.f.fam -side left -fill both -expand 1
10028         pack $top.f -side top -fill both -expand 1
10029         frame $top.g
10030         spinbox $top.g.size -from 4 -to 40 -width 4 \
10031             -textvariable fontparam(size) \
10032             -validatecommand {string is integer -strict %s}
10033         checkbutton $top.g.bold -padx 5 \
10034             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
10035             -variable fontparam(weight) -onvalue bold -offvalue normal
10036         checkbutton $top.g.ital -padx 5 \
10037             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
10038             -variable fontparam(slant) -onvalue italic -offvalue roman
10039         pack $top.g.size $top.g.bold $top.g.ital -side left
10040         pack $top.g -side top
10041         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10042             -background white
10043         $top.c create text 100 25 -anchor center -text $which -font sample \
10044             -fill black -tags text
10045         bind $top.c <Configure> [list centertext $top.c]
10046         pack $top.c -side top -fill x
10047         frame $top.buts
10048         button $top.buts.ok -text [mc "OK"] -command fontok -default active
10049         button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
10050         bind $top <Key-Return> fontok
10051         bind $top <Key-Escape> fontcan
10052         grid $top.buts.ok $top.buts.can
10053         grid columnconfigure $top.buts 0 -weight 1 -uniform a
10054         grid columnconfigure $top.buts 1 -weight 1 -uniform a
10055         pack $top.buts -side bottom -fill x
10056         trace add variable fontparam write chg_fontparam
10057     } else {
10058         raise $top
10059         $top.c itemconf text -text $which
10060     }
10061     set i [lsearch -exact $fontlist $fontparam(family)]
10062     if {$i >= 0} {
10063         $top.f.fam selection set $i
10064         $top.f.fam see $i
10065     }
10066 }
10067
10068 proc centertext {w} {
10069     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10070 }
10071
10072 proc fontok {} {
10073     global fontparam fontpref prefstop
10074
10075     set f $fontparam(font)
10076     set fontpref($f) [list $fontparam(family) $fontparam(size)]
10077     if {$fontparam(weight) eq "bold"} {
10078         lappend fontpref($f) "bold"
10079     }
10080     if {$fontparam(slant) eq "italic"} {
10081         lappend fontpref($f) "italic"
10082     }
10083     set w $prefstop.$f
10084     $w conf -text $fontparam(family) -font $fontpref($f)
10085
10086     fontcan
10087 }
10088
10089 proc fontcan {} {
10090     global fonttop fontparam
10091
10092     if {[info exists fonttop]} {
10093         catch {destroy $fonttop}
10094         catch {font delete sample}
10095         unset fonttop
10096         unset fontparam
10097     }
10098 }
10099
10100 proc selfontfam {} {
10101     global fonttop fontparam
10102
10103     set i [$fonttop.f.fam curselection]
10104     if {$i ne {}} {
10105         set fontparam(family) [$fonttop.f.fam get $i]
10106     }
10107 }
10108
10109 proc chg_fontparam {v sub op} {
10110     global fontparam
10111
10112     font config sample -$sub $fontparam($sub)
10113 }
10114
10115 proc doprefs {} {
10116     global maxwidth maxgraphpct
10117     global oldprefs prefstop showneartags showlocalchanges
10118     global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10119     global tabstop limitdiffs autoselect extdifftool perfile_attrs
10120
10121     set top .gitkprefs
10122     set prefstop $top
10123     if {[winfo exists $top]} {
10124         raise $top
10125         return
10126     }
10127     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10128                    limitdiffs tabstop perfile_attrs} {
10129         set oldprefs($v) [set $v]
10130     }
10131     toplevel $top
10132     wm title $top [mc "Gitk preferences"]
10133     make_transient $top .
10134     label $top.ldisp -text [mc "Commit list display options"]
10135     grid $top.ldisp - -sticky w -pady 10
10136     label $top.spacer -text " "
10137     label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
10138         -font optionfont
10139     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10140     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
10141     label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
10142         -font optionfont
10143     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10144     grid x $top.maxpctl $top.maxpct -sticky w
10145     frame $top.showlocal
10146     label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
10147     checkbutton $top.showlocal.b -variable showlocalchanges
10148     pack $top.showlocal.b $top.showlocal.l -side left
10149     grid x $top.showlocal -sticky w
10150     frame $top.autoselect
10151     label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont
10152     checkbutton $top.autoselect.b -variable autoselect
10153     pack $top.autoselect.b $top.autoselect.l -side left
10154     grid x $top.autoselect -sticky w
10155
10156     label $top.ddisp -text [mc "Diff display options"]
10157     grid $top.ddisp - -sticky w -pady 10
10158     label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
10159     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10160     grid x $top.tabstopl $top.tabstop -sticky w
10161     frame $top.ntag
10162     label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
10163     checkbutton $top.ntag.b -variable showneartags
10164     pack $top.ntag.b $top.ntag.l -side left
10165     grid x $top.ntag -sticky w
10166     frame $top.ldiff
10167     label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
10168     checkbutton $top.ldiff.b -variable limitdiffs
10169     pack $top.ldiff.b $top.ldiff.l -side left
10170     grid x $top.ldiff -sticky w
10171     frame $top.lattr
10172     label $top.lattr.l -text [mc "Support per-file encodings"] -font optionfont
10173     checkbutton $top.lattr.b -variable perfile_attrs
10174     pack $top.lattr.b $top.lattr.l -side left
10175     grid x $top.lattr -sticky w
10176
10177     entry $top.extdifft -textvariable extdifftool
10178     frame $top.extdifff
10179     label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
10180         -padx 10
10181     button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
10182         -command choose_extdiff
10183     pack $top.extdifff.l $top.extdifff.b -side left
10184     grid x $top.extdifff $top.extdifft -sticky w
10185
10186     label $top.cdisp -text [mc "Colors: press to choose"]
10187     grid $top.cdisp - -sticky w -pady 10
10188     label $top.bg -padx 40 -relief sunk -background $bgcolor
10189     button $top.bgbut -text [mc "Background"] -font optionfont \
10190         -command [list choosecolor bgcolor {} $top.bg background setbg]
10191     grid x $top.bgbut $top.bg -sticky w
10192     label $top.fg -padx 40 -relief sunk -background $fgcolor
10193     button $top.fgbut -text [mc "Foreground"] -font optionfont \
10194         -command [list choosecolor fgcolor {} $top.fg foreground setfg]
10195     grid x $top.fgbut $top.fg -sticky w
10196     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10197     button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
10198         -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
10199                       [list $ctext tag conf d0 -foreground]]
10200     grid x $top.diffoldbut $top.diffold -sticky w
10201     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10202     button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
10203         -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
10204                       [list $ctext tag conf dresult -foreground]]
10205     grid x $top.diffnewbut $top.diffnew -sticky w
10206     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10207     button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
10208         -command [list choosecolor diffcolors 2 $top.hunksep \
10209                       "diff hunk header" \
10210                       [list $ctext tag conf hunksep -foreground]]
10211     grid x $top.hunksepbut $top.hunksep -sticky w
10212     label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
10213     button $top.markbgbut -text [mc "Marked line bg"] -font optionfont \
10214         -command [list choosecolor markbgcolor {} $top.markbgsep \
10215                       [mc "marked line background"] \
10216                       [list $ctext tag conf omark -background]]
10217     grid x $top.markbgbut $top.markbgsep -sticky w
10218     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10219     button $top.selbgbut -text [mc "Select bg"] -font optionfont \
10220         -command [list choosecolor selectbgcolor {} $top.selbgsep background setselbg]
10221     grid x $top.selbgbut $top.selbgsep -sticky w
10222
10223     label $top.cfont -text [mc "Fonts: press to choose"]
10224     grid $top.cfont - -sticky w -pady 10
10225     mkfontdisp mainfont $top [mc "Main font"]
10226     mkfontdisp textfont $top [mc "Diff display font"]
10227     mkfontdisp uifont $top [mc "User interface font"]
10228
10229     frame $top.buts
10230     button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10231     button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10232     bind $top <Key-Return> prefsok
10233     bind $top <Key-Escape> prefscan
10234     grid $top.buts.ok $top.buts.can
10235     grid columnconfigure $top.buts 0 -weight 1 -uniform a
10236     grid columnconfigure $top.buts 1 -weight 1 -uniform a
10237     grid $top.buts - - -pady 10 -sticky ew
10238     bind $top <Visibility> "focus $top.buts.ok"
10239 }
10240
10241 proc choose_extdiff {} {
10242     global extdifftool
10243
10244     set prog [tk_getOpenFile -title "External diff tool" -multiple false]
10245     if {$prog ne {}} {
10246         set extdifftool $prog
10247     }
10248 }
10249
10250 proc choosecolor {v vi w x cmd} {
10251     global $v
10252
10253     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
10254                -title [mc "Gitk: choose color for %s" $x]]
10255     if {$c eq {}} return
10256     $w conf -background $c
10257     lset $v $vi $c
10258     eval $cmd $c
10259 }
10260
10261 proc setselbg {c} {
10262     global bglist cflist
10263     foreach w $bglist {
10264         $w configure -selectbackground $c
10265     }
10266     $cflist tag configure highlight \
10267         -background [$cflist cget -selectbackground]
10268     allcanvs itemconf secsel -fill $c
10269 }
10270
10271 proc setbg {c} {
10272     global bglist
10273
10274     foreach w $bglist {
10275         $w conf -background $c
10276     }
10277 }
10278
10279 proc setfg {c} {
10280     global fglist canv
10281
10282     foreach w $fglist {
10283         $w conf -foreground $c
10284     }
10285     allcanvs itemconf text -fill $c
10286     $canv itemconf circle -outline $c
10287 }
10288
10289 proc prefscan {} {
10290     global oldprefs prefstop
10291
10292     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10293                    limitdiffs tabstop perfile_attrs} {
10294         global $v
10295         set $v $oldprefs($v)
10296     }
10297     catch {destroy $prefstop}
10298     unset prefstop
10299     fontcan
10300 }
10301
10302 proc prefsok {} {
10303     global maxwidth maxgraphpct
10304     global oldprefs prefstop showneartags showlocalchanges
10305     global fontpref mainfont textfont uifont
10306     global limitdiffs treediffs perfile_attrs
10307
10308     catch {destroy $prefstop}
10309     unset prefstop
10310     fontcan
10311     set fontchanged 0
10312     if {$mainfont ne $fontpref(mainfont)} {
10313         set mainfont $fontpref(mainfont)
10314         parsefont mainfont $mainfont
10315         eval font configure mainfont [fontflags mainfont]
10316         eval font configure mainfontbold [fontflags mainfont 1]
10317         setcoords
10318         set fontchanged 1
10319     }
10320     if {$textfont ne $fontpref(textfont)} {
10321         set textfont $fontpref(textfont)
10322         parsefont textfont $textfont
10323         eval font configure textfont [fontflags textfont]
10324         eval font configure textfontbold [fontflags textfont 1]
10325     }
10326     if {$uifont ne $fontpref(uifont)} {
10327         set uifont $fontpref(uifont)
10328         parsefont uifont $uifont
10329         eval font configure uifont [fontflags uifont]
10330     }
10331     settabs
10332     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
10333         if {$showlocalchanges} {
10334             doshowlocalchanges
10335         } else {
10336             dohidelocalchanges
10337         }
10338     }
10339     if {$limitdiffs != $oldprefs(limitdiffs) ||
10340         ($perfile_attrs && !$oldprefs(perfile_attrs))} {
10341         # treediffs elements are limited by path;
10342         # won't have encodings cached if perfile_attrs was just turned on
10343         catch {unset treediffs}
10344     }
10345     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
10346         || $maxgraphpct != $oldprefs(maxgraphpct)} {
10347         redisplay
10348     } elseif {$showneartags != $oldprefs(showneartags) ||
10349           $limitdiffs != $oldprefs(limitdiffs)} {
10350         reselectline
10351     }
10352 }
10353
10354 proc formatdate {d} {
10355     global datetimeformat
10356     if {$d ne {}} {
10357         set d [clock format $d -format $datetimeformat]
10358     }
10359     return $d
10360 }
10361
10362 # This list of encoding names and aliases is distilled from
10363 # http://www.iana.org/assignments/character-sets.
10364 # Not all of them are supported by Tcl.
10365 set encoding_aliases {
10366     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
10367       ISO646-US US-ASCII us IBM367 cp367 csASCII }
10368     { ISO-10646-UTF-1 csISO10646UTF1 }
10369     { ISO_646.basic:1983 ref csISO646basic1983 }
10370     { INVARIANT csINVARIANT }
10371     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
10372     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
10373     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
10374     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
10375     { NATS-DANO iso-ir-9-1 csNATSDANO }
10376     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
10377     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
10378     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
10379     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
10380     { ISO-2022-KR csISO2022KR }
10381     { EUC-KR csEUCKR }
10382     { ISO-2022-JP csISO2022JP }
10383     { ISO-2022-JP-2 csISO2022JP2 }
10384     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
10385       csISO13JISC6220jp }
10386     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
10387     { IT iso-ir-15 ISO646-IT csISO15Italian }
10388     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
10389     { ES iso-ir-17 ISO646-ES csISO17Spanish }
10390     { greek7-old iso-ir-18 csISO18Greek7Old }
10391     { latin-greek iso-ir-19 csISO19LatinGreek }
10392     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
10393     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
10394     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
10395     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
10396     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
10397     { BS_viewdata iso-ir-47 csISO47BSViewdata }
10398     { INIS iso-ir-49 csISO49INIS }
10399     { INIS-8 iso-ir-50 csISO50INIS8 }
10400     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
10401     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
10402     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
10403     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
10404     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
10405     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
10406       csISO60Norwegian1 }
10407     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
10408     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
10409     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
10410     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
10411     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
10412     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
10413     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
10414     { greek7 iso-ir-88 csISO88Greek7 }
10415     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
10416     { iso-ir-90 csISO90 }
10417     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
10418     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
10419       csISO92JISC62991984b }
10420     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
10421     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
10422     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
10423       csISO95JIS62291984handadd }
10424     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
10425     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
10426     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
10427     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
10428       CP819 csISOLatin1 }
10429     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
10430     { T.61-7bit iso-ir-102 csISO102T617bit }
10431     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
10432     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
10433     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
10434     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
10435     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
10436     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
10437     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
10438     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
10439       arabic csISOLatinArabic }
10440     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
10441     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
10442     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
10443       greek greek8 csISOLatinGreek }
10444     { T.101-G2 iso-ir-128 csISO128T101G2 }
10445     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
10446       csISOLatinHebrew }
10447     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
10448     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
10449     { CSN_369103 iso-ir-139 csISO139CSN369103 }
10450     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
10451     { ISO_6937-2-add iso-ir-142 csISOTextComm }
10452     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
10453     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
10454       csISOLatinCyrillic }
10455     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
10456     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
10457     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
10458     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
10459     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
10460     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
10461     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
10462     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
10463     { ISO_10367-box iso-ir-155 csISO10367Box }
10464     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
10465     { latin-lap lap iso-ir-158 csISO158Lap }
10466     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
10467     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
10468     { us-dk csUSDK }
10469     { dk-us csDKUS }
10470     { JIS_X0201 X0201 csHalfWidthKatakana }
10471     { KSC5636 ISO646-KR csKSC5636 }
10472     { ISO-10646-UCS-2 csUnicode }
10473     { ISO-10646-UCS-4 csUCS4 }
10474     { DEC-MCS dec csDECMCS }
10475     { hp-roman8 roman8 r8 csHPRoman8 }
10476     { macintosh mac csMacintosh }
10477     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
10478       csIBM037 }
10479     { IBM038 EBCDIC-INT cp038 csIBM038 }
10480     { IBM273 CP273 csIBM273 }
10481     { IBM274 EBCDIC-BE CP274 csIBM274 }
10482     { IBM275 EBCDIC-BR cp275 csIBM275 }
10483     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
10484     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
10485     { IBM280 CP280 ebcdic-cp-it csIBM280 }
10486     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
10487     { IBM284 CP284 ebcdic-cp-es csIBM284 }
10488     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
10489     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
10490     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
10491     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
10492     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
10493     { IBM424 cp424 ebcdic-cp-he csIBM424 }
10494     { IBM437 cp437 437 csPC8CodePage437 }
10495     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
10496     { IBM775 cp775 csPC775Baltic }
10497     { IBM850 cp850 850 csPC850Multilingual }
10498     { IBM851 cp851 851 csIBM851 }
10499     { IBM852 cp852 852 csPCp852 }
10500     { IBM855 cp855 855 csIBM855 }
10501     { IBM857 cp857 857 csIBM857 }
10502     { IBM860 cp860 860 csIBM860 }
10503     { IBM861 cp861 861 cp-is csIBM861 }
10504     { IBM862 cp862 862 csPC862LatinHebrew }
10505     { IBM863 cp863 863 csIBM863 }
10506     { IBM864 cp864 csIBM864 }
10507     { IBM865 cp865 865 csIBM865 }
10508     { IBM866 cp866 866 csIBM866 }
10509     { IBM868 CP868 cp-ar csIBM868 }
10510     { IBM869 cp869 869 cp-gr csIBM869 }
10511     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
10512     { IBM871 CP871 ebcdic-cp-is csIBM871 }
10513     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
10514     { IBM891 cp891 csIBM891 }
10515     { IBM903 cp903 csIBM903 }
10516     { IBM904 cp904 904 csIBBM904 }
10517     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
10518     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
10519     { IBM1026 CP1026 csIBM1026 }
10520     { EBCDIC-AT-DE csIBMEBCDICATDE }
10521     { EBCDIC-AT-DE-A csEBCDICATDEA }
10522     { EBCDIC-CA-FR csEBCDICCAFR }
10523     { EBCDIC-DK-NO csEBCDICDKNO }
10524     { EBCDIC-DK-NO-A csEBCDICDKNOA }
10525     { EBCDIC-FI-SE csEBCDICFISE }
10526     { EBCDIC-FI-SE-A csEBCDICFISEA }
10527     { EBCDIC-FR csEBCDICFR }
10528     { EBCDIC-IT csEBCDICIT }
10529     { EBCDIC-PT csEBCDICPT }
10530     { EBCDIC-ES csEBCDICES }
10531     { EBCDIC-ES-A csEBCDICESA }
10532     { EBCDIC-ES-S csEBCDICESS }
10533     { EBCDIC-UK csEBCDICUK }
10534     { EBCDIC-US csEBCDICUS }
10535     { UNKNOWN-8BIT csUnknown8BiT }
10536     { MNEMONIC csMnemonic }
10537     { MNEM csMnem }
10538     { VISCII csVISCII }
10539     { VIQR csVIQR }
10540     { KOI8-R csKOI8R }
10541     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
10542     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
10543     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
10544     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
10545     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
10546     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
10547     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
10548     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
10549     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
10550     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
10551     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
10552     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
10553     { IBM1047 IBM-1047 }
10554     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
10555     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
10556     { UNICODE-1-1 csUnicode11 }
10557     { CESU-8 csCESU-8 }
10558     { BOCU-1 csBOCU-1 }
10559     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
10560     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
10561       l8 }
10562     { ISO-8859-15 ISO_8859-15 Latin-9 }
10563     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
10564     { GBK CP936 MS936 windows-936 }
10565     { JIS_Encoding csJISEncoding }
10566     { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
10567     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
10568       EUC-JP }
10569     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
10570     { ISO-10646-UCS-Basic csUnicodeASCII }
10571     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
10572     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
10573     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
10574     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
10575     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
10576     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
10577     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
10578     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
10579     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
10580     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
10581     { Adobe-Standard-Encoding csAdobeStandardEncoding }
10582     { Ventura-US csVenturaUS }
10583     { Ventura-International csVenturaInternational }
10584     { PC8-Danish-Norwegian csPC8DanishNorwegian }
10585     { PC8-Turkish csPC8Turkish }
10586     { IBM-Symbols csIBMSymbols }
10587     { IBM-Thai csIBMThai }
10588     { HP-Legal csHPLegal }
10589     { HP-Pi-font csHPPiFont }
10590     { HP-Math8 csHPMath8 }
10591     { Adobe-Symbol-Encoding csHPPSMath }
10592     { HP-DeskTop csHPDesktop }
10593     { Ventura-Math csVenturaMath }
10594     { Microsoft-Publishing csMicrosoftPublishing }
10595     { Windows-31J csWindows31J }
10596     { GB2312 csGB2312 }
10597     { Big5 csBig5 }
10598 }
10599
10600 proc tcl_encoding {enc} {
10601     global encoding_aliases tcl_encoding_cache
10602     if {[info exists tcl_encoding_cache($enc)]} {
10603         return $tcl_encoding_cache($enc)
10604     }
10605     set names [encoding names]
10606     set lcnames [string tolower $names]
10607     set enc [string tolower $enc]
10608     set i [lsearch -exact $lcnames $enc]
10609     if {$i < 0} {
10610         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
10611         if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
10612             set i [lsearch -exact $lcnames $encx]
10613         }
10614     }
10615     if {$i < 0} {
10616         foreach l $encoding_aliases {
10617             set ll [string tolower $l]
10618             if {[lsearch -exact $ll $enc] < 0} continue
10619             # look through the aliases for one that tcl knows about
10620             foreach e $ll {
10621                 set i [lsearch -exact $lcnames $e]
10622                 if {$i < 0} {
10623                     if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
10624                         set i [lsearch -exact $lcnames $ex]
10625                     }
10626                 }
10627                 if {$i >= 0} break
10628             }
10629             break
10630         }
10631     }
10632     set tclenc {}
10633     if {$i >= 0} {
10634         set tclenc [lindex $names $i]
10635     }
10636     set tcl_encoding_cache($enc) $tclenc
10637     return $tclenc
10638 }
10639
10640 proc gitattr {path attr default} {
10641     global path_attr_cache
10642     if {[info exists path_attr_cache($attr,$path)]} {
10643         set r $path_attr_cache($attr,$path)
10644     } else {
10645         set r "unspecified"
10646         if {![catch {set line [exec git check-attr $attr -- $path]}]} {
10647             regexp "(.*): encoding: (.*)" $line m f r
10648         }
10649         set path_attr_cache($attr,$path) $r
10650     }
10651     if {$r eq "unspecified"} {
10652         return $default
10653     }
10654     return $r
10655 }
10656
10657 proc cache_gitattr {attr pathlist} {
10658     global path_attr_cache
10659     set newlist {}
10660     foreach path $pathlist {
10661         if {![info exists path_attr_cache($attr,$path)]} {
10662             lappend newlist $path
10663         }
10664     }
10665     set lim 1000
10666     if {[tk windowingsystem] == "win32"} {
10667         # windows has a 32k limit on the arguments to a command...
10668         set lim 30
10669     }
10670     while {$newlist ne {}} {
10671         set head [lrange $newlist 0 [expr {$lim - 1}]]
10672         set newlist [lrange $newlist $lim end]
10673         if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
10674             foreach row [split $rlist "\n"] {
10675                 if {[regexp "(.*): encoding: (.*)" $row m path value]} {
10676                     if {[string index $path 0] eq "\""} {
10677                         set path [encoding convertfrom [lindex $path 0]]
10678                     }
10679                     set path_attr_cache($attr,$path) $value
10680                 }
10681             }
10682         }
10683     }
10684 }
10685
10686 proc get_path_encoding {path} {
10687     global gui_encoding perfile_attrs
10688     set tcl_enc $gui_encoding
10689     if {$path ne {} && $perfile_attrs} {
10690         set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
10691         if {$enc2 ne {}} {
10692             set tcl_enc $enc2
10693         }
10694     }
10695     return $tcl_enc
10696 }
10697
10698 # First check that Tcl/Tk is recent enough
10699 if {[catch {package require Tk 8.4} err]} {
10700     show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
10701                      Gitk requires at least Tcl/Tk 8.4."]
10702     exit 1
10703 }
10704
10705 # defaults...
10706 set wrcomcmd "git diff-tree --stdin -p --pretty"
10707
10708 set gitencoding {}
10709 catch {
10710     set gitencoding [exec git config --get i18n.commitencoding]
10711 }
10712 catch {
10713     set gitencoding [exec git config --get i18n.logoutputencoding]
10714 }
10715 if {$gitencoding == ""} {
10716     set gitencoding "utf-8"
10717 }
10718 set tclencoding [tcl_encoding $gitencoding]
10719 if {$tclencoding == {}} {
10720     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
10721 }
10722
10723 set gui_encoding [encoding system]
10724 catch {
10725     set enc [exec git config --get gui.encoding]
10726     if {$enc ne {}} {
10727         set tclenc [tcl_encoding $enc]
10728         if {$tclenc ne {}} {
10729             set gui_encoding $tclenc
10730         } else {
10731             puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
10732         }
10733     }
10734 }
10735
10736 set mainfont {Helvetica 9}
10737 set textfont {Courier 9}
10738 set uifont {Helvetica 9 bold}
10739 set tabstop 8
10740 set findmergefiles 0
10741 set maxgraphpct 50
10742 set maxwidth 16
10743 set revlistorder 0
10744 set fastdate 0
10745 set uparrowlen 5
10746 set downarrowlen 5
10747 set mingaplen 100
10748 set cmitmode "patch"
10749 set wrapcomment "none"
10750 set showneartags 1
10751 set maxrefs 20
10752 set maxlinelen 200
10753 set showlocalchanges 1
10754 set limitdiffs 1
10755 set datetimeformat "%Y-%m-%d %H:%M:%S"
10756 set autoselect 1
10757 set perfile_attrs 0
10758
10759 set extdifftool "meld"
10760
10761 set colors {green red blue magenta darkgrey brown orange}
10762 set bgcolor white
10763 set fgcolor black
10764 set diffcolors {red "#00a000" blue}
10765 set diffcontext 3
10766 set ignorespace 0
10767 set selectbgcolor gray85
10768 set markbgcolor "#e0e0ff"
10769
10770 set circlecolors {white blue gray blue blue}
10771
10772 # button for popping up context menus
10773 if {[tk windowingsystem] eq "aqua"} {
10774     set ctxbut <Button-2>
10775 } else {
10776     set ctxbut <Button-3>
10777 }
10778
10779 ## For msgcat loading, first locate the installation location.
10780 if { [info exists ::env(GITK_MSGSDIR)] } {
10781     ## Msgsdir was manually set in the environment.
10782     set gitk_msgsdir $::env(GITK_MSGSDIR)
10783 } else {
10784     ## Let's guess the prefix from argv0.
10785     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
10786     set gitk_libdir [file join $gitk_prefix share gitk lib]
10787     set gitk_msgsdir [file join $gitk_libdir msgs]
10788     unset gitk_prefix
10789 }
10790
10791 ## Internationalization (i18n) through msgcat and gettext. See
10792 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
10793 package require msgcat
10794 namespace import ::msgcat::mc
10795 ## And eventually load the actual message catalog
10796 ::msgcat::mcload $gitk_msgsdir
10797
10798 catch {source ~/.gitk}
10799
10800 font create optionfont -family sans-serif -size -12
10801
10802 parsefont mainfont $mainfont
10803 eval font create mainfont [fontflags mainfont]
10804 eval font create mainfontbold [fontflags mainfont 1]
10805
10806 parsefont textfont $textfont
10807 eval font create textfont [fontflags textfont]
10808 eval font create textfontbold [fontflags textfont 1]
10809
10810 parsefont uifont $uifont
10811 eval font create uifont [fontflags uifont]
10812
10813 setoptions
10814
10815 # check that we can find a .git directory somewhere...
10816 if {[catch {set gitdir [gitdir]}]} {
10817     show_error {} . [mc "Cannot find a git repository here."]
10818     exit 1
10819 }
10820 if {![file isdirectory $gitdir]} {
10821     show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
10822     exit 1
10823 }
10824
10825 set selecthead {}
10826 set selectheadid {}
10827
10828 set revtreeargs {}
10829 set cmdline_files {}
10830 set i 0
10831 set revtreeargscmd {}
10832 foreach arg $argv {
10833     switch -glob -- $arg {
10834         "" { }
10835         "--" {
10836             set cmdline_files [lrange $argv [expr {$i + 1}] end]
10837             break
10838         }
10839         "--select-commit=*" {
10840             set selecthead [string range $arg 16 end]
10841         }
10842         "--argscmd=*" {
10843             set revtreeargscmd [string range $arg 10 end]
10844         }
10845         default {
10846             lappend revtreeargs $arg
10847         }
10848     }
10849     incr i
10850 }
10851
10852 if {$selecthead eq "HEAD"} {
10853     set selecthead {}
10854 }
10855
10856 if {$i >= [llength $argv] && $revtreeargs ne {}} {
10857     # no -- on command line, but some arguments (other than --argscmd)
10858     if {[catch {
10859         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
10860         set cmdline_files [split $f "\n"]
10861         set n [llength $cmdline_files]
10862         set revtreeargs [lrange $revtreeargs 0 end-$n]
10863         # Unfortunately git rev-parse doesn't produce an error when
10864         # something is both a revision and a filename.  To be consistent
10865         # with git log and git rev-list, check revtreeargs for filenames.
10866         foreach arg $revtreeargs {
10867             if {[file exists $arg]} {
10868                 show_error {} . [mc "Ambiguous argument '%s': both revision\
10869                                  and filename" $arg]
10870                 exit 1
10871             }
10872         }
10873     } err]} {
10874         # unfortunately we get both stdout and stderr in $err,
10875         # so look for "fatal:".
10876         set i [string first "fatal:" $err]
10877         if {$i > 0} {
10878             set err [string range $err [expr {$i + 6}] end]
10879         }
10880         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
10881         exit 1
10882     }
10883 }
10884
10885 set nullid "0000000000000000000000000000000000000000"
10886 set nullid2 "0000000000000000000000000000000000000001"
10887 set nullfile "/dev/null"
10888
10889 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
10890
10891 set runq {}
10892 set history {}
10893 set historyindex 0
10894 set fh_serial 0
10895 set nhl_names {}
10896 set highlight_paths {}
10897 set findpattern {}
10898 set searchdirn -forwards
10899 set boldids {}
10900 set boldnameids {}
10901 set diffelide {0 0}
10902 set markingmatches 0
10903 set linkentercount 0
10904 set need_redisplay 0
10905 set nrows_drawn 0
10906 set firsttabstop 0
10907
10908 set nextviewnum 1
10909 set curview 0
10910 set selectedview 0
10911 set selectedhlview [mc "None"]
10912 set highlight_related [mc "None"]
10913 set highlight_files {}
10914 set viewfiles(0) {}
10915 set viewperm(0) 0
10916 set viewargs(0) {}
10917 set viewargscmd(0) {}
10918
10919 set selectedline {}
10920 set numcommits 0
10921 set loginstance 0
10922 set cmdlineok 0
10923 set stopped 0
10924 set stuffsaved 0
10925 set patchnum 0
10926 set lserial 0
10927 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
10928 setcoords
10929 makewindow
10930 # wait for the window to become visible
10931 tkwait visibility .
10932 wm title . "[file tail $argv0]: [file tail [pwd]]"
10933 readrefs
10934
10935 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
10936     # create a view for the files/dirs specified on the command line
10937     set curview 1
10938     set selectedview 1
10939     set nextviewnum 2
10940     set viewname(1) [mc "Command line"]
10941     set viewfiles(1) $cmdline_files
10942     set viewargs(1) $revtreeargs
10943     set viewargscmd(1) $revtreeargscmd
10944     set viewperm(1) 0
10945     set vdatemode(1) 0
10946     addviewmenu 1
10947     .bar.view entryconf [mca "Edit view..."] -state normal
10948     .bar.view entryconf [mca "Delete view"] -state normal
10949 }
10950
10951 if {[info exists permviews]} {
10952     foreach v $permviews {
10953         set n $nextviewnum
10954         incr nextviewnum
10955         set viewname($n) [lindex $v 0]
10956         set viewfiles($n) [lindex $v 1]
10957         set viewargs($n) [lindex $v 2]
10958         set viewargscmd($n) [lindex $v 3]
10959         set viewperm($n) 1
10960         addviewmenu $n
10961     }
10962 }
10963 getcommits {}