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