gitk-git/gitk

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