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