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