gitk-git/gitk

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