gitk-git/gitk

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