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