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     catch {unset 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         unset 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 unset} 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 {$op eq "unset"} {
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 {[info exists selectedline]} {
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 {[info exists selectedline] && $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 {[info exists selectedline] && $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 {![info exists selectedline]} 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 selectedline 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 {[info exists selectedline] && $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 {[info exists selectedline] &&
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
5129     allcanvs delete all
5130     catch {unset iddrawn}
5131     catch {unset linesegs}
5132     catch {unset vhighlights}
5133     catch {unset fhighlights}
5134     catch {unset nhighlights}
5135     catch {unset rhighlights}
5136     set need_redisplay 0
5137     set nrows_drawn 0
5138 }
5139
5140 proc findcrossings {id} {
5141     global rowidlist parentlist numcommits displayorder
5142
5143     set cross {}
5144     set ccross {}
5145     foreach {s e} [rowranges $id] {
5146         if {$e >= $numcommits} {
5147             set e [expr {$numcommits - 1}]
5148         }
5149         if {$e <= $s} continue
5150         for {set row $e} {[incr row -1] >= $s} {} {
5151             set x [lsearch -exact [lindex $rowidlist $row] $id]
5152             if {$x < 0} break
5153             set olds [lindex $parentlist $row]
5154             set kid [lindex $displayorder $row]
5155             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
5156             if {$kidx < 0} continue
5157             set nextrow [lindex $rowidlist [expr {$row + 1}]]
5158             foreach p $olds {
5159                 set px [lsearch -exact $nextrow $p]
5160                 if {$px < 0} continue
5161                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
5162                     if {[lsearch -exact $ccross $p] >= 0} continue
5163                     if {$x == $px + ($kidx < $px? -1: 1)} {
5164                         lappend ccross $p
5165                     } elseif {[lsearch -exact $cross $p] < 0} {
5166                         lappend cross $p
5167                     }
5168                 }
5169             }
5170         }
5171     }
5172     return [concat $ccross {{}} $cross]
5173 }
5174
5175 proc assigncolor {id} {
5176     global colormap colors nextcolor
5177     global parents children children curview
5178
5179     if {[info exists colormap($id)]} return
5180     set ncolors [llength $colors]
5181     if {[info exists children($curview,$id)]} {
5182         set kids $children($curview,$id)
5183     } else {
5184         set kids {}
5185     }
5186     if {[llength $kids] == 1} {
5187         set child [lindex $kids 0]
5188         if {[info exists colormap($child)]
5189             && [llength $parents($curview,$child)] == 1} {
5190             set colormap($id) $colormap($child)
5191             return
5192         }
5193     }
5194     set badcolors {}
5195     set origbad {}
5196     foreach x [findcrossings $id] {
5197         if {$x eq {}} {
5198             # delimiter between corner crossings and other crossings
5199             if {[llength $badcolors] >= $ncolors - 1} break
5200             set origbad $badcolors
5201         }
5202         if {[info exists colormap($x)]
5203             && [lsearch -exact $badcolors $colormap($x)] < 0} {
5204             lappend badcolors $colormap($x)
5205         }
5206     }
5207     if {[llength $badcolors] >= $ncolors} {
5208         set badcolors $origbad
5209     }
5210     set origbad $badcolors
5211     if {[llength $badcolors] < $ncolors - 1} {
5212         foreach child $kids {
5213             if {[info exists colormap($child)]
5214                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
5215                 lappend badcolors $colormap($child)
5216             }
5217             foreach p $parents($curview,$child) {
5218                 if {[info exists colormap($p)]
5219                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
5220                     lappend badcolors $colormap($p)
5221                 }
5222             }
5223         }
5224         if {[llength $badcolors] >= $ncolors} {
5225             set badcolors $origbad
5226         }
5227     }
5228     for {set i 0} {$i <= $ncolors} {incr i} {
5229         set c [lindex $colors $nextcolor]
5230         if {[incr nextcolor] >= $ncolors} {
5231             set nextcolor 0
5232         }
5233         if {[lsearch -exact $badcolors $c]} break
5234     }
5235     set colormap($id) $c
5236 }
5237
5238 proc bindline {t id} {
5239     global canv
5240
5241     $canv bind $t <Enter> "lineenter %x %y $id"
5242     $canv bind $t <Motion> "linemotion %x %y $id"
5243     $canv bind $t <Leave> "lineleave $id"
5244     $canv bind $t <Button-1> "lineclick %x %y $id 1"
5245 }
5246
5247 proc drawtags {id x xt y1} {
5248     global idtags idheads idotherrefs mainhead
5249     global linespc lthickness
5250     global canv rowtextx curview fgcolor bgcolor
5251
5252     set marks {}
5253     set ntags 0
5254     set nheads 0
5255     if {[info exists idtags($id)]} {
5256         set marks $idtags($id)
5257         set ntags [llength $marks]
5258     }
5259     if {[info exists idheads($id)]} {
5260         set marks [concat $marks $idheads($id)]
5261         set nheads [llength $idheads($id)]
5262     }
5263     if {[info exists idotherrefs($id)]} {
5264         set marks [concat $marks $idotherrefs($id)]
5265     }
5266     if {$marks eq {}} {
5267         return $xt
5268     }
5269
5270     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
5271     set yt [expr {$y1 - 0.5 * $linespc}]
5272     set yb [expr {$yt + $linespc - 1}]
5273     set xvals {}
5274     set wvals {}
5275     set i -1
5276     foreach tag $marks {
5277         incr i
5278         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
5279             set wid [font measure mainfontbold $tag]
5280         } else {
5281             set wid [font measure mainfont $tag]
5282         }
5283         lappend xvals $xt
5284         lappend wvals $wid
5285         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
5286     }
5287     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
5288                -width $lthickness -fill black -tags tag.$id]
5289     $canv lower $t
5290     foreach tag $marks x $xvals wid $wvals {
5291         set xl [expr {$x + $delta}]
5292         set xr [expr {$x + $delta + $wid + $lthickness}]
5293         set font mainfont
5294         if {[incr ntags -1] >= 0} {
5295             # draw a tag
5296             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
5297                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
5298                        -width 1 -outline black -fill yellow -tags tag.$id]
5299             $canv bind $t <1> [list showtag $tag 1]
5300             set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
5301         } else {
5302             # draw a head or other ref
5303             if {[incr nheads -1] >= 0} {
5304                 set col green
5305                 if {$tag eq $mainhead} {
5306                     set font mainfontbold
5307                 }
5308             } else {
5309                 set col "#ddddff"
5310             }
5311             set xl [expr {$xl - $delta/2}]
5312             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
5313                 -width 1 -outline black -fill $col -tags tag.$id
5314             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
5315                 set rwid [font measure mainfont $remoteprefix]
5316                 set xi [expr {$x + 1}]
5317                 set yti [expr {$yt + 1}]
5318                 set xri [expr {$x + $rwid}]
5319                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
5320                         -width 0 -fill "#ffddaa" -tags tag.$id
5321             }
5322         }
5323         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
5324                    -font $font -tags [list tag.$id text]]
5325         if {$ntags >= 0} {
5326             $canv bind $t <1> [list showtag $tag 1]
5327         } elseif {$nheads >= 0} {
5328             $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
5329         }
5330     }
5331     return $xt
5332 }
5333
5334 proc xcoord {i level ln} {
5335     global canvx0 xspc1 xspc2
5336
5337     set x [expr {$canvx0 + $i * $xspc1($ln)}]
5338     if {$i > 0 && $i == $level} {
5339         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
5340     } elseif {$i > $level} {
5341         set x [expr {$x + $xspc2 - $xspc1($ln)}]
5342     }
5343     return $x
5344 }
5345
5346 proc show_status {msg} {
5347     global canv fgcolor
5348
5349     clear_display
5350     $canv create text 3 3 -anchor nw -text $msg -font mainfont \
5351         -tags text -fill $fgcolor
5352 }
5353
5354 # Don't change the text pane cursor if it is currently the hand cursor,
5355 # showing that we are over a sha1 ID link.
5356 proc settextcursor {c} {
5357     global ctext curtextcursor
5358
5359     if {[$ctext cget -cursor] == $curtextcursor} {
5360         $ctext config -cursor $c
5361     }
5362     set curtextcursor $c
5363 }
5364
5365 proc nowbusy {what {name {}}} {
5366     global isbusy busyname statusw
5367
5368     if {[array names isbusy] eq {}} {
5369         . config -cursor watch
5370         settextcursor watch
5371     }
5372     set isbusy($what) 1
5373     set busyname($what) $name
5374     if {$name ne {}} {
5375         $statusw conf -text $name
5376     }
5377 }
5378
5379 proc notbusy {what} {
5380     global isbusy maincursor textcursor busyname statusw
5381
5382     catch {
5383         unset isbusy($what)
5384         if {$busyname($what) ne {} &&
5385             [$statusw cget -text] eq $busyname($what)} {
5386             $statusw conf -text {}
5387         }
5388     }
5389     if {[array names isbusy] eq {}} {
5390         . config -cursor $maincursor
5391         settextcursor $textcursor
5392     }
5393 }
5394
5395 proc findmatches {f} {
5396     global findtype findstring
5397     if {$findtype == [mc "Regexp"]} {
5398         set matches [regexp -indices -all -inline $findstring $f]
5399     } else {
5400         set fs $findstring
5401         if {$findtype == [mc "IgnCase"]} {
5402             set f [string tolower $f]
5403             set fs [string tolower $fs]
5404         }
5405         set matches {}
5406         set i 0
5407         set l [string length $fs]
5408         while {[set j [string first $fs $f $i]] >= 0} {
5409             lappend matches [list $j [expr {$j+$l-1}]]
5410             set i [expr {$j + $l}]
5411         }
5412     }
5413     return $matches
5414 }
5415
5416 proc dofind {{dirn 1} {wrap 1}} {
5417     global findstring findstartline findcurline selectedline numcommits
5418     global gdttype filehighlight fh_serial find_dirn findallowwrap
5419
5420     if {[info exists find_dirn]} {
5421         if {$find_dirn == $dirn} return
5422         stopfinding
5423     }
5424     focus .
5425     if {$findstring eq {} || $numcommits == 0} return
5426     if {![info exists selectedline]} {
5427         set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
5428     } else {
5429         set findstartline $selectedline
5430     }
5431     set findcurline $findstartline
5432     nowbusy finding [mc "Searching"]
5433     if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
5434         after cancel do_file_hl $fh_serial
5435         do_file_hl $fh_serial
5436     }
5437     set find_dirn $dirn
5438     set findallowwrap $wrap
5439     run findmore
5440 }
5441
5442 proc stopfinding {} {
5443     global find_dirn findcurline fprogcoord
5444
5445     if {[info exists find_dirn]} {
5446         unset find_dirn
5447         unset findcurline
5448         notbusy finding
5449         set fprogcoord 0
5450         adjustprogress
5451     }
5452 }
5453
5454 proc findmore {} {
5455     global commitdata commitinfo numcommits findpattern findloc
5456     global findstartline findcurline findallowwrap
5457     global find_dirn gdttype fhighlights fprogcoord
5458     global curview varcorder vrownum varccommits vrowmod
5459
5460     if {![info exists find_dirn]} {
5461         return 0
5462     }
5463     set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
5464     set l $findcurline
5465     set moretodo 0
5466     if {$find_dirn > 0} {
5467         incr l
5468         if {$l >= $numcommits} {
5469             set l 0
5470         }
5471         if {$l <= $findstartline} {
5472             set lim [expr {$findstartline + 1}]
5473         } else {
5474             set lim $numcommits
5475             set moretodo $findallowwrap
5476         }
5477     } else {
5478         if {$l == 0} {
5479             set l $numcommits
5480         }
5481         incr l -1
5482         if {$l >= $findstartline} {
5483             set lim [expr {$findstartline - 1}]
5484         } else {
5485             set lim -1
5486             set moretodo $findallowwrap
5487         }
5488     }
5489     set n [expr {($lim - $l) * $find_dirn}]
5490     if {$n > 500} {
5491         set n 500
5492         set moretodo 1
5493     }
5494     if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
5495         update_arcrows $curview
5496     }
5497     set found 0
5498     set domore 1
5499     set ai [bsearch $vrownum($curview) $l]
5500     set a [lindex $varcorder($curview) $ai]
5501     set arow [lindex $vrownum($curview) $ai]
5502     set ids [lindex $varccommits($curview,$a)]
5503     set arowend [expr {$arow + [llength $ids]}]
5504     if {$gdttype eq [mc "containing:"]} {
5505         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5506             if {$l < $arow || $l >= $arowend} {
5507                 incr ai $find_dirn
5508                 set a [lindex $varcorder($curview) $ai]
5509                 set arow [lindex $vrownum($curview) $ai]
5510                 set ids [lindex $varccommits($curview,$a)]
5511                 set arowend [expr {$arow + [llength $ids]}]
5512             }
5513             set id [lindex $ids [expr {$l - $arow}]]
5514             # shouldn't happen unless git log doesn't give all the commits...
5515             if {![info exists commitdata($id)] ||
5516                 ![doesmatch $commitdata($id)]} {
5517                 continue
5518             }
5519             if {![info exists commitinfo($id)]} {
5520                 getcommit $id
5521             }
5522             set info $commitinfo($id)
5523             foreach f $info ty $fldtypes {
5524                 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
5525                     [doesmatch $f]} {
5526                     set found 1
5527                     break
5528                 }
5529             }
5530             if {$found} break
5531         }
5532     } else {
5533         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
5534             if {$l < $arow || $l >= $arowend} {
5535                 incr ai $find_dirn
5536                 set a [lindex $varcorder($curview) $ai]
5537                 set arow [lindex $vrownum($curview) $ai]
5538                 set ids [lindex $varccommits($curview,$a)]
5539                 set arowend [expr {$arow + [llength $ids]}]
5540             }
5541             set id [lindex $ids [expr {$l - $arow}]]
5542             if {![info exists fhighlights($id)]} {
5543                 # this sets fhighlights($id) to -1
5544                 askfilehighlight $l $id
5545             }
5546             if {$fhighlights($id) > 0} {
5547                 set found $domore
5548                 break
5549             }
5550             if {$fhighlights($id) < 0} {
5551                 if {$domore} {
5552                     set domore 0
5553                     set findcurline [expr {$l - $find_dirn}]
5554                 }
5555             }
5556         }
5557     }
5558     if {$found || ($domore && !$moretodo)} {
5559         unset findcurline
5560         unset find_dirn
5561         notbusy finding
5562         set fprogcoord 0
5563         adjustprogress
5564         if {$found} {
5565             findselectline $l
5566         } else {
5567             bell
5568         }
5569         return 0
5570     }
5571     if {!$domore} {
5572         flushhighlights
5573     } else {
5574         set findcurline [expr {$l - $find_dirn}]
5575     }
5576     set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
5577     if {$n < 0} {
5578         incr n $numcommits
5579     }
5580     set fprogcoord [expr {$n * 1.0 / $numcommits}]
5581     adjustprogress
5582     return $domore
5583 }
5584
5585 proc findselectline {l} {
5586     global findloc commentend ctext findcurline markingmatches gdttype
5587
5588     set markingmatches 1
5589     set findcurline $l
5590     selectline $l 1
5591     if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
5592         # highlight the matches in the comments
5593         set f [$ctext get 1.0 $commentend]
5594         set matches [findmatches $f]
5595         foreach match $matches {
5596             set start [lindex $match 0]
5597             set end [expr {[lindex $match 1] + 1}]
5598             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
5599         }
5600     }
5601     drawvisible
5602 }
5603
5604 # mark the bits of a headline or author that match a find string
5605 proc markmatches {canv l str tag matches font row} {
5606     global selectedline
5607
5608     set bbox [$canv bbox $tag]
5609     set x0 [lindex $bbox 0]
5610     set y0 [lindex $bbox 1]
5611     set y1 [lindex $bbox 3]
5612     foreach match $matches {
5613         set start [lindex $match 0]
5614         set end [lindex $match 1]
5615         if {$start > $end} continue
5616         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
5617         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
5618         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
5619                    [expr {$x0+$xlen+2}] $y1 \
5620                    -outline {} -tags [list match$l matches] -fill yellow]
5621         $canv lower $t
5622         if {[info exists selectedline] && $row == $selectedline} {
5623             $canv raise $t secsel
5624         }
5625     }
5626 }
5627
5628 proc unmarkmatches {} {
5629     global markingmatches
5630
5631     allcanvs delete matches
5632     set markingmatches 0
5633     stopfinding
5634 }
5635
5636 proc selcanvline {w x y} {
5637     global canv canvy0 ctext linespc
5638     global rowtextx
5639     set ymax [lindex [$canv cget -scrollregion] 3]
5640     if {$ymax == {}} return
5641     set yfrac [lindex [$canv yview] 0]
5642     set y [expr {$y + $yfrac * $ymax}]
5643     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
5644     if {$l < 0} {
5645         set l 0
5646     }
5647     if {$w eq $canv} {
5648         set xmax [lindex [$canv cget -scrollregion] 2]
5649         set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
5650         if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
5651     }
5652     unmarkmatches
5653     selectline $l 1
5654 }
5655
5656 proc commit_descriptor {p} {
5657     global commitinfo
5658     if {![info exists commitinfo($p)]} {
5659         getcommit $p
5660     }
5661     set l "..."
5662     if {[llength $commitinfo($p)] > 1} {
5663         set l [lindex $commitinfo($p) 0]
5664     }
5665     return "$p ($l)\n"
5666 }
5667
5668 # append some text to the ctext widget, and make any SHA1 ID
5669 # that we know about be a clickable link.
5670 proc appendwithlinks {text tags} {
5671     global ctext linknum curview pendinglinks
5672
5673     set start [$ctext index "end - 1c"]
5674     $ctext insert end $text $tags
5675     set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
5676     foreach l $links {
5677         set s [lindex $l 0]
5678         set e [lindex $l 1]
5679         set linkid [string range $text $s $e]
5680         incr e
5681         $ctext tag delete link$linknum
5682         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
5683         setlink $linkid link$linknum
5684         incr linknum
5685     }
5686 }
5687
5688 proc setlink {id lk} {
5689     global curview ctext pendinglinks commitinterest
5690
5691     if {[commitinview $id $curview]} {
5692         $ctext tag conf $lk -foreground blue -underline 1
5693         $ctext tag bind $lk <1> [list selectline [rowofcommit $id] 1]
5694         $ctext tag bind $lk <Enter> {linkcursor %W 1}
5695         $ctext tag bind $lk <Leave> {linkcursor %W -1}
5696     } else {
5697         lappend pendinglinks($id) $lk
5698         lappend commitinterest($id) {makelink %I}
5699     }
5700 }
5701
5702 proc makelink {id} {
5703     global pendinglinks
5704
5705     if {![info exists pendinglinks($id)]} return
5706     foreach lk $pendinglinks($id) {
5707         setlink $id $lk
5708     }
5709     unset pendinglinks($id)
5710 }
5711
5712 proc linkcursor {w inc} {
5713     global linkentercount curtextcursor
5714
5715     if {[incr linkentercount $inc] > 0} {
5716         $w configure -cursor hand2
5717     } else {
5718         $w configure -cursor $curtextcursor
5719         if {$linkentercount < 0} {
5720             set linkentercount 0
5721         }
5722     }
5723 }
5724
5725 proc viewnextline {dir} {
5726     global canv linespc
5727
5728     $canv delete hover
5729     set ymax [lindex [$canv cget -scrollregion] 3]
5730     set wnow [$canv yview]
5731     set wtop [expr {[lindex $wnow 0] * $ymax}]
5732     set newtop [expr {$wtop + $dir * $linespc}]
5733     if {$newtop < 0} {
5734         set newtop 0
5735     } elseif {$newtop > $ymax} {
5736         set newtop $ymax
5737     }
5738     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5739 }
5740
5741 # add a list of tag or branch names at position pos
5742 # returns the number of names inserted
5743 proc appendrefs {pos ids var} {
5744     global ctext linknum curview $var maxrefs
5745
5746     if {[catch {$ctext index $pos}]} {
5747         return 0
5748     }
5749     $ctext conf -state normal
5750     $ctext delete $pos "$pos lineend"
5751     set tags {}
5752     foreach id $ids {
5753         foreach tag [set $var\($id\)] {
5754             lappend tags [list $tag $id]
5755         }
5756     }
5757     if {[llength $tags] > $maxrefs} {
5758         $ctext insert $pos "many ([llength $tags])"
5759     } else {
5760         set tags [lsort -index 0 -decreasing $tags]
5761         set sep {}
5762         foreach ti $tags {
5763             set id [lindex $ti 1]
5764             set lk link$linknum
5765             incr linknum
5766             $ctext tag delete $lk
5767             $ctext insert $pos $sep
5768             $ctext insert $pos [lindex $ti 0] $lk
5769             setlink $id $lk
5770             set sep ", "
5771         }
5772     }
5773     $ctext conf -state disabled
5774     return [llength $tags]
5775 }
5776
5777 # called when we have finished computing the nearby tags
5778 proc dispneartags {delay} {
5779     global selectedline currentid showneartags tagphase
5780
5781     if {![info exists selectedline] || !$showneartags} return
5782     after cancel dispnexttag
5783     if {$delay} {
5784         after 200 dispnexttag
5785         set tagphase -1
5786     } else {
5787         after idle dispnexttag
5788         set tagphase 0
5789     }
5790 }
5791
5792 proc dispnexttag {} {
5793     global selectedline currentid showneartags tagphase ctext
5794
5795     if {![info exists selectedline] || !$showneartags} return
5796     switch -- $tagphase {
5797         0 {
5798             set dtags [desctags $currentid]
5799             if {$dtags ne {}} {
5800                 appendrefs precedes $dtags idtags
5801             }
5802         }
5803         1 {
5804             set atags [anctags $currentid]
5805             if {$atags ne {}} {
5806                 appendrefs follows $atags idtags
5807             }
5808         }
5809         2 {
5810             set dheads [descheads $currentid]
5811             if {$dheads ne {}} {
5812                 if {[appendrefs branch $dheads idheads] > 1
5813                     && [$ctext get "branch -3c"] eq "h"} {
5814                     # turn "Branch" into "Branches"
5815                     $ctext conf -state normal
5816                     $ctext insert "branch -2c" "es"
5817                     $ctext conf -state disabled
5818                 }
5819             }
5820         }
5821     }
5822     if {[incr tagphase] <= 2} {
5823         after idle dispnexttag
5824     }
5825 }
5826
5827 proc make_secsel {l} {
5828     global linehtag linentag linedtag canv canv2 canv3
5829
5830     if {![info exists linehtag($l)]} return
5831     $canv delete secsel
5832     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
5833                -tags secsel -fill [$canv cget -selectbackground]]
5834     $canv lower $t
5835     $canv2 delete secsel
5836     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
5837                -tags secsel -fill [$canv2 cget -selectbackground]]
5838     $canv2 lower $t
5839     $canv3 delete secsel
5840     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
5841                -tags secsel -fill [$canv3 cget -selectbackground]]
5842     $canv3 lower $t
5843 }
5844
5845 proc selectline {l isnew} {
5846     global canv ctext commitinfo selectedline
5847     global canvy0 linespc parents children curview
5848     global currentid sha1entry
5849     global commentend idtags linknum
5850     global mergemax numcommits pending_select
5851     global cmitmode showneartags allcommits
5852     global targetrow targetid lastscrollrows
5853     global autoselect
5854
5855     catch {unset pending_select}
5856     $canv delete hover
5857     normalline
5858     unsel_reflist
5859     stopfinding
5860     if {$l < 0 || $l >= $numcommits} return
5861     set id [commitonrow $l]
5862     set targetid $id
5863     set targetrow $l
5864     set selectedline $l
5865     set currentid $id
5866     if {$lastscrollrows < $numcommits} {
5867         setcanvscroll
5868     }
5869
5870     set y [expr {$canvy0 + $l * $linespc}]
5871     set ymax [lindex [$canv cget -scrollregion] 3]
5872     set ytop [expr {$y - $linespc - 1}]
5873     set ybot [expr {$y + $linespc + 1}]
5874     set wnow [$canv yview]
5875     set wtop [expr {[lindex $wnow 0] * $ymax}]
5876     set wbot [expr {[lindex $wnow 1] * $ymax}]
5877     set wh [expr {$wbot - $wtop}]
5878     set newtop $wtop
5879     if {$ytop < $wtop} {
5880         if {$ybot < $wtop} {
5881             set newtop [expr {$y - $wh / 2.0}]
5882         } else {
5883             set newtop $ytop
5884             if {$newtop > $wtop - $linespc} {
5885                 set newtop [expr {$wtop - $linespc}]
5886             }
5887         }
5888     } elseif {$ybot > $wbot} {
5889         if {$ytop > $wbot} {
5890             set newtop [expr {$y - $wh / 2.0}]
5891         } else {
5892             set newtop [expr {$ybot - $wh}]
5893             if {$newtop < $wtop + $linespc} {
5894                 set newtop [expr {$wtop + $linespc}]
5895             }
5896         }
5897     }
5898     if {$newtop != $wtop} {
5899         if {$newtop < 0} {
5900             set newtop 0
5901         }
5902         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5903         drawvisible
5904     }
5905
5906     make_secsel $l
5907
5908     if {$isnew} {
5909         addtohistory [list selbyid $id]
5910     }
5911
5912     $sha1entry delete 0 end
5913     $sha1entry insert 0 $id
5914     if {$autoselect} {
5915         $sha1entry selection from 0
5916         $sha1entry selection to end
5917     }
5918     rhighlight_sel $id
5919
5920     $ctext conf -state normal
5921     clear_ctext
5922     set linknum 0
5923     if {![info exists commitinfo($id)]} {
5924         getcommit $id
5925     }
5926     set info $commitinfo($id)
5927     set date [formatdate [lindex $info 2]]
5928     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
5929     set date [formatdate [lindex $info 4]]
5930     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
5931     if {[info exists idtags($id)]} {
5932         $ctext insert end [mc "Tags:"]
5933         foreach tag $idtags($id) {
5934             $ctext insert end " $tag"
5935         }
5936         $ctext insert end "\n"
5937     }
5938
5939     set headers {}
5940     set olds $parents($curview,$id)
5941     if {[llength $olds] > 1} {
5942         set np 0
5943         foreach p $olds {
5944             if {$np >= $mergemax} {
5945                 set tag mmax
5946             } else {
5947                 set tag m$np
5948             }
5949             $ctext insert end "[mc "Parent"]: " $tag
5950             appendwithlinks [commit_descriptor $p] {}
5951             incr np
5952         }
5953     } else {
5954         foreach p $olds {
5955             append headers "[mc "Parent"]: [commit_descriptor $p]"
5956         }
5957     }
5958
5959     foreach c $children($curview,$id) {
5960         append headers "[mc "Child"]:  [commit_descriptor $c]"
5961     }
5962
5963     # make anything that looks like a SHA1 ID be a clickable link
5964     appendwithlinks $headers {}
5965     if {$showneartags} {
5966         if {![info exists allcommits]} {
5967             getallcommits
5968         }
5969         $ctext insert end "[mc "Branch"]: "
5970         $ctext mark set branch "end -1c"
5971         $ctext mark gravity branch left
5972         $ctext insert end "\n[mc "Follows"]: "
5973         $ctext mark set follows "end -1c"
5974         $ctext mark gravity follows left
5975         $ctext insert end "\n[mc "Precedes"]: "
5976         $ctext mark set precedes "end -1c"
5977         $ctext mark gravity precedes left
5978         $ctext insert end "\n"
5979         dispneartags 1
5980     }
5981     $ctext insert end "\n"
5982     set comment [lindex $info 5]
5983     if {[string first "\r" $comment] >= 0} {
5984         set comment [string map {"\r" "\n    "} $comment]
5985     }
5986     appendwithlinks $comment {comment}
5987
5988     $ctext tag remove found 1.0 end
5989     $ctext conf -state disabled
5990     set commentend [$ctext index "end - 1c"]
5991
5992     init_flist [mc "Comments"]
5993     if {$cmitmode eq "tree"} {
5994         gettree $id
5995     } elseif {[llength $olds] <= 1} {
5996         startdiff $id
5997     } else {
5998         mergediff $id
5999     }
6000 }
6001
6002 proc selfirstline {} {
6003     unmarkmatches
6004     selectline 0 1
6005 }
6006
6007 proc sellastline {} {
6008     global numcommits
6009     unmarkmatches
6010     set l [expr {$numcommits - 1}]
6011     selectline $l 1
6012 }
6013
6014 proc selnextline {dir} {
6015     global selectedline
6016     focus .
6017     if {![info exists selectedline]} return
6018     set l [expr {$selectedline + $dir}]
6019     unmarkmatches
6020     selectline $l 1
6021 }
6022
6023 proc selnextpage {dir} {
6024     global canv linespc selectedline numcommits
6025
6026     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
6027     if {$lpp < 1} {
6028         set lpp 1
6029     }
6030     allcanvs yview scroll [expr {$dir * $lpp}] units
6031     drawvisible
6032     if {![info exists selectedline]} return
6033     set l [expr {$selectedline + $dir * $lpp}]
6034     if {$l < 0} {
6035         set l 0
6036     } elseif {$l >= $numcommits} {
6037         set l [expr $numcommits - 1]
6038     }
6039     unmarkmatches
6040     selectline $l 1
6041 }
6042
6043 proc unselectline {} {
6044     global selectedline currentid
6045
6046     catch {unset selectedline}
6047     catch {unset currentid}
6048     allcanvs delete secsel
6049     rhighlight_none
6050 }
6051
6052 proc reselectline {} {
6053     global selectedline
6054
6055     if {[info exists selectedline]} {
6056         selectline $selectedline 0
6057     }
6058 }
6059
6060 proc addtohistory {cmd} {
6061     global history historyindex curview
6062
6063     set elt [list $curview $cmd]
6064     if {$historyindex > 0
6065         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
6066         return
6067     }
6068
6069     if {$historyindex < [llength $history]} {
6070         set history [lreplace $history $historyindex end $elt]
6071     } else {
6072         lappend history $elt
6073     }
6074     incr historyindex
6075     if {$historyindex > 1} {
6076         .tf.bar.leftbut conf -state normal
6077     } else {
6078         .tf.bar.leftbut conf -state disabled
6079     }
6080     .tf.bar.rightbut conf -state disabled
6081 }
6082
6083 proc godo {elt} {
6084     global curview
6085
6086     set view [lindex $elt 0]
6087     set cmd [lindex $elt 1]
6088     if {$curview != $view} {
6089         showview $view
6090     }
6091     eval $cmd
6092 }
6093
6094 proc goback {} {
6095     global history historyindex
6096     focus .
6097
6098     if {$historyindex > 1} {
6099         incr historyindex -1
6100         godo [lindex $history [expr {$historyindex - 1}]]
6101         .tf.bar.rightbut conf -state normal
6102     }
6103     if {$historyindex <= 1} {
6104         .tf.bar.leftbut conf -state disabled
6105     }
6106 }
6107
6108 proc goforw {} {
6109     global history historyindex
6110     focus .
6111
6112     if {$historyindex < [llength $history]} {
6113         set cmd [lindex $history $historyindex]
6114         incr historyindex
6115         godo $cmd
6116         .tf.bar.leftbut conf -state normal
6117     }
6118     if {$historyindex >= [llength $history]} {
6119         .tf.bar.rightbut conf -state disabled
6120     }
6121 }
6122
6123 proc gettree {id} {
6124     global treefilelist treeidlist diffids diffmergeid treepending
6125     global nullid nullid2
6126
6127     set diffids $id
6128     catch {unset diffmergeid}
6129     if {![info exists treefilelist($id)]} {
6130         if {![info exists treepending]} {
6131             if {$id eq $nullid} {
6132                 set cmd [list | git ls-files]
6133             } elseif {$id eq $nullid2} {
6134                 set cmd [list | git ls-files --stage -t]
6135             } else {
6136                 set cmd [list | git ls-tree -r $id]
6137             }
6138             if {[catch {set gtf [open $cmd r]}]} {
6139                 return
6140             }
6141             set treepending $id
6142             set treefilelist($id) {}
6143             set treeidlist($id) {}
6144             fconfigure $gtf -blocking 0
6145             filerun $gtf [list gettreeline $gtf $id]
6146         }
6147     } else {
6148         setfilelist $id
6149     }
6150 }
6151
6152 proc gettreeline {gtf id} {
6153     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
6154
6155     set nl 0
6156     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
6157         if {$diffids eq $nullid} {
6158             set fname $line
6159         } else {
6160             set i [string first "\t" $line]
6161             if {$i < 0} continue
6162             set fname [string range $line [expr {$i+1}] end]
6163             set line [string range $line 0 [expr {$i-1}]]
6164             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
6165             set sha1 [lindex $line 2]
6166             if {[string index $fname 0] eq "\""} {
6167                 set fname [lindex $fname 0]
6168             }
6169             lappend treeidlist($id) $sha1
6170         }
6171         lappend treefilelist($id) $fname
6172     }
6173     if {![eof $gtf]} {
6174         return [expr {$nl >= 1000? 2: 1}]
6175     }
6176     close $gtf
6177     unset treepending
6178     if {$cmitmode ne "tree"} {
6179         if {![info exists diffmergeid]} {
6180             gettreediffs $diffids
6181         }
6182     } elseif {$id ne $diffids} {
6183         gettree $diffids
6184     } else {
6185         setfilelist $id
6186     }
6187     return 0
6188 }
6189
6190 proc showfile {f} {
6191     global treefilelist treeidlist diffids nullid nullid2
6192     global ctext commentend
6193
6194     set i [lsearch -exact $treefilelist($diffids) $f]
6195     if {$i < 0} {
6196         puts "oops, $f not in list for id $diffids"
6197         return
6198     }
6199     if {$diffids eq $nullid} {
6200         if {[catch {set bf [open $f r]} err]} {
6201             puts "oops, can't read $f: $err"
6202             return
6203         }
6204     } else {
6205         set blob [lindex $treeidlist($diffids) $i]
6206         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
6207             puts "oops, error reading blob $blob: $err"
6208             return
6209         }
6210     }
6211     fconfigure $bf -blocking 0
6212     filerun $bf [list getblobline $bf $diffids]
6213     $ctext config -state normal
6214     clear_ctext $commentend
6215     $ctext insert end "\n"
6216     $ctext insert end "$f\n" filesep
6217     $ctext config -state disabled
6218     $ctext yview $commentend
6219     settabs 0
6220 }
6221
6222 proc getblobline {bf id} {
6223     global diffids cmitmode ctext
6224
6225     if {$id ne $diffids || $cmitmode ne "tree"} {
6226         catch {close $bf}
6227         return 0
6228     }
6229     $ctext config -state normal
6230     set nl 0
6231     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
6232         $ctext insert end "$line\n"
6233     }
6234     if {[eof $bf]} {
6235         # delete last newline
6236         $ctext delete "end - 2c" "end - 1c"
6237         close $bf
6238         return 0
6239     }
6240     $ctext config -state disabled
6241     return [expr {$nl >= 1000? 2: 1}]
6242 }
6243
6244 proc mergediff {id} {
6245     global diffmergeid mdifffd
6246     global diffids
6247     global parents
6248     global diffcontext
6249     global limitdiffs vfilelimit curview
6250
6251     set diffmergeid $id
6252     set diffids $id
6253     # this doesn't seem to actually affect anything...
6254     set cmd [concat | git diff-tree --no-commit-id --cc -U$diffcontext $id]
6255     if {$limitdiffs && $vfilelimit($curview) ne {}} {
6256         set cmd [concat $cmd -- $vfilelimit($curview)]
6257     }
6258     if {[catch {set mdf [open $cmd r]} err]} {
6259         error_popup "[mc "Error getting merge diffs:"] $err"
6260         return
6261     }
6262     fconfigure $mdf -blocking 0
6263     set mdifffd($id) $mdf
6264     set np [llength $parents($curview,$id)]
6265     settabs $np
6266     filerun $mdf [list getmergediffline $mdf $id $np]
6267 }
6268
6269 proc getmergediffline {mdf id np} {
6270     global diffmergeid ctext cflist mergemax
6271     global difffilestart mdifffd
6272
6273     $ctext conf -state normal
6274     set nr 0
6275     while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
6276         if {![info exists diffmergeid] || $id != $diffmergeid
6277             || $mdf != $mdifffd($id)} {
6278             close $mdf
6279             return 0
6280         }
6281         if {[regexp {^diff --cc (.*)} $line match fname]} {
6282             # start of a new file
6283             $ctext insert end "\n"
6284             set here [$ctext index "end - 1c"]
6285             lappend difffilestart $here
6286             add_flist [list $fname]
6287             set l [expr {(78 - [string length $fname]) / 2}]
6288             set pad [string range "----------------------------------------" 1 $l]
6289             $ctext insert end "$pad $fname $pad\n" filesep
6290         } elseif {[regexp {^@@} $line]} {
6291             $ctext insert end "$line\n" hunksep
6292         } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
6293             # do nothing
6294         } else {
6295             # parse the prefix - one ' ', '-' or '+' for each parent
6296             set spaces {}
6297             set minuses {}
6298             set pluses {}
6299             set isbad 0
6300             for {set j 0} {$j < $np} {incr j} {
6301                 set c [string range $line $j $j]
6302                 if {$c == " "} {
6303                     lappend spaces $j
6304                 } elseif {$c == "-"} {
6305                     lappend minuses $j
6306                 } elseif {$c == "+"} {
6307                     lappend pluses $j
6308                 } else {
6309                     set isbad 1
6310                     break
6311                 }
6312             }
6313             set tags {}
6314             set num {}
6315             if {!$isbad && $minuses ne {} && $pluses eq {}} {
6316                 # line doesn't appear in result, parents in $minuses have the line
6317                 set num [lindex $minuses 0]
6318             } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
6319                 # line appears in result, parents in $pluses don't have the line
6320                 lappend tags mresult
6321                 set num [lindex $spaces 0]
6322             }
6323             if {$num ne {}} {
6324                 if {$num >= $mergemax} {
6325                     set num "max"
6326                 }
6327                 lappend tags m$num
6328             }
6329             $ctext insert end "$line\n" $tags
6330         }
6331     }
6332     $ctext conf -state disabled
6333     if {[eof $mdf]} {
6334         close $mdf
6335         return 0
6336     }
6337     return [expr {$nr >= 1000? 2: 1}]
6338 }
6339
6340 proc startdiff {ids} {
6341     global treediffs diffids treepending diffmergeid nullid nullid2
6342
6343     settabs 1
6344     set diffids $ids
6345     catch {unset diffmergeid}
6346     if {![info exists treediffs($ids)] ||
6347         [lsearch -exact $ids $nullid] >= 0 ||
6348         [lsearch -exact $ids $nullid2] >= 0} {
6349         if {![info exists treepending]} {
6350             gettreediffs $ids
6351         }
6352     } else {
6353         addtocflist $ids
6354     }
6355 }
6356
6357 proc path_filter {filter name} {
6358     foreach p $filter {
6359         set l [string length $p]
6360         if {[string index $p end] eq "/"} {
6361             if {[string compare -length $l $p $name] == 0} {
6362                 return 1
6363             }
6364         } else {
6365             if {[string compare -length $l $p $name] == 0 &&
6366                 ([string length $name] == $l ||
6367                  [string index $name $l] eq "/")} {
6368                 return 1
6369             }
6370         }
6371     }
6372     return 0
6373 }
6374
6375 proc addtocflist {ids} {
6376     global treediffs
6377
6378     add_flist $treediffs($ids)
6379     getblobdiffs $ids
6380 }
6381
6382 proc diffcmd {ids flags} {
6383     global nullid nullid2
6384
6385     set i [lsearch -exact $ids $nullid]
6386     set j [lsearch -exact $ids $nullid2]
6387     if {$i >= 0} {
6388         if {[llength $ids] > 1 && $j < 0} {
6389             # comparing working directory with some specific revision
6390             set cmd [concat | git diff-index $flags]
6391             if {$i == 0} {
6392                 lappend cmd -R [lindex $ids 1]
6393             } else {
6394                 lappend cmd [lindex $ids 0]
6395             }
6396         } else {
6397             # comparing working directory with index
6398             set cmd [concat | git diff-files $flags]
6399             if {$j == 1} {
6400                 lappend cmd -R
6401             }
6402         }
6403     } elseif {$j >= 0} {
6404         set cmd [concat | git diff-index --cached $flags]
6405         if {[llength $ids] > 1} {
6406             # comparing index with specific revision
6407             if {$i == 0} {
6408                 lappend cmd -R [lindex $ids 1]
6409             } else {
6410                 lappend cmd [lindex $ids 0]
6411             }
6412         } else {
6413             # comparing index with HEAD
6414             lappend cmd HEAD
6415         }
6416     } else {
6417         set cmd [concat | git diff-tree -r $flags $ids]
6418     }
6419     return $cmd
6420 }
6421
6422 proc gettreediffs {ids} {
6423     global treediff treepending
6424
6425     set treepending $ids
6426     set treediff {}
6427     if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
6428     fconfigure $gdtf -blocking 0
6429     filerun $gdtf [list gettreediffline $gdtf $ids]
6430 }
6431
6432 proc gettreediffline {gdtf ids} {
6433     global treediff treediffs treepending diffids diffmergeid
6434     global cmitmode vfilelimit curview limitdiffs
6435
6436     set nr 0
6437     while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
6438         set i [string first "\t" $line]
6439         if {$i >= 0} {
6440             set file [string range $line [expr {$i+1}] end]
6441             if {[string index $file 0] eq "\""} {
6442                 set file [lindex $file 0]
6443             }
6444             lappend treediff $file
6445         }
6446     }
6447     if {![eof $gdtf]} {
6448         return [expr {$nr >= 1000? 2: 1}]
6449     }
6450     close $gdtf
6451     if {$limitdiffs && $vfilelimit($curview) ne {}} {
6452         set flist {}
6453         foreach f $treediff {
6454             if {[path_filter $vfilelimit($curview) $f]} {
6455                 lappend flist $f
6456             }
6457         }
6458         set treediffs($ids) $flist
6459     } else {
6460         set treediffs($ids) $treediff
6461     }
6462     unset treepending
6463     if {$cmitmode eq "tree"} {
6464         gettree $diffids
6465     } elseif {$ids != $diffids} {
6466         if {![info exists diffmergeid]} {
6467             gettreediffs $diffids
6468         }
6469     } else {
6470         addtocflist $ids
6471     }
6472     return 0
6473 }
6474
6475 # empty string or positive integer
6476 proc diffcontextvalidate {v} {
6477     return [regexp {^(|[1-9][0-9]*)$} $v]
6478 }
6479
6480 proc diffcontextchange {n1 n2 op} {
6481     global diffcontextstring diffcontext
6482
6483     if {[string is integer -strict $diffcontextstring]} {
6484         if {$diffcontextstring > 0} {
6485             set diffcontext $diffcontextstring
6486             reselectline
6487         }
6488     }
6489 }
6490
6491 proc changeignorespace {} {
6492     reselectline
6493 }
6494
6495 proc getblobdiffs {ids} {
6496     global blobdifffd diffids env
6497     global diffinhdr treediffs
6498     global diffcontext
6499     global ignorespace
6500     global limitdiffs vfilelimit curview
6501
6502     set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
6503     if {$ignorespace} {
6504         append cmd " -w"
6505     }
6506     if {$limitdiffs && $vfilelimit($curview) ne {}} {
6507         set cmd [concat $cmd -- $vfilelimit($curview)]
6508     }
6509     if {[catch {set bdf [open $cmd r]} err]} {
6510         puts "error getting diffs: $err"
6511         return
6512     }
6513     set diffinhdr 0
6514     fconfigure $bdf -blocking 0
6515     set blobdifffd($ids) $bdf
6516     filerun $bdf [list getblobdiffline $bdf $diffids]
6517 }
6518
6519 proc setinlist {var i val} {
6520     global $var
6521
6522     while {[llength [set $var]] < $i} {
6523         lappend $var {}
6524     }
6525     if {[llength [set $var]] == $i} {
6526         lappend $var $val
6527     } else {
6528         lset $var $i $val
6529     }
6530 }
6531
6532 proc makediffhdr {fname ids} {
6533     global ctext curdiffstart treediffs
6534
6535     set i [lsearch -exact $treediffs($ids) $fname]
6536     if {$i >= 0} {
6537         setinlist difffilestart $i $curdiffstart
6538     }
6539     set l [expr {(78 - [string length $fname]) / 2}]
6540     set pad [string range "----------------------------------------" 1 $l]
6541     $ctext insert $curdiffstart "$pad $fname $pad" filesep
6542 }
6543
6544 proc getblobdiffline {bdf ids} {
6545     global diffids blobdifffd ctext curdiffstart
6546     global diffnexthead diffnextnote difffilestart
6547     global diffinhdr treediffs
6548
6549     set nr 0
6550     $ctext conf -state normal
6551     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6552         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6553             close $bdf
6554             return 0
6555         }
6556         if {![string compare -length 11 "diff --git " $line]} {
6557             # trim off "diff --git "
6558             set line [string range $line 11 end]
6559             set diffinhdr 1
6560             # start of a new file
6561             $ctext insert end "\n"
6562             set curdiffstart [$ctext index "end - 1c"]
6563             $ctext insert end "\n" filesep
6564             # If the name hasn't changed the length will be odd,
6565             # the middle char will be a space, and the two bits either
6566             # side will be a/name and b/name, or "a/name" and "b/name".
6567             # If the name has changed we'll get "rename from" and
6568             # "rename to" or "copy from" and "copy to" lines following this,
6569             # and we'll use them to get the filenames.
6570             # This complexity is necessary because spaces in the filename(s)
6571             # don't get escaped.
6572             set l [string length $line]
6573             set i [expr {$l / 2}]
6574             if {!(($l & 1) && [string index $line $i] eq " " &&
6575                   [string range $line 2 [expr {$i - 1}]] eq \
6576                       [string range $line [expr {$i + 3}] end])} {
6577                 continue
6578             }
6579             # unescape if quoted and chop off the a/ from the front
6580             if {[string index $line 0] eq "\""} {
6581                 set fname [string range [lindex $line 0] 2 end]
6582             } else {
6583                 set fname [string range $line 2 [expr {$i - 1}]]
6584             }
6585             makediffhdr $fname $ids
6586
6587         } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
6588                        $line match f1l f1c f2l f2c rest]} {
6589             $ctext insert end "$line\n" hunksep
6590             set diffinhdr 0
6591
6592         } elseif {$diffinhdr} {
6593             if {![string compare -length 12 "rename from " $line]} {
6594                 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
6595                 if {[string index $fname 0] eq "\""} {
6596                     set fname [lindex $fname 0]
6597                 }
6598                 set i [lsearch -exact $treediffs($ids) $fname]
6599                 if {$i >= 0} {
6600                     setinlist difffilestart $i $curdiffstart
6601                 }
6602             } elseif {![string compare -length 10 $line "rename to "] ||
6603                       ![string compare -length 8 $line "copy to "]} {
6604                 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
6605                 if {[string index $fname 0] eq "\""} {
6606                     set fname [lindex $fname 0]
6607                 }
6608                 makediffhdr $fname $ids
6609             } elseif {[string compare -length 3 $line "---"] == 0} {
6610                 # do nothing
6611                 continue
6612             } elseif {[string compare -length 3 $line "+++"] == 0} {
6613                 set diffinhdr 0
6614                 continue
6615             }
6616             $ctext insert end "$line\n" filesep
6617
6618         } else {
6619             set x [string range $line 0 0]
6620             if {$x == "-" || $x == "+"} {
6621                 set tag [expr {$x == "+"}]
6622                 $ctext insert end "$line\n" d$tag
6623             } elseif {$x == " "} {
6624                 $ctext insert end "$line\n"
6625             } else {
6626                 # "\ No newline at end of file",
6627                 # or something else we don't recognize
6628                 $ctext insert end "$line\n" hunksep
6629             }
6630         }
6631     }
6632     $ctext conf -state disabled
6633     if {[eof $bdf]} {
6634         close $bdf
6635         return 0
6636     }
6637     return [expr {$nr >= 1000? 2: 1}]
6638 }
6639
6640 proc changediffdisp {} {
6641     global ctext diffelide
6642
6643     $ctext tag conf d0 -elide [lindex $diffelide 0]
6644     $ctext tag conf d1 -elide [lindex $diffelide 1]
6645 }
6646
6647 proc highlightfile {loc cline} {
6648     global ctext cflist cflist_top
6649
6650     $ctext yview $loc
6651     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
6652     $cflist tag add highlight $cline.0 "$cline.0 lineend"
6653     $cflist see $cline.0
6654     set cflist_top $cline
6655 }
6656
6657 proc prevfile {} {
6658     global difffilestart ctext cmitmode
6659
6660     if {$cmitmode eq "tree"} return
6661     set prev 0.0
6662     set prevline 1
6663     set here [$ctext index @0,0]
6664     foreach loc $difffilestart {
6665         if {[$ctext compare $loc >= $here]} {
6666             highlightfile $prev $prevline
6667             return
6668         }
6669         set prev $loc
6670         incr prevline
6671     }
6672     highlightfile $prev $prevline
6673 }
6674
6675 proc nextfile {} {
6676     global difffilestart ctext cmitmode
6677
6678     if {$cmitmode eq "tree"} return
6679     set here [$ctext index @0,0]
6680     set line 1
6681     foreach loc $difffilestart {
6682         incr line
6683         if {[$ctext compare $loc > $here]} {
6684             highlightfile $loc $line
6685             return
6686         }
6687     }
6688 }
6689
6690 proc clear_ctext {{first 1.0}} {
6691     global ctext smarktop smarkbot
6692     global pendinglinks
6693
6694     set l [lindex [split $first .] 0]
6695     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6696         set smarktop $l
6697     }
6698     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6699         set smarkbot $l
6700     }
6701     $ctext delete $first end
6702     if {$first eq "1.0"} {
6703         catch {unset pendinglinks}
6704     }
6705 }
6706
6707 proc settabs {{firstab {}}} {
6708     global firsttabstop tabstop ctext have_tk85
6709
6710     if {$firstab ne {} && $have_tk85} {
6711         set firsttabstop $firstab
6712     }
6713     set w [font measure textfont "0"]
6714     if {$firsttabstop != 0} {
6715         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6716                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
6717     } elseif {$have_tk85 || $tabstop != 8} {
6718         $ctext conf -tabs [expr {$tabstop * $w}]
6719     } else {
6720         $ctext conf -tabs {}
6721     }
6722 }
6723
6724 proc incrsearch {name ix op} {
6725     global ctext searchstring searchdirn
6726
6727     $ctext tag remove found 1.0 end
6728     if {[catch {$ctext index anchor}]} {
6729         # no anchor set, use start of selection, or of visible area
6730         set sel [$ctext tag ranges sel]
6731         if {$sel ne {}} {
6732             $ctext mark set anchor [lindex $sel 0]
6733         } elseif {$searchdirn eq "-forwards"} {
6734             $ctext mark set anchor @0,0
6735         } else {
6736             $ctext mark set anchor @0,[winfo height $ctext]
6737         }
6738     }
6739     if {$searchstring ne {}} {
6740         set here [$ctext search $searchdirn -- $searchstring anchor]
6741         if {$here ne {}} {
6742             $ctext see $here
6743         }
6744         searchmarkvisible 1
6745     }
6746 }
6747
6748 proc dosearch {} {
6749     global sstring ctext searchstring searchdirn
6750
6751     focus $sstring
6752     $sstring icursor end
6753     set searchdirn -forwards
6754     if {$searchstring ne {}} {
6755         set sel [$ctext tag ranges sel]
6756         if {$sel ne {}} {
6757             set start "[lindex $sel 0] + 1c"
6758         } elseif {[catch {set start [$ctext index anchor]}]} {
6759             set start "@0,0"
6760         }
6761         set match [$ctext search -count mlen -- $searchstring $start]
6762         $ctext tag remove sel 1.0 end
6763         if {$match eq {}} {
6764             bell
6765             return
6766         }
6767         $ctext see $match
6768         set mend "$match + $mlen c"
6769         $ctext tag add sel $match $mend
6770         $ctext mark unset anchor
6771     }
6772 }
6773
6774 proc dosearchback {} {
6775     global sstring ctext searchstring searchdirn
6776
6777     focus $sstring
6778     $sstring icursor end
6779     set searchdirn -backwards
6780     if {$searchstring ne {}} {
6781         set sel [$ctext tag ranges sel]
6782         if {$sel ne {}} {
6783             set start [lindex $sel 0]
6784         } elseif {[catch {set start [$ctext index anchor]}]} {
6785             set start @0,[winfo height $ctext]
6786         }
6787         set match [$ctext search -backwards -count ml -- $searchstring $start]
6788         $ctext tag remove sel 1.0 end
6789         if {$match eq {}} {
6790             bell
6791             return
6792         }
6793         $ctext see $match
6794         set mend "$match + $ml c"
6795         $ctext tag add sel $match $mend
6796         $ctext mark unset anchor
6797     }
6798 }
6799
6800 proc searchmark {first last} {
6801     global ctext searchstring
6802
6803     set mend $first.0
6804     while {1} {
6805         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
6806         if {$match eq {}} break
6807         set mend "$match + $mlen c"
6808         $ctext tag add found $match $mend
6809     }
6810 }
6811
6812 proc searchmarkvisible {doall} {
6813     global ctext smarktop smarkbot
6814
6815     set topline [lindex [split [$ctext index @0,0] .] 0]
6816     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
6817     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
6818         # no overlap with previous
6819         searchmark $topline $botline
6820         set smarktop $topline
6821         set smarkbot $botline
6822     } else {
6823         if {$topline < $smarktop} {
6824             searchmark $topline [expr {$smarktop-1}]
6825             set smarktop $topline
6826         }
6827         if {$botline > $smarkbot} {
6828             searchmark [expr {$smarkbot+1}] $botline
6829             set smarkbot $botline
6830         }
6831     }
6832 }
6833
6834 proc scrolltext {f0 f1} {
6835     global searchstring
6836
6837     .bleft.bottom.sb set $f0 $f1
6838     if {$searchstring ne {}} {
6839         searchmarkvisible 0
6840     }
6841 }
6842
6843 proc setcoords {} {
6844     global linespc charspc canvx0 canvy0
6845     global xspc1 xspc2 lthickness
6846
6847     set linespc [font metrics mainfont -linespace]
6848     set charspc [font measure mainfont "m"]
6849     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
6850     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
6851     set lthickness [expr {int($linespc / 9) + 1}]
6852     set xspc1(0) $linespc
6853     set xspc2 $linespc
6854 }
6855
6856 proc redisplay {} {
6857     global canv
6858     global selectedline
6859
6860     set ymax [lindex [$canv cget -scrollregion] 3]
6861     if {$ymax eq {} || $ymax == 0} return
6862     set span [$canv yview]
6863     clear_display
6864     setcanvscroll
6865     allcanvs yview moveto [lindex $span 0]
6866     drawvisible
6867     if {[info exists selectedline]} {
6868         selectline $selectedline 0
6869         allcanvs yview moveto [lindex $span 0]
6870     }
6871 }
6872
6873 proc parsefont {f n} {
6874     global fontattr
6875
6876     set fontattr($f,family) [lindex $n 0]
6877     set s [lindex $n 1]
6878     if {$s eq {} || $s == 0} {
6879         set s 10
6880     } elseif {$s < 0} {
6881         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
6882     }
6883     set fontattr($f,size) $s
6884     set fontattr($f,weight) normal
6885     set fontattr($f,slant) roman
6886     foreach style [lrange $n 2 end] {
6887         switch -- $style {
6888             "normal" -
6889             "bold"   {set fontattr($f,weight) $style}
6890             "roman" -
6891             "italic" {set fontattr($f,slant) $style}
6892         }
6893     }
6894 }
6895
6896 proc fontflags {f {isbold 0}} {
6897     global fontattr
6898
6899     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
6900                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
6901                 -slant $fontattr($f,slant)]
6902 }
6903
6904 proc fontname {f} {
6905     global fontattr
6906
6907     set n [list $fontattr($f,family) $fontattr($f,size)]
6908     if {$fontattr($f,weight) eq "bold"} {
6909         lappend n "bold"
6910     }
6911     if {$fontattr($f,slant) eq "italic"} {
6912         lappend n "italic"
6913     }
6914     return $n
6915 }
6916
6917 proc incrfont {inc} {
6918     global mainfont textfont ctext canv cflist showrefstop
6919     global stopped entries fontattr
6920
6921     unmarkmatches
6922     set s $fontattr(mainfont,size)
6923     incr s $inc
6924     if {$s < 1} {
6925         set s 1
6926     }
6927     set fontattr(mainfont,size) $s
6928     font config mainfont -size $s
6929     font config mainfontbold -size $s
6930     set mainfont [fontname mainfont]
6931     set s $fontattr(textfont,size)
6932     incr s $inc
6933     if {$s < 1} {
6934         set s 1
6935     }
6936     set fontattr(textfont,size) $s
6937     font config textfont -size $s
6938     font config textfontbold -size $s
6939     set textfont [fontname textfont]
6940     setcoords
6941     settabs
6942     redisplay
6943 }
6944
6945 proc clearsha1 {} {
6946     global sha1entry sha1string
6947     if {[string length $sha1string] == 40} {
6948         $sha1entry delete 0 end
6949     }
6950 }
6951
6952 proc sha1change {n1 n2 op} {
6953     global sha1string currentid sha1but
6954     if {$sha1string == {}
6955         || ([info exists currentid] && $sha1string == $currentid)} {
6956         set state disabled
6957     } else {
6958         set state normal
6959     }
6960     if {[$sha1but cget -state] == $state} return
6961     if {$state == "normal"} {
6962         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
6963     } else {
6964         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
6965     }
6966 }
6967
6968 proc gotocommit {} {
6969     global sha1string tagids headids curview varcid
6970
6971     if {$sha1string == {}
6972         || ([info exists currentid] && $sha1string == $currentid)} return
6973     if {[info exists tagids($sha1string)]} {
6974         set id $tagids($sha1string)
6975     } elseif {[info exists headids($sha1string)]} {
6976         set id $headids($sha1string)
6977     } else {
6978         set id [string tolower $sha1string]
6979         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
6980             set matches [array names varcid "$curview,$id*"]
6981             if {$matches ne {}} {
6982                 if {[llength $matches] > 1} {
6983                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
6984                     return
6985                 }
6986                 set id [lindex [split [lindex $matches 0] ","] 1]
6987             }
6988         }
6989     }
6990     if {[commitinview $id $curview]} {
6991         selectline [rowofcommit $id] 1
6992         return
6993     }
6994     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
6995         set msg [mc "SHA1 id %s is not known" $sha1string]
6996     } else {
6997         set msg [mc "Tag/Head %s is not known" $sha1string]
6998     }
6999     error_popup $msg
7000 }
7001
7002 proc lineenter {x y id} {
7003     global hoverx hovery hoverid hovertimer
7004     global commitinfo canv
7005
7006     if {![info exists commitinfo($id)] && ![getcommit $id]} return
7007     set hoverx $x
7008     set hovery $y
7009     set hoverid $id
7010     if {[info exists hovertimer]} {
7011         after cancel $hovertimer
7012     }
7013     set hovertimer [after 500 linehover]
7014     $canv delete hover
7015 }
7016
7017 proc linemotion {x y id} {
7018     global hoverx hovery hoverid hovertimer
7019
7020     if {[info exists hoverid] && $id == $hoverid} {
7021         set hoverx $x
7022         set hovery $y
7023         if {[info exists hovertimer]} {
7024             after cancel $hovertimer
7025         }
7026         set hovertimer [after 500 linehover]
7027     }
7028 }
7029
7030 proc lineleave {id} {
7031     global hoverid hovertimer canv
7032
7033     if {[info exists hoverid] && $id == $hoverid} {
7034         $canv delete hover
7035         if {[info exists hovertimer]} {
7036             after cancel $hovertimer
7037             unset hovertimer
7038         }
7039         unset hoverid
7040     }
7041 }
7042
7043 proc linehover {} {
7044     global hoverx hovery hoverid hovertimer
7045     global canv linespc lthickness
7046     global commitinfo
7047
7048     set text [lindex $commitinfo($hoverid) 0]
7049     set ymax [lindex [$canv cget -scrollregion] 3]
7050     if {$ymax == {}} return
7051     set yfrac [lindex [$canv yview] 0]
7052     set x [expr {$hoverx + 2 * $linespc}]
7053     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
7054     set x0 [expr {$x - 2 * $lthickness}]
7055     set y0 [expr {$y - 2 * $lthickness}]
7056     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
7057     set y1 [expr {$y + $linespc + 2 * $lthickness}]
7058     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
7059                -fill \#ffff80 -outline black -width 1 -tags hover]
7060     $canv raise $t
7061     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
7062                -font mainfont]
7063     $canv raise $t
7064 }
7065
7066 proc clickisonarrow {id y} {
7067     global lthickness
7068
7069     set ranges [rowranges $id]
7070     set thresh [expr {2 * $lthickness + 6}]
7071     set n [expr {[llength $ranges] - 1}]
7072     for {set i 1} {$i < $n} {incr i} {
7073         set row [lindex $ranges $i]
7074         if {abs([yc $row] - $y) < $thresh} {
7075             return $i
7076         }
7077     }
7078     return {}
7079 }
7080
7081 proc arrowjump {id n y} {
7082     global canv
7083
7084     # 1 <-> 2, 3 <-> 4, etc...
7085     set n [expr {(($n - 1) ^ 1) + 1}]
7086     set row [lindex [rowranges $id] $n]
7087     set yt [yc $row]
7088     set ymax [lindex [$canv cget -scrollregion] 3]
7089     if {$ymax eq {} || $ymax <= 0} return
7090     set view [$canv yview]
7091     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
7092     set yfrac [expr {$yt / $ymax - $yspan / 2}]
7093     if {$yfrac < 0} {
7094         set yfrac 0
7095     }
7096     allcanvs yview moveto $yfrac
7097 }
7098
7099 proc lineclick {x y id isnew} {
7100     global ctext commitinfo children canv thickerline curview
7101
7102     if {![info exists commitinfo($id)] && ![getcommit $id]} return
7103     unmarkmatches
7104     unselectline
7105     normalline
7106     $canv delete hover
7107     # draw this line thicker than normal
7108     set thickerline $id
7109     drawlines $id
7110     if {$isnew} {
7111         set ymax [lindex [$canv cget -scrollregion] 3]
7112         if {$ymax eq {}} return
7113         set yfrac [lindex [$canv yview] 0]
7114         set y [expr {$y + $yfrac * $ymax}]
7115     }
7116     set dirn [clickisonarrow $id $y]
7117     if {$dirn ne {}} {
7118         arrowjump $id $dirn $y
7119         return
7120     }
7121
7122     if {$isnew} {
7123         addtohistory [list lineclick $x $y $id 0]
7124     }
7125     # fill the details pane with info about this line
7126     $ctext conf -state normal
7127     clear_ctext
7128     settabs 0
7129     $ctext insert end "[mc "Parent"]:\t"
7130     $ctext insert end $id link0
7131     setlink $id link0
7132     set info $commitinfo($id)
7133     $ctext insert end "\n\t[lindex $info 0]\n"
7134     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
7135     set date [formatdate [lindex $info 2]]
7136     $ctext insert end "\t[mc "Date"]:\t$date\n"
7137     set kids $children($curview,$id)
7138     if {$kids ne {}} {
7139         $ctext insert end "\n[mc "Children"]:"
7140         set i 0
7141         foreach child $kids {
7142             incr i
7143             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
7144             set info $commitinfo($child)
7145             $ctext insert end "\n\t"
7146             $ctext insert end $child link$i
7147             setlink $child link$i
7148             $ctext insert end "\n\t[lindex $info 0]"
7149             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
7150             set date [formatdate [lindex $info 2]]
7151             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
7152         }
7153     }
7154     $ctext conf -state disabled
7155     init_flist {}
7156 }
7157
7158 proc normalline {} {
7159     global thickerline
7160     if {[info exists thickerline]} {
7161         set id $thickerline
7162         unset thickerline
7163         drawlines $id
7164     }
7165 }
7166
7167 proc selbyid {id} {
7168     global curview
7169     if {[commitinview $id $curview]} {
7170         selectline [rowofcommit $id] 1
7171     }
7172 }
7173
7174 proc mstime {} {
7175     global startmstime
7176     if {![info exists startmstime]} {
7177         set startmstime [clock clicks -milliseconds]
7178     }
7179     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
7180 }
7181
7182 proc rowmenu {x y id} {
7183     global rowctxmenu selectedline rowmenuid curview
7184     global nullid nullid2 fakerowmenu mainhead
7185
7186     stopfinding
7187     set rowmenuid $id
7188     if {![info exists selectedline]
7189         || [rowofcommit $id] eq $selectedline} {
7190         set state disabled
7191     } else {
7192         set state normal
7193     }
7194     if {$id ne $nullid && $id ne $nullid2} {
7195         set menu $rowctxmenu
7196         if {$mainhead ne {}} {
7197             $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
7198         } else {
7199             $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
7200         }
7201     } else {
7202         set menu $fakerowmenu
7203     }
7204     $menu entryconfigure [mc "Diff this -> selected"] -state $state
7205     $menu entryconfigure [mc "Diff selected -> this"] -state $state
7206     $menu entryconfigure [mc "Make patch"] -state $state
7207     tk_popup $menu $x $y
7208 }
7209
7210 proc diffvssel {dirn} {
7211     global rowmenuid selectedline
7212
7213     if {![info exists selectedline]} return
7214     if {$dirn} {
7215         set oldid [commitonrow $selectedline]
7216         set newid $rowmenuid
7217     } else {
7218         set oldid $rowmenuid
7219         set newid [commitonrow $selectedline]
7220     }
7221     addtohistory [list doseldiff $oldid $newid]
7222     doseldiff $oldid $newid
7223 }
7224
7225 proc doseldiff {oldid newid} {
7226     global ctext
7227     global commitinfo
7228
7229     $ctext conf -state normal
7230     clear_ctext
7231     init_flist [mc "Top"]
7232     $ctext insert end "[mc "From"] "
7233     $ctext insert end $oldid link0
7234     setlink $oldid link0
7235     $ctext insert end "\n     "
7236     $ctext insert end [lindex $commitinfo($oldid) 0]
7237     $ctext insert end "\n\n[mc "To"]   "
7238     $ctext insert end $newid link1
7239     setlink $newid link1
7240     $ctext insert end "\n     "
7241     $ctext insert end [lindex $commitinfo($newid) 0]
7242     $ctext insert end "\n"
7243     $ctext conf -state disabled
7244     $ctext tag remove found 1.0 end
7245     startdiff [list $oldid $newid]
7246 }
7247
7248 proc mkpatch {} {
7249     global rowmenuid currentid commitinfo patchtop patchnum
7250
7251     if {![info exists currentid]} return
7252     set oldid $currentid
7253     set oldhead [lindex $commitinfo($oldid) 0]
7254     set newid $rowmenuid
7255     set newhead [lindex $commitinfo($newid) 0]
7256     set top .patch
7257     set patchtop $top
7258     catch {destroy $top}
7259     toplevel $top
7260     label $top.title -text [mc "Generate patch"]
7261     grid $top.title - -pady 10
7262     label $top.from -text [mc "From:"]
7263     entry $top.fromsha1 -width 40 -relief flat
7264     $top.fromsha1 insert 0 $oldid
7265     $top.fromsha1 conf -state readonly
7266     grid $top.from $top.fromsha1 -sticky w
7267     entry $top.fromhead -width 60 -relief flat
7268     $top.fromhead insert 0 $oldhead
7269     $top.fromhead conf -state readonly
7270     grid x $top.fromhead -sticky w
7271     label $top.to -text [mc "To:"]
7272     entry $top.tosha1 -width 40 -relief flat
7273     $top.tosha1 insert 0 $newid
7274     $top.tosha1 conf -state readonly
7275     grid $top.to $top.tosha1 -sticky w
7276     entry $top.tohead -width 60 -relief flat
7277     $top.tohead insert 0 $newhead
7278     $top.tohead conf -state readonly
7279     grid x $top.tohead -sticky w
7280     button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
7281     grid $top.rev x -pady 10
7282     label $top.flab -text [mc "Output file:"]
7283     entry $top.fname -width 60
7284     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
7285     incr patchnum
7286     grid $top.flab $top.fname -sticky w
7287     frame $top.buts
7288     button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
7289     button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
7290     grid $top.buts.gen $top.buts.can
7291     grid columnconfigure $top.buts 0 -weight 1 -uniform a
7292     grid columnconfigure $top.buts 1 -weight 1 -uniform a
7293     grid $top.buts - -pady 10 -sticky ew
7294     focus $top.fname
7295 }
7296
7297 proc mkpatchrev {} {
7298     global patchtop
7299
7300     set oldid [$patchtop.fromsha1 get]
7301     set oldhead [$patchtop.fromhead get]
7302     set newid [$patchtop.tosha1 get]
7303     set newhead [$patchtop.tohead get]
7304     foreach e [list fromsha1 fromhead tosha1 tohead] \
7305             v [list $newid $newhead $oldid $oldhead] {
7306         $patchtop.$e conf -state normal
7307         $patchtop.$e delete 0 end
7308         $patchtop.$e insert 0 $v
7309         $patchtop.$e conf -state readonly
7310     }
7311 }
7312
7313 proc mkpatchgo {} {
7314     global patchtop nullid nullid2
7315
7316     set oldid [$patchtop.fromsha1 get]
7317     set newid [$patchtop.tosha1 get]
7318     set fname [$patchtop.fname get]
7319     set cmd [diffcmd [list $oldid $newid] -p]
7320     # trim off the initial "|"
7321     set cmd [lrange $cmd 1 end]
7322     lappend cmd >$fname &
7323     if {[catch {eval exec $cmd} err]} {
7324         error_popup "[mc "Error creating patch:"] $err"
7325     }
7326     catch {destroy $patchtop}
7327     unset patchtop
7328 }
7329
7330 proc mkpatchcan {} {
7331     global patchtop
7332
7333     catch {destroy $patchtop}
7334     unset patchtop
7335 }
7336
7337 proc mktag {} {
7338     global rowmenuid mktagtop commitinfo
7339
7340     set top .maketag
7341     set mktagtop $top
7342     catch {destroy $top}
7343     toplevel $top
7344     label $top.title -text [mc "Create tag"]
7345     grid $top.title - -pady 10
7346     label $top.id -text [mc "ID:"]
7347     entry $top.sha1 -width 40 -relief flat
7348     $top.sha1 insert 0 $rowmenuid
7349     $top.sha1 conf -state readonly
7350     grid $top.id $top.sha1 -sticky w
7351     entry $top.head -width 60 -relief flat
7352     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7353     $top.head conf -state readonly
7354     grid x $top.head -sticky w
7355     label $top.tlab -text [mc "Tag name:"]
7356     entry $top.tag -width 60
7357     grid $top.tlab $top.tag -sticky w
7358     frame $top.buts
7359     button $top.buts.gen -text [mc "Create"] -command mktaggo
7360     button $top.buts.can -text [mc "Cancel"] -command mktagcan
7361     grid $top.buts.gen $top.buts.can
7362     grid columnconfigure $top.buts 0 -weight 1 -uniform a
7363     grid columnconfigure $top.buts 1 -weight 1 -uniform a
7364     grid $top.buts - -pady 10 -sticky ew
7365     focus $top.tag
7366 }
7367
7368 proc domktag {} {
7369     global mktagtop env tagids idtags
7370
7371     set id [$mktagtop.sha1 get]
7372     set tag [$mktagtop.tag get]
7373     if {$tag == {}} {
7374         error_popup [mc "No tag name specified"]
7375         return
7376     }
7377     if {[info exists tagids($tag)]} {
7378         error_popup [mc "Tag \"%s\" already exists" $tag]
7379         return
7380     }
7381     if {[catch {
7382         exec git tag $tag $id
7383     } err]} {
7384         error_popup "[mc "Error creating tag:"] $err"
7385         return
7386     }
7387
7388     set tagids($tag) $id
7389     lappend idtags($id) $tag
7390     redrawtags $id
7391     addedtag $id
7392     dispneartags 0
7393     run refill_reflist
7394 }
7395
7396 proc redrawtags {id} {
7397     global canv linehtag idpos currentid curview
7398     global canvxmax iddrawn
7399
7400     if {![commitinview $id $curview]} return
7401     if {![info exists iddrawn($id)]} return
7402     set row [rowofcommit $id]
7403     $canv delete tag.$id
7404     set xt [eval drawtags $id $idpos($id)]
7405     $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
7406     set text [$canv itemcget $linehtag($row) -text]
7407     set font [$canv itemcget $linehtag($row) -font]
7408     set xr [expr {$xt + [font measure $font $text]}]
7409     if {$xr > $canvxmax} {
7410         set canvxmax $xr
7411         setcanvscroll
7412     }
7413     if {[info exists currentid] && $currentid == $id} {
7414         make_secsel $row
7415     }
7416 }
7417
7418 proc mktagcan {} {
7419     global mktagtop
7420
7421     catch {destroy $mktagtop}
7422     unset mktagtop
7423 }
7424
7425 proc mktaggo {} {
7426     domktag
7427     mktagcan
7428 }
7429
7430 proc writecommit {} {
7431     global rowmenuid wrcomtop commitinfo wrcomcmd
7432
7433     set top .writecommit
7434     set wrcomtop $top
7435     catch {destroy $top}
7436     toplevel $top
7437     label $top.title -text [mc "Write commit to file"]
7438     grid $top.title - -pady 10
7439     label $top.id -text [mc "ID:"]
7440     entry $top.sha1 -width 40 -relief flat
7441     $top.sha1 insert 0 $rowmenuid
7442     $top.sha1 conf -state readonly
7443     grid $top.id $top.sha1 -sticky w
7444     entry $top.head -width 60 -relief flat
7445     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7446     $top.head conf -state readonly
7447     grid x $top.head -sticky w
7448     label $top.clab -text [mc "Command:"]
7449     entry $top.cmd -width 60 -textvariable wrcomcmd
7450     grid $top.clab $top.cmd -sticky w -pady 10
7451     label $top.flab -text [mc "Output file:"]
7452     entry $top.fname -width 60
7453     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
7454     grid $top.flab $top.fname -sticky w
7455     frame $top.buts
7456     button $top.buts.gen -text [mc "Write"] -command wrcomgo
7457     button $top.buts.can -text [mc "Cancel"] -command wrcomcan
7458     grid $top.buts.gen $top.buts.can
7459     grid columnconfigure $top.buts 0 -weight 1 -uniform a
7460     grid columnconfigure $top.buts 1 -weight 1 -uniform a
7461     grid $top.buts - -pady 10 -sticky ew
7462     focus $top.fname
7463 }
7464
7465 proc wrcomgo {} {
7466     global wrcomtop
7467
7468     set id [$wrcomtop.sha1 get]
7469     set cmd "echo $id | [$wrcomtop.cmd get]"
7470     set fname [$wrcomtop.fname get]
7471     if {[catch {exec sh -c $cmd >$fname &} err]} {
7472         error_popup "[mc "Error writing commit:"] $err"
7473     }
7474     catch {destroy $wrcomtop}
7475     unset wrcomtop
7476 }
7477
7478 proc wrcomcan {} {
7479     global wrcomtop
7480
7481     catch {destroy $wrcomtop}
7482     unset wrcomtop
7483 }
7484
7485 proc mkbranch {} {
7486     global rowmenuid mkbrtop
7487
7488     set top .makebranch
7489     catch {destroy $top}
7490     toplevel $top
7491     label $top.title -text [mc "Create new branch"]
7492     grid $top.title - -pady 10
7493     label $top.id -text [mc "ID:"]
7494     entry $top.sha1 -width 40 -relief flat
7495     $top.sha1 insert 0 $rowmenuid
7496     $top.sha1 conf -state readonly
7497     grid $top.id $top.sha1 -sticky w
7498     label $top.nlab -text [mc "Name:"]
7499     entry $top.name -width 40
7500     grid $top.nlab $top.name -sticky w
7501     frame $top.buts
7502     button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
7503     button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
7504     grid $top.buts.go $top.buts.can
7505     grid columnconfigure $top.buts 0 -weight 1 -uniform a
7506     grid columnconfigure $top.buts 1 -weight 1 -uniform a
7507     grid $top.buts - -pady 10 -sticky ew
7508     focus $top.name
7509 }
7510
7511 proc mkbrgo {top} {
7512     global headids idheads
7513
7514     set name [$top.name get]
7515     set id [$top.sha1 get]
7516     if {$name eq {}} {
7517         error_popup [mc "Please specify a name for the new branch"]
7518         return
7519     }
7520     catch {destroy $top}
7521     nowbusy newbranch
7522     update
7523     if {[catch {
7524         exec git branch $name $id
7525     } err]} {
7526         notbusy newbranch
7527         error_popup $err
7528     } else {
7529         set headids($name) $id
7530         lappend idheads($id) $name
7531         addedhead $id $name
7532         notbusy newbranch
7533         redrawtags $id
7534         dispneartags 0
7535         run refill_reflist
7536     }
7537 }
7538
7539 proc cherrypick {} {
7540     global rowmenuid curview
7541     global mainhead mainheadid
7542
7543     set oldhead [exec git rev-parse HEAD]
7544     set dheads [descheads $rowmenuid]
7545     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
7546         set ok [confirm_popup [mc "Commit %s is already\
7547                 included in branch %s -- really re-apply it?" \
7548                                    [string range $rowmenuid 0 7] $mainhead]]
7549         if {!$ok} return
7550     }
7551     nowbusy cherrypick [mc "Cherry-picking"]
7552     update
7553     # Unfortunately git-cherry-pick writes stuff to stderr even when
7554     # no error occurs, and exec takes that as an indication of error...
7555     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
7556         notbusy cherrypick
7557         error_popup $err
7558         return
7559     }
7560     set newhead [exec git rev-parse HEAD]
7561     if {$newhead eq $oldhead} {
7562         notbusy cherrypick
7563         error_popup [mc "No changes committed"]
7564         return
7565     }
7566     addnewchild $newhead $oldhead
7567     if {[commitinview $oldhead $curview]} {
7568         insertrow $newhead $oldhead $curview
7569         if {$mainhead ne {}} {
7570             movehead $newhead $mainhead
7571             movedhead $newhead $mainhead
7572             set mainheadid $newhead
7573         }
7574         redrawtags $oldhead
7575         redrawtags $newhead
7576         selbyid $newhead
7577     }
7578     notbusy cherrypick
7579 }
7580
7581 proc resethead {} {
7582     global mainhead rowmenuid confirm_ok resettype
7583
7584     set confirm_ok 0
7585     set w ".confirmreset"
7586     toplevel $w
7587     wm transient $w .
7588     wm title $w [mc "Confirm reset"]
7589     message $w.m -text \
7590         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
7591         -justify center -aspect 1000
7592     pack $w.m -side top -fill x -padx 20 -pady 20
7593     frame $w.f -relief sunken -border 2
7594     message $w.f.rt -text [mc "Reset type:"] -aspect 1000
7595     grid $w.f.rt -sticky w
7596     set resettype mixed
7597     radiobutton $w.f.soft -value soft -variable resettype -justify left \
7598         -text [mc "Soft: Leave working tree and index untouched"]
7599     grid $w.f.soft -sticky w
7600     radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
7601         -text [mc "Mixed: Leave working tree untouched, reset index"]
7602     grid $w.f.mixed -sticky w
7603     radiobutton $w.f.hard -value hard -variable resettype -justify left \
7604         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
7605     grid $w.f.hard -sticky w
7606     pack $w.f -side top -fill x
7607     button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
7608     pack $w.ok -side left -fill x -padx 20 -pady 20
7609     button $w.cancel -text [mc Cancel] -command "destroy $w"
7610     pack $w.cancel -side right -fill x -padx 20 -pady 20
7611     bind $w <Visibility> "grab $w; focus $w"
7612     tkwait window $w
7613     if {!$confirm_ok} return
7614     if {[catch {set fd [open \
7615             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
7616         error_popup $err
7617     } else {
7618         dohidelocalchanges
7619         filerun $fd [list readresetstat $fd]
7620         nowbusy reset [mc "Resetting"]
7621         selbyid $rowmenuid
7622     }
7623 }
7624
7625 proc readresetstat {fd} {
7626     global mainhead mainheadid showlocalchanges rprogcoord
7627
7628     if {[gets $fd line] >= 0} {
7629         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7630             set rprogcoord [expr {1.0 * $m / $n}]
7631             adjustprogress
7632         }
7633         return 1
7634     }
7635     set rprogcoord 0
7636     adjustprogress
7637     notbusy reset
7638     if {[catch {close $fd} err]} {
7639         error_popup $err
7640     }
7641     set oldhead $mainheadid
7642     set newhead [exec git rev-parse HEAD]
7643     if {$newhead ne $oldhead} {
7644         movehead $newhead $mainhead
7645         movedhead $newhead $mainhead
7646         set mainheadid $newhead
7647         redrawtags $oldhead
7648         redrawtags $newhead
7649     }
7650     if {$showlocalchanges} {
7651         doshowlocalchanges
7652     }
7653     return 0
7654 }
7655
7656 # context menu for a head
7657 proc headmenu {x y id head} {
7658     global headmenuid headmenuhead headctxmenu mainhead
7659
7660     stopfinding
7661     set headmenuid $id
7662     set headmenuhead $head
7663     set state normal
7664     if {$head eq $mainhead} {
7665         set state disabled
7666     }
7667     $headctxmenu entryconfigure 0 -state $state
7668     $headctxmenu entryconfigure 1 -state $state
7669     tk_popup $headctxmenu $x $y
7670 }
7671
7672 proc cobranch {} {
7673     global headmenuid headmenuhead mainhead headids
7674     global showlocalchanges mainheadid
7675
7676     # check the tree is clean first??
7677     nowbusy checkout [mc "Checking out"]
7678     update
7679     dohidelocalchanges
7680     if {[catch {
7681         set fd [open [list | git checkout $headmenuhead 2>@1] r]
7682     } err]} {
7683         notbusy checkout
7684         error_popup $err
7685         if {$showlocalchanges} {
7686             dodiffindex
7687         }
7688     } else {
7689         filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
7690     }
7691 }
7692
7693 proc readcheckoutstat {fd newhead newheadid} {
7694     global mainhead mainheadid headids showlocalchanges progresscoords
7695
7696     if {[gets $fd line] >= 0} {
7697         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7698             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
7699             adjustprogress
7700         }
7701         return 1
7702     }
7703     set progresscoords {0 0}
7704     adjustprogress
7705     notbusy checkout
7706     if {[catch {close $fd} err]} {
7707         error_popup $err
7708     }
7709     set oldmainhead $mainhead
7710     set mainhead $newhead
7711     set mainheadid $newheadid
7712     if {[info exists headids($oldmainhead)]} {
7713         redrawtags $headids($oldmainhead)
7714     }
7715     redrawtags $newheadid
7716     selbyid $newheadid
7717     if {$showlocalchanges} {
7718         dodiffindex
7719     }
7720 }
7721
7722 proc rmbranch {} {
7723     global headmenuid headmenuhead mainhead
7724     global idheads
7725
7726     set head $headmenuhead
7727     set id $headmenuid
7728     # this check shouldn't be needed any more...
7729     if {$head eq $mainhead} {
7730         error_popup [mc "Cannot delete the currently checked-out branch"]
7731         return
7732     }
7733     set dheads [descheads $id]
7734     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7735         # the stuff on this branch isn't on any other branch
7736         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7737                         branch.\nReally delete branch %s?" $head $head]]} return
7738     }
7739     nowbusy rmbranch
7740     update
7741     if {[catch {exec git branch -D $head} err]} {
7742         notbusy rmbranch
7743         error_popup $err
7744         return
7745     }
7746     removehead $id $head
7747     removedhead $id $head
7748     redrawtags $id
7749     notbusy rmbranch
7750     dispneartags 0
7751     run refill_reflist
7752 }
7753
7754 # Display a list of tags and heads
7755 proc showrefs {} {
7756     global showrefstop bgcolor fgcolor selectbgcolor
7757     global bglist fglist reflistfilter reflist maincursor
7758
7759     set top .showrefs
7760     set showrefstop $top
7761     if {[winfo exists $top]} {
7762         raise $top
7763         refill_reflist
7764         return
7765     }
7766     toplevel $top
7767     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
7768     text $top.list -background $bgcolor -foreground $fgcolor \
7769         -selectbackground $selectbgcolor -font mainfont \
7770         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7771         -width 30 -height 20 -cursor $maincursor \
7772         -spacing1 1 -spacing3 1 -state disabled
7773     $top.list tag configure highlight -background $selectbgcolor
7774     lappend bglist $top.list
7775     lappend fglist $top.list
7776     scrollbar $top.ysb -command "$top.list yview" -orient vertical
7777     scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7778     grid $top.list $top.ysb -sticky nsew
7779     grid $top.xsb x -sticky ew
7780     frame $top.f
7781     label $top.f.l -text "[mc "Filter"]: "
7782     entry $top.f.e -width 20 -textvariable reflistfilter
7783     set reflistfilter "*"
7784     trace add variable reflistfilter write reflistfilter_change
7785     pack $top.f.e -side right -fill x -expand 1
7786     pack $top.f.l -side left
7787     grid $top.f - -sticky ew -pady 2
7788     button $top.close -command [list destroy $top] -text [mc "Close"]
7789     grid $top.close -
7790     grid columnconfigure $top 0 -weight 1
7791     grid rowconfigure $top 0 -weight 1
7792     bind $top.list <1> {break}
7793     bind $top.list <B1-Motion> {break}
7794     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7795     set reflist {}
7796     refill_reflist
7797 }
7798
7799 proc sel_reflist {w x y} {
7800     global showrefstop reflist headids tagids otherrefids
7801
7802     if {![winfo exists $showrefstop]} return
7803     set l [lindex [split [$w index "@$x,$y"] "."] 0]
7804     set ref [lindex $reflist [expr {$l-1}]]
7805     set n [lindex $ref 0]
7806     switch -- [lindex $ref 1] {
7807         "H" {selbyid $headids($n)}
7808         "T" {selbyid $tagids($n)}
7809         "o" {selbyid $otherrefids($n)}
7810     }
7811     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7812 }
7813
7814 proc unsel_reflist {} {
7815     global showrefstop
7816
7817     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7818     $showrefstop.list tag remove highlight 0.0 end
7819 }
7820
7821 proc reflistfilter_change {n1 n2 op} {
7822     global reflistfilter
7823
7824     after cancel refill_reflist
7825     after 200 refill_reflist
7826 }
7827
7828 proc refill_reflist {} {
7829     global reflist reflistfilter showrefstop headids tagids otherrefids
7830     global curview commitinterest
7831
7832     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7833     set refs {}
7834     foreach n [array names headids] {
7835         if {[string match $reflistfilter $n]} {
7836             if {[commitinview $headids($n) $curview]} {
7837                 lappend refs [list $n H]
7838             } else {
7839                 set commitinterest($headids($n)) {run refill_reflist}
7840             }
7841         }
7842     }
7843     foreach n [array names tagids] {
7844         if {[string match $reflistfilter $n]} {
7845             if {[commitinview $tagids($n) $curview]} {
7846                 lappend refs [list $n T]
7847             } else {
7848                 set commitinterest($tagids($n)) {run refill_reflist}
7849             }
7850         }
7851     }
7852     foreach n [array names otherrefids] {
7853         if {[string match $reflistfilter $n]} {
7854             if {[commitinview $otherrefids($n) $curview]} {
7855                 lappend refs [list $n o]
7856             } else {
7857                 set commitinterest($otherrefids($n)) {run refill_reflist}
7858             }
7859         }
7860     }
7861     set refs [lsort -index 0 $refs]
7862     if {$refs eq $reflist} return
7863
7864     # Update the contents of $showrefstop.list according to the
7865     # differences between $reflist (old) and $refs (new)
7866     $showrefstop.list conf -state normal
7867     $showrefstop.list insert end "\n"
7868     set i 0
7869     set j 0
7870     while {$i < [llength $reflist] || $j < [llength $refs]} {
7871         if {$i < [llength $reflist]} {
7872             if {$j < [llength $refs]} {
7873                 set cmp [string compare [lindex $reflist $i 0] \
7874                              [lindex $refs $j 0]]
7875                 if {$cmp == 0} {
7876                     set cmp [string compare [lindex $reflist $i 1] \
7877                                  [lindex $refs $j 1]]
7878                 }
7879             } else {
7880                 set cmp -1
7881             }
7882         } else {
7883             set cmp 1
7884         }
7885         switch -- $cmp {
7886             -1 {
7887                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
7888                 incr i
7889             }
7890             0 {
7891                 incr i
7892                 incr j
7893             }
7894             1 {
7895                 set l [expr {$j + 1}]
7896                 $showrefstop.list image create $l.0 -align baseline \
7897                     -image reficon-[lindex $refs $j 1] -padx 2
7898                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
7899                 incr j
7900             }
7901         }
7902     }
7903     set reflist $refs
7904     # delete last newline
7905     $showrefstop.list delete end-2c end-1c
7906     $showrefstop.list conf -state disabled
7907 }
7908
7909 # Stuff for finding nearby tags
7910 proc getallcommits {} {
7911     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
7912     global idheads idtags idotherrefs allparents tagobjid
7913
7914     if {![info exists allcommits]} {
7915         set nextarc 0
7916         set allcommits 0
7917         set seeds {}
7918         set allcwait 0
7919         set cachedarcs 0
7920         set allccache [file join [gitdir] "gitk.cache"]
7921         if {![catch {
7922             set f [open $allccache r]
7923             set allcwait 1
7924             getcache $f
7925         }]} return
7926     }
7927
7928     if {$allcwait} {
7929         return
7930     }
7931     set cmd [list | git rev-list --parents]
7932     set allcupdate [expr {$seeds ne {}}]
7933     if {!$allcupdate} {
7934         set ids "--all"
7935     } else {
7936         set refs [concat [array names idheads] [array names idtags] \
7937                       [array names idotherrefs]]
7938         set ids {}
7939         set tagobjs {}
7940         foreach name [array names tagobjid] {
7941             lappend tagobjs $tagobjid($name)
7942         }
7943         foreach id [lsort -unique $refs] {
7944             if {![info exists allparents($id)] &&
7945                 [lsearch -exact $tagobjs $id] < 0} {
7946                 lappend ids $id
7947             }
7948         }
7949         if {$ids ne {}} {
7950             foreach id $seeds {
7951                 lappend ids "^$id"
7952             }
7953         }
7954     }
7955     if {$ids ne {}} {
7956         set fd [open [concat $cmd $ids] r]
7957         fconfigure $fd -blocking 0
7958         incr allcommits
7959         nowbusy allcommits
7960         filerun $fd [list getallclines $fd]
7961     } else {
7962         dispneartags 0
7963     }
7964 }
7965
7966 # Since most commits have 1 parent and 1 child, we group strings of
7967 # such commits into "arcs" joining branch/merge points (BMPs), which
7968 # are commits that either don't have 1 parent or don't have 1 child.
7969 #
7970 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
7971 # arcout(id) - outgoing arcs for BMP
7972 # arcids(a) - list of IDs on arc including end but not start
7973 # arcstart(a) - BMP ID at start of arc
7974 # arcend(a) - BMP ID at end of arc
7975 # growing(a) - arc a is still growing
7976 # arctags(a) - IDs out of arcids (excluding end) that have tags
7977 # archeads(a) - IDs out of arcids (excluding end) that have heads
7978 # The start of an arc is at the descendent end, so "incoming" means
7979 # coming from descendents, and "outgoing" means going towards ancestors.
7980
7981 proc getallclines {fd} {
7982     global allparents allchildren idtags idheads nextarc
7983     global arcnos arcids arctags arcout arcend arcstart archeads growing
7984     global seeds allcommits cachedarcs allcupdate
7985
7986     set nid 0
7987     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
7988         set id [lindex $line 0]
7989         if {[info exists allparents($id)]} {
7990             # seen it already
7991             continue
7992         }
7993         set cachedarcs 0
7994         set olds [lrange $line 1 end]
7995         set allparents($id) $olds
7996         if {![info exists allchildren($id)]} {
7997             set allchildren($id) {}
7998             set arcnos($id) {}
7999             lappend seeds $id
8000         } else {
8001             set a $arcnos($id)
8002             if {[llength $olds] == 1 && [llength $a] == 1} {
8003                 lappend arcids($a) $id
8004                 if {[info exists idtags($id)]} {
8005                     lappend arctags($a) $id
8006                 }
8007                 if {[info exists idheads($id)]} {
8008                     lappend archeads($a) $id
8009                 }
8010                 if {[info exists allparents($olds)]} {
8011                     # seen parent already
8012                     if {![info exists arcout($olds)]} {
8013                         splitarc $olds
8014                     }
8015                     lappend arcids($a) $olds
8016                     set arcend($a) $olds
8017                     unset growing($a)
8018                 }
8019                 lappend allchildren($olds) $id
8020                 lappend arcnos($olds) $a
8021                 continue
8022             }
8023         }
8024         foreach a $arcnos($id) {
8025             lappend arcids($a) $id
8026             set arcend($a) $id
8027             unset growing($a)
8028         }
8029
8030         set ao {}
8031         foreach p $olds {
8032             lappend allchildren($p) $id
8033             set a [incr nextarc]
8034             set arcstart($a) $id
8035             set archeads($a) {}
8036             set arctags($a) {}
8037             set archeads($a) {}
8038             set arcids($a) {}
8039             lappend ao $a
8040             set growing($a) 1
8041             if {[info exists allparents($p)]} {
8042                 # seen it already, may need to make a new branch
8043                 if {![info exists arcout($p)]} {
8044                     splitarc $p
8045                 }
8046                 lappend arcids($a) $p
8047                 set arcend($a) $p
8048                 unset growing($a)
8049             }
8050             lappend arcnos($p) $a
8051         }
8052         set arcout($id) $ao
8053     }
8054     if {$nid > 0} {
8055         global cached_dheads cached_dtags cached_atags
8056         catch {unset cached_dheads}
8057         catch {unset cached_dtags}
8058         catch {unset cached_atags}
8059     }
8060     if {![eof $fd]} {
8061         return [expr {$nid >= 1000? 2: 1}]
8062     }
8063     set cacheok 1
8064     if {[catch {
8065         fconfigure $fd -blocking 1
8066         close $fd
8067     } err]} {
8068         # got an error reading the list of commits
8069         # if we were updating, try rereading the whole thing again
8070         if {$allcupdate} {
8071             incr allcommits -1
8072             dropcache $err
8073             return
8074         }
8075         error_popup "[mc "Error reading commit topology information;\
8076                 branch and preceding/following tag information\
8077                 will be incomplete."]\n($err)"
8078         set cacheok 0
8079     }
8080     if {[incr allcommits -1] == 0} {
8081         notbusy allcommits
8082         if {$cacheok} {
8083             run savecache
8084         }
8085     }
8086     dispneartags 0
8087     return 0
8088 }
8089
8090 proc recalcarc {a} {
8091     global arctags archeads arcids idtags idheads
8092
8093     set at {}
8094     set ah {}
8095     foreach id [lrange $arcids($a) 0 end-1] {
8096         if {[info exists idtags($id)]} {
8097             lappend at $id
8098         }
8099         if {[info exists idheads($id)]} {
8100             lappend ah $id
8101         }
8102     }
8103     set arctags($a) $at
8104     set archeads($a) $ah
8105 }
8106
8107 proc splitarc {p} {
8108     global arcnos arcids nextarc arctags archeads idtags idheads
8109     global arcstart arcend arcout allparents growing
8110
8111     set a $arcnos($p)
8112     if {[llength $a] != 1} {
8113         puts "oops splitarc called but [llength $a] arcs already"
8114         return
8115     }
8116     set a [lindex $a 0]
8117     set i [lsearch -exact $arcids($a) $p]
8118     if {$i < 0} {
8119         puts "oops splitarc $p not in arc $a"
8120         return
8121     }
8122     set na [incr nextarc]
8123     if {[info exists arcend($a)]} {
8124         set arcend($na) $arcend($a)
8125     } else {
8126         set l [lindex $allparents([lindex $arcids($a) end]) 0]
8127         set j [lsearch -exact $arcnos($l) $a]
8128         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
8129     }
8130     set tail [lrange $arcids($a) [expr {$i+1}] end]
8131     set arcids($a) [lrange $arcids($a) 0 $i]
8132     set arcend($a) $p
8133     set arcstart($na) $p
8134     set arcout($p) $na
8135     set arcids($na) $tail
8136     if {[info exists growing($a)]} {
8137         set growing($na) 1
8138         unset growing($a)
8139     }
8140
8141     foreach id $tail {
8142         if {[llength $arcnos($id)] == 1} {
8143             set arcnos($id) $na
8144         } else {
8145             set j [lsearch -exact $arcnos($id) $a]
8146             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
8147         }
8148     }
8149
8150     # reconstruct tags and heads lists
8151     if {$arctags($a) ne {} || $archeads($a) ne {}} {
8152         recalcarc $a
8153         recalcarc $na
8154     } else {
8155         set arctags($na) {}
8156         set archeads($na) {}
8157     }
8158 }
8159
8160 # Update things for a new commit added that is a child of one
8161 # existing commit.  Used when cherry-picking.
8162 proc addnewchild {id p} {
8163     global allparents allchildren idtags nextarc
8164     global arcnos arcids arctags arcout arcend arcstart archeads growing
8165     global seeds allcommits
8166
8167     if {![info exists allcommits] || ![info exists arcnos($p)]} return
8168     set allparents($id) [list $p]
8169     set allchildren($id) {}
8170     set arcnos($id) {}
8171     lappend seeds $id
8172     lappend allchildren($p) $id
8173     set a [incr nextarc]
8174     set arcstart($a) $id
8175     set archeads($a) {}
8176     set arctags($a) {}
8177     set arcids($a) [list $p]
8178     set arcend($a) $p
8179     if {![info exists arcout($p)]} {
8180         splitarc $p
8181     }
8182     lappend arcnos($p) $a
8183     set arcout($id) [list $a]
8184 }
8185
8186 # This implements a cache for the topology information.
8187 # The cache saves, for each arc, the start and end of the arc,
8188 # the ids on the arc, and the outgoing arcs from the end.
8189 proc readcache {f} {
8190     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
8191     global idtags idheads allparents cachedarcs possible_seeds seeds growing
8192     global allcwait
8193
8194     set a $nextarc
8195     set lim $cachedarcs
8196     if {$lim - $a > 500} {
8197         set lim [expr {$a + 500}]
8198     }
8199     if {[catch {
8200         if {$a == $lim} {
8201             # finish reading the cache and setting up arctags, etc.
8202             set line [gets $f]
8203             if {$line ne "1"} {error "bad final version"}
8204             close $f
8205             foreach id [array names idtags] {
8206                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8207                     [llength $allparents($id)] == 1} {
8208                     set a [lindex $arcnos($id) 0]
8209                     if {$arctags($a) eq {}} {
8210                         recalcarc $a
8211                     }
8212                 }
8213             }
8214             foreach id [array names idheads] {
8215                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8216                     [llength $allparents($id)] == 1} {
8217                     set a [lindex $arcnos($id) 0]
8218                     if {$archeads($a) eq {}} {
8219                         recalcarc $a
8220                     }
8221                 }
8222             }
8223             foreach id [lsort -unique $possible_seeds] {
8224                 if {$arcnos($id) eq {}} {
8225                     lappend seeds $id
8226                 }
8227             }
8228             set allcwait 0
8229         } else {
8230             while {[incr a] <= $lim} {
8231                 set line [gets $f]
8232                 if {[llength $line] != 3} {error "bad line"}
8233                 set s [lindex $line 0]
8234                 set arcstart($a) $s
8235                 lappend arcout($s) $a
8236                 if {![info exists arcnos($s)]} {
8237                     lappend possible_seeds $s
8238                     set arcnos($s) {}
8239                 }
8240                 set e [lindex $line 1]
8241                 if {$e eq {}} {
8242                     set growing($a) 1
8243                 } else {
8244                     set arcend($a) $e
8245                     if {![info exists arcout($e)]} {
8246                         set arcout($e) {}
8247                     }
8248                 }
8249                 set arcids($a) [lindex $line 2]
8250                 foreach id $arcids($a) {
8251                     lappend allparents($s) $id
8252                     set s $id
8253                     lappend arcnos($id) $a
8254                 }
8255                 if {![info exists allparents($s)]} {
8256                     set allparents($s) {}
8257                 }
8258                 set arctags($a) {}
8259                 set archeads($a) {}
8260             }
8261             set nextarc [expr {$a - 1}]
8262         }
8263     } err]} {
8264         dropcache $err
8265         return 0
8266     }
8267     if {!$allcwait} {
8268         getallcommits
8269     }
8270     return $allcwait
8271 }
8272
8273 proc getcache {f} {
8274     global nextarc cachedarcs possible_seeds
8275
8276     if {[catch {
8277         set line [gets $f]
8278         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
8279         # make sure it's an integer
8280         set cachedarcs [expr {int([lindex $line 1])}]
8281         if {$cachedarcs < 0} {error "bad number of arcs"}
8282         set nextarc 0
8283         set possible_seeds {}
8284         run readcache $f
8285     } err]} {
8286         dropcache $err
8287     }
8288     return 0
8289 }
8290
8291 proc dropcache {err} {
8292     global allcwait nextarc cachedarcs seeds
8293
8294     #puts "dropping cache ($err)"
8295     foreach v {arcnos arcout arcids arcstart arcend growing \
8296                    arctags archeads allparents allchildren} {
8297         global $v
8298         catch {unset $v}
8299     }
8300     set allcwait 0
8301     set nextarc 0
8302     set cachedarcs 0
8303     set seeds {}
8304     getallcommits
8305 }
8306
8307 proc writecache {f} {
8308     global cachearc cachedarcs allccache
8309     global arcstart arcend arcnos arcids arcout
8310
8311     set a $cachearc
8312     set lim $cachedarcs
8313     if {$lim - $a > 1000} {
8314         set lim [expr {$a + 1000}]
8315     }
8316     if {[catch {
8317         while {[incr a] <= $lim} {
8318             if {[info exists arcend($a)]} {
8319                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
8320             } else {
8321                 puts $f [list $arcstart($a) {} $arcids($a)]
8322             }
8323         }
8324     } err]} {
8325         catch {close $f}
8326         catch {file delete $allccache}
8327         #puts "writing cache failed ($err)"
8328         return 0
8329     }
8330     set cachearc [expr {$a - 1}]
8331     if {$a > $cachedarcs} {
8332         puts $f "1"
8333         close $f
8334         return 0
8335     }
8336     return 1
8337 }
8338
8339 proc savecache {} {
8340     global nextarc cachedarcs cachearc allccache
8341
8342     if {$nextarc == $cachedarcs} return
8343     set cachearc 0
8344     set cachedarcs $nextarc
8345     catch {
8346         set f [open $allccache w]
8347         puts $f [list 1 $cachedarcs]
8348         run writecache $f
8349     }
8350 }
8351
8352 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
8353 # or 0 if neither is true.
8354 proc anc_or_desc {a b} {
8355     global arcout arcstart arcend arcnos cached_isanc
8356
8357     if {$arcnos($a) eq $arcnos($b)} {
8358         # Both are on the same arc(s); either both are the same BMP,
8359         # or if one is not a BMP, the other is also not a BMP or is
8360         # the BMP at end of the arc (and it only has 1 incoming arc).
8361         # Or both can be BMPs with no incoming arcs.
8362         if {$a eq $b || $arcnos($a) eq {}} {
8363             return 0
8364         }
8365         # assert {[llength $arcnos($a)] == 1}
8366         set arc [lindex $arcnos($a) 0]
8367         set i [lsearch -exact $arcids($arc) $a]
8368         set j [lsearch -exact $arcids($arc) $b]
8369         if {$i < 0 || $i > $j} {
8370             return 1
8371         } else {
8372             return -1
8373         }
8374     }
8375
8376     if {![info exists arcout($a)]} {
8377         set arc [lindex $arcnos($a) 0]
8378         if {[info exists arcend($arc)]} {
8379             set aend $arcend($arc)
8380         } else {
8381             set aend {}
8382         }
8383         set a $arcstart($arc)
8384     } else {
8385         set aend $a
8386     }
8387     if {![info exists arcout($b)]} {
8388         set arc [lindex $arcnos($b) 0]
8389         if {[info exists arcend($arc)]} {
8390             set bend $arcend($arc)
8391         } else {
8392             set bend {}
8393         }
8394         set b $arcstart($arc)
8395     } else {
8396         set bend $b
8397     }
8398     if {$a eq $bend} {
8399         return 1
8400     }
8401     if {$b eq $aend} {
8402         return -1
8403     }
8404     if {[info exists cached_isanc($a,$bend)]} {
8405         if {$cached_isanc($a,$bend)} {
8406             return 1
8407         }
8408     }
8409     if {[info exists cached_isanc($b,$aend)]} {
8410         if {$cached_isanc($b,$aend)} {
8411             return -1
8412         }
8413         if {[info exists cached_isanc($a,$bend)]} {
8414             return 0
8415         }
8416     }
8417
8418     set todo [list $a $b]
8419     set anc($a) a
8420     set anc($b) b
8421     for {set i 0} {$i < [llength $todo]} {incr i} {
8422         set x [lindex $todo $i]
8423         if {$anc($x) eq {}} {
8424             continue
8425         }
8426         foreach arc $arcnos($x) {
8427             set xd $arcstart($arc)
8428             if {$xd eq $bend} {
8429                 set cached_isanc($a,$bend) 1
8430                 set cached_isanc($b,$aend) 0
8431                 return 1
8432             } elseif {$xd eq $aend} {
8433                 set cached_isanc($b,$aend) 1
8434                 set cached_isanc($a,$bend) 0
8435                 return -1
8436             }
8437             if {![info exists anc($xd)]} {
8438                 set anc($xd) $anc($x)
8439                 lappend todo $xd
8440             } elseif {$anc($xd) ne $anc($x)} {
8441                 set anc($xd) {}
8442             }
8443         }
8444     }
8445     set cached_isanc($a,$bend) 0
8446     set cached_isanc($b,$aend) 0
8447     return 0
8448 }
8449
8450 # This identifies whether $desc has an ancestor that is
8451 # a growing tip of the graph and which is not an ancestor of $anc
8452 # and returns 0 if so and 1 if not.
8453 # If we subsequently discover a tag on such a growing tip, and that
8454 # turns out to be a descendent of $anc (which it could, since we
8455 # don't necessarily see children before parents), then $desc
8456 # isn't a good choice to display as a descendent tag of
8457 # $anc (since it is the descendent of another tag which is
8458 # a descendent of $anc).  Similarly, $anc isn't a good choice to
8459 # display as a ancestor tag of $desc.
8460 #
8461 proc is_certain {desc anc} {
8462     global arcnos arcout arcstart arcend growing problems
8463
8464     set certain {}
8465     if {[llength $arcnos($anc)] == 1} {
8466         # tags on the same arc are certain
8467         if {$arcnos($desc) eq $arcnos($anc)} {
8468             return 1
8469         }
8470         if {![info exists arcout($anc)]} {
8471             # if $anc is partway along an arc, use the start of the arc instead
8472             set a [lindex $arcnos($anc) 0]
8473             set anc $arcstart($a)
8474         }
8475     }
8476     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
8477         set x $desc
8478     } else {
8479         set a [lindex $arcnos($desc) 0]
8480         set x $arcend($a)
8481     }
8482     if {$x == $anc} {
8483         return 1
8484     }
8485     set anclist [list $x]
8486     set dl($x) 1
8487     set nnh 1
8488     set ngrowanc 0
8489     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
8490         set x [lindex $anclist $i]
8491         if {$dl($x)} {
8492             incr nnh -1
8493         }
8494         set done($x) 1
8495         foreach a $arcout($x) {
8496             if {[info exists growing($a)]} {
8497                 if {![info exists growanc($x)] && $dl($x)} {
8498                     set growanc($x) 1
8499                     incr ngrowanc
8500                 }
8501             } else {
8502                 set y $arcend($a)
8503                 if {[info exists dl($y)]} {
8504                     if {$dl($y)} {
8505                         if {!$dl($x)} {
8506                             set dl($y) 0
8507                             if {![info exists done($y)]} {
8508                                 incr nnh -1
8509                             }
8510                             if {[info exists growanc($x)]} {
8511                                 incr ngrowanc -1
8512                             }
8513                             set xl [list $y]
8514                             for {set k 0} {$k < [llength $xl]} {incr k} {
8515                                 set z [lindex $xl $k]
8516                                 foreach c $arcout($z) {
8517                                     if {[info exists arcend($c)]} {
8518                                         set v $arcend($c)
8519                                         if {[info exists dl($v)] && $dl($v)} {
8520                                             set dl($v) 0
8521                                             if {![info exists done($v)]} {
8522                                                 incr nnh -1
8523                                             }
8524                                             if {[info exists growanc($v)]} {
8525                                                 incr ngrowanc -1
8526                                             }
8527                                             lappend xl $v
8528                                         }
8529                                     }
8530                                 }
8531                             }
8532                         }
8533                     }
8534                 } elseif {$y eq $anc || !$dl($x)} {
8535                     set dl($y) 0
8536                     lappend anclist $y
8537                 } else {
8538                     set dl($y) 1
8539                     lappend anclist $y
8540                     incr nnh
8541                 }
8542             }
8543         }
8544     }
8545     foreach x [array names growanc] {
8546         if {$dl($x)} {
8547             return 0
8548         }
8549         return 0
8550     }
8551     return 1
8552 }
8553
8554 proc validate_arctags {a} {
8555     global arctags idtags
8556
8557     set i -1
8558     set na $arctags($a)
8559     foreach id $arctags($a) {
8560         incr i
8561         if {![info exists idtags($id)]} {
8562             set na [lreplace $na $i $i]
8563             incr i -1
8564         }
8565     }
8566     set arctags($a) $na
8567 }
8568
8569 proc validate_archeads {a} {
8570     global archeads idheads
8571
8572     set i -1
8573     set na $archeads($a)
8574     foreach id $archeads($a) {
8575         incr i
8576         if {![info exists idheads($id)]} {
8577             set na [lreplace $na $i $i]
8578             incr i -1
8579         }
8580     }
8581     set archeads($a) $na
8582 }
8583
8584 # Return the list of IDs that have tags that are descendents of id,
8585 # ignoring IDs that are descendents of IDs already reported.
8586 proc desctags {id} {
8587     global arcnos arcstart arcids arctags idtags allparents
8588     global growing cached_dtags
8589
8590     if {![info exists allparents($id)]} {
8591         return {}
8592     }
8593     set t1 [clock clicks -milliseconds]
8594     set argid $id
8595     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8596         # part-way along an arc; check that arc first
8597         set a [lindex $arcnos($id) 0]
8598         if {$arctags($a) ne {}} {
8599             validate_arctags $a
8600             set i [lsearch -exact $arcids($a) $id]
8601             set tid {}
8602             foreach t $arctags($a) {
8603                 set j [lsearch -exact $arcids($a) $t]
8604                 if {$j >= $i} break
8605                 set tid $t
8606             }
8607             if {$tid ne {}} {
8608                 return $tid
8609             }
8610         }
8611         set id $arcstart($a)
8612         if {[info exists idtags($id)]} {
8613             return $id
8614         }
8615     }
8616     if {[info exists cached_dtags($id)]} {
8617         return $cached_dtags($id)
8618     }
8619
8620     set origid $id
8621     set todo [list $id]
8622     set queued($id) 1
8623     set nc 1
8624     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8625         set id [lindex $todo $i]
8626         set done($id) 1
8627         set ta [info exists hastaggedancestor($id)]
8628         if {!$ta} {
8629             incr nc -1
8630         }
8631         # ignore tags on starting node
8632         if {!$ta && $i > 0} {
8633             if {[info exists idtags($id)]} {
8634                 set tagloc($id) $id
8635                 set ta 1
8636             } elseif {[info exists cached_dtags($id)]} {
8637                 set tagloc($id) $cached_dtags($id)
8638                 set ta 1
8639             }
8640         }
8641         foreach a $arcnos($id) {
8642             set d $arcstart($a)
8643             if {!$ta && $arctags($a) ne {}} {
8644                 validate_arctags $a
8645                 if {$arctags($a) ne {}} {
8646                     lappend tagloc($id) [lindex $arctags($a) end]
8647                 }
8648             }
8649             if {$ta || $arctags($a) ne {}} {
8650                 set tomark [list $d]
8651                 for {set j 0} {$j < [llength $tomark]} {incr j} {
8652                     set dd [lindex $tomark $j]
8653                     if {![info exists hastaggedancestor($dd)]} {
8654                         if {[info exists done($dd)]} {
8655                             foreach b $arcnos($dd) {
8656                                 lappend tomark $arcstart($b)
8657                             }
8658                             if {[info exists tagloc($dd)]} {
8659                                 unset tagloc($dd)
8660                             }
8661                         } elseif {[info exists queued($dd)]} {
8662                             incr nc -1
8663                         }
8664                         set hastaggedancestor($dd) 1
8665                     }
8666                 }
8667             }
8668             if {![info exists queued($d)]} {
8669                 lappend todo $d
8670                 set queued($d) 1
8671                 if {![info exists hastaggedancestor($d)]} {
8672                     incr nc
8673                 }
8674             }
8675         }
8676     }
8677     set tags {}
8678     foreach id [array names tagloc] {
8679         if {![info exists hastaggedancestor($id)]} {
8680             foreach t $tagloc($id) {
8681                 if {[lsearch -exact $tags $t] < 0} {
8682                     lappend tags $t
8683                 }
8684             }
8685         }
8686     }
8687     set t2 [clock clicks -milliseconds]
8688     set loopix $i
8689
8690     # remove tags that are descendents of other tags
8691     for {set i 0} {$i < [llength $tags]} {incr i} {
8692         set a [lindex $tags $i]
8693         for {set j 0} {$j < $i} {incr j} {
8694             set b [lindex $tags $j]
8695             set r [anc_or_desc $a $b]
8696             if {$r == 1} {
8697                 set tags [lreplace $tags $j $j]
8698                 incr j -1
8699                 incr i -1
8700             } elseif {$r == -1} {
8701                 set tags [lreplace $tags $i $i]
8702                 incr i -1
8703                 break
8704             }
8705         }
8706     }
8707
8708     if {[array names growing] ne {}} {
8709         # graph isn't finished, need to check if any tag could get
8710         # eclipsed by another tag coming later.  Simply ignore any
8711         # tags that could later get eclipsed.
8712         set ctags {}
8713         foreach t $tags {
8714             if {[is_certain $t $origid]} {
8715                 lappend ctags $t
8716             }
8717         }
8718         if {$tags eq $ctags} {
8719             set cached_dtags($origid) $tags
8720         } else {
8721             set tags $ctags
8722         }
8723     } else {
8724         set cached_dtags($origid) $tags
8725     }
8726     set t3 [clock clicks -milliseconds]
8727     if {0 && $t3 - $t1 >= 100} {
8728         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8729             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8730     }
8731     return $tags
8732 }
8733
8734 proc anctags {id} {
8735     global arcnos arcids arcout arcend arctags idtags allparents
8736     global growing cached_atags
8737
8738     if {![info exists allparents($id)]} {
8739         return {}
8740     }
8741     set t1 [clock clicks -milliseconds]
8742     set argid $id
8743     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8744         # part-way along an arc; check that arc first
8745         set a [lindex $arcnos($id) 0]
8746         if {$arctags($a) ne {}} {
8747             validate_arctags $a
8748             set i [lsearch -exact $arcids($a) $id]
8749             foreach t $arctags($a) {
8750                 set j [lsearch -exact $arcids($a) $t]
8751                 if {$j > $i} {
8752                     return $t
8753                 }
8754             }
8755         }
8756         if {![info exists arcend($a)]} {
8757             return {}
8758         }
8759         set id $arcend($a)
8760         if {[info exists idtags($id)]} {
8761             return $id
8762         }
8763     }
8764     if {[info exists cached_atags($id)]} {
8765         return $cached_atags($id)
8766     }
8767
8768     set origid $id
8769     set todo [list $id]
8770     set queued($id) 1
8771     set taglist {}
8772     set nc 1
8773     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8774         set id [lindex $todo $i]
8775         set done($id) 1
8776         set td [info exists hastaggeddescendent($id)]
8777         if {!$td} {
8778             incr nc -1
8779         }
8780         # ignore tags on starting node
8781         if {!$td && $i > 0} {
8782             if {[info exists idtags($id)]} {
8783                 set tagloc($id) $id
8784                 set td 1
8785             } elseif {[info exists cached_atags($id)]} {
8786                 set tagloc($id) $cached_atags($id)
8787                 set td 1
8788             }
8789         }
8790         foreach a $arcout($id) {
8791             if {!$td && $arctags($a) ne {}} {
8792                 validate_arctags $a
8793                 if {$arctags($a) ne {}} {
8794                     lappend tagloc($id) [lindex $arctags($a) 0]
8795                 }
8796             }
8797             if {![info exists arcend($a)]} continue
8798             set d $arcend($a)
8799             if {$td || $arctags($a) ne {}} {
8800                 set tomark [list $d]
8801                 for {set j 0} {$j < [llength $tomark]} {incr j} {
8802                     set dd [lindex $tomark $j]
8803                     if {![info exists hastaggeddescendent($dd)]} {
8804                         if {[info exists done($dd)]} {
8805                             foreach b $arcout($dd) {
8806                                 if {[info exists arcend($b)]} {
8807                                     lappend tomark $arcend($b)
8808                                 }
8809                             }
8810                             if {[info exists tagloc($dd)]} {
8811                                 unset tagloc($dd)
8812                             }
8813                         } elseif {[info exists queued($dd)]} {
8814                             incr nc -1
8815                         }
8816                         set hastaggeddescendent($dd) 1
8817                     }
8818                 }
8819             }
8820             if {![info exists queued($d)]} {
8821                 lappend todo $d
8822                 set queued($d) 1
8823                 if {![info exists hastaggeddescendent($d)]} {
8824                     incr nc
8825                 }
8826             }
8827         }
8828     }
8829     set t2 [clock clicks -milliseconds]
8830     set loopix $i
8831     set tags {}
8832     foreach id [array names tagloc] {
8833         if {![info exists hastaggeddescendent($id)]} {
8834             foreach t $tagloc($id) {
8835                 if {[lsearch -exact $tags $t] < 0} {
8836                     lappend tags $t
8837                 }
8838             }
8839         }
8840     }
8841
8842     # remove tags that are ancestors of other tags
8843     for {set i 0} {$i < [llength $tags]} {incr i} {
8844         set a [lindex $tags $i]
8845         for {set j 0} {$j < $i} {incr j} {
8846             set b [lindex $tags $j]
8847             set r [anc_or_desc $a $b]
8848             if {$r == -1} {
8849                 set tags [lreplace $tags $j $j]
8850                 incr j -1
8851                 incr i -1
8852             } elseif {$r == 1} {
8853                 set tags [lreplace $tags $i $i]
8854                 incr i -1
8855                 break
8856             }
8857         }
8858     }
8859
8860     if {[array names growing] ne {}} {
8861         # graph isn't finished, need to check if any tag could get
8862         # eclipsed by another tag coming later.  Simply ignore any
8863         # tags that could later get eclipsed.
8864         set ctags {}
8865         foreach t $tags {
8866             if {[is_certain $origid $t]} {
8867                 lappend ctags $t
8868             }
8869         }
8870         if {$tags eq $ctags} {
8871             set cached_atags($origid) $tags
8872         } else {
8873             set tags $ctags
8874         }
8875     } else {
8876         set cached_atags($origid) $tags
8877     }
8878     set t3 [clock clicks -milliseconds]
8879     if {0 && $t3 - $t1 >= 100} {
8880         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
8881             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8882     }
8883     return $tags
8884 }
8885
8886 # Return the list of IDs that have heads that are descendents of id,
8887 # including id itself if it has a head.
8888 proc descheads {id} {
8889     global arcnos arcstart arcids archeads idheads cached_dheads
8890     global allparents
8891
8892     if {![info exists allparents($id)]} {
8893         return {}
8894     }
8895     set aret {}
8896     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8897         # part-way along an arc; check it first
8898         set a [lindex $arcnos($id) 0]
8899         if {$archeads($a) ne {}} {
8900             validate_archeads $a
8901             set i [lsearch -exact $arcids($a) $id]
8902             foreach t $archeads($a) {
8903                 set j [lsearch -exact $arcids($a) $t]
8904                 if {$j > $i} break
8905                 lappend aret $t
8906             }
8907         }
8908         set id $arcstart($a)
8909     }
8910     set origid $id
8911     set todo [list $id]
8912     set seen($id) 1
8913     set ret {}
8914     for {set i 0} {$i < [llength $todo]} {incr i} {
8915         set id [lindex $todo $i]
8916         if {[info exists cached_dheads($id)]} {
8917             set ret [concat $ret $cached_dheads($id)]
8918         } else {
8919             if {[info exists idheads($id)]} {
8920                 lappend ret $id
8921             }
8922             foreach a $arcnos($id) {
8923                 if {$archeads($a) ne {}} {
8924                     validate_archeads $a
8925                     if {$archeads($a) ne {}} {
8926                         set ret [concat $ret $archeads($a)]
8927                     }
8928                 }
8929                 set d $arcstart($a)
8930                 if {![info exists seen($d)]} {
8931                     lappend todo $d
8932                     set seen($d) 1
8933                 }
8934             }
8935         }
8936     }
8937     set ret [lsort -unique $ret]
8938     set cached_dheads($origid) $ret
8939     return [concat $ret $aret]
8940 }
8941
8942 proc addedtag {id} {
8943     global arcnos arcout cached_dtags cached_atags
8944
8945     if {![info exists arcnos($id)]} return
8946     if {![info exists arcout($id)]} {
8947         recalcarc [lindex $arcnos($id) 0]
8948     }
8949     catch {unset cached_dtags}
8950     catch {unset cached_atags}
8951 }
8952
8953 proc addedhead {hid head} {
8954     global arcnos arcout cached_dheads
8955
8956     if {![info exists arcnos($hid)]} return
8957     if {![info exists arcout($hid)]} {
8958         recalcarc [lindex $arcnos($hid) 0]
8959     }
8960     catch {unset cached_dheads}
8961 }
8962
8963 proc removedhead {hid head} {
8964     global cached_dheads
8965
8966     catch {unset cached_dheads}
8967 }
8968
8969 proc movedhead {hid head} {
8970     global arcnos arcout cached_dheads
8971
8972     if {![info exists arcnos($hid)]} return
8973     if {![info exists arcout($hid)]} {
8974         recalcarc [lindex $arcnos($hid) 0]
8975     }
8976     catch {unset cached_dheads}
8977 }
8978
8979 proc changedrefs {} {
8980     global cached_dheads cached_dtags cached_atags
8981     global arctags archeads arcnos arcout idheads idtags
8982
8983     foreach id [concat [array names idheads] [array names idtags]] {
8984         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
8985             set a [lindex $arcnos($id) 0]
8986             if {![info exists donearc($a)]} {
8987                 recalcarc $a
8988                 set donearc($a) 1
8989             }
8990         }
8991     }
8992     catch {unset cached_dtags}
8993     catch {unset cached_atags}
8994     catch {unset cached_dheads}
8995 }
8996
8997 proc rereadrefs {} {
8998     global idtags idheads idotherrefs mainheadid
8999
9000     set refids [concat [array names idtags] \
9001                     [array names idheads] [array names idotherrefs]]
9002     foreach id $refids {
9003         if {![info exists ref($id)]} {
9004             set ref($id) [listrefs $id]
9005         }
9006     }
9007     set oldmainhead $mainheadid
9008     readrefs
9009     changedrefs
9010     set refids [lsort -unique [concat $refids [array names idtags] \
9011                         [array names idheads] [array names idotherrefs]]]
9012     foreach id $refids {
9013         set v [listrefs $id]
9014         if {![info exists ref($id)] || $ref($id) != $v ||
9015             ($id eq $oldmainhead && $id ne $mainheadid) ||
9016             ($id eq $mainheadid && $id ne $oldmainhead)} {
9017             redrawtags $id
9018         }
9019     }
9020     run refill_reflist
9021 }
9022
9023 proc listrefs {id} {
9024     global idtags idheads idotherrefs
9025
9026     set x {}
9027     if {[info exists idtags($id)]} {
9028         set x $idtags($id)
9029     }
9030     set y {}
9031     if {[info exists idheads($id)]} {
9032         set y $idheads($id)
9033     }
9034     set z {}
9035     if {[info exists idotherrefs($id)]} {
9036         set z $idotherrefs($id)
9037     }
9038     return [list $x $y $z]
9039 }
9040
9041 proc showtag {tag isnew} {
9042     global ctext tagcontents tagids linknum tagobjid
9043
9044     if {$isnew} {
9045         addtohistory [list showtag $tag 0]
9046     }
9047     $ctext conf -state normal
9048     clear_ctext
9049     settabs 0
9050     set linknum 0
9051     if {![info exists tagcontents($tag)]} {
9052         catch {
9053             set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
9054         }
9055     }
9056     if {[info exists tagcontents($tag)]} {
9057         set text $tagcontents($tag)
9058     } else {
9059         set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
9060     }
9061     appendwithlinks $text {}
9062     $ctext conf -state disabled
9063     init_flist {}
9064 }
9065
9066 proc doquit {} {
9067     global stopped
9068     global gitktmpdir
9069
9070     set stopped 100
9071     savestuff .
9072     destroy .
9073
9074     if {[info exists gitktmpdir]} {
9075         catch {file delete -force $gitktmpdir}
9076     }
9077 }
9078
9079 proc mkfontdisp {font top which} {
9080     global fontattr fontpref $font
9081
9082     set fontpref($font) [set $font]
9083     button $top.${font}but -text $which -font optionfont \
9084         -command [list choosefont $font $which]
9085     label $top.$font -relief flat -font $font \
9086         -text $fontattr($font,family) -justify left
9087     grid x $top.${font}but $top.$font -sticky w
9088 }
9089
9090 proc choosefont {font which} {
9091     global fontparam fontlist fonttop fontattr
9092
9093     set fontparam(which) $which
9094     set fontparam(font) $font
9095     set fontparam(family) [font actual $font -family]
9096     set fontparam(size) $fontattr($font,size)
9097     set fontparam(weight) $fontattr($font,weight)
9098     set fontparam(slant) $fontattr($font,slant)
9099     set top .gitkfont
9100     set fonttop $top
9101     if {![winfo exists $top]} {
9102         font create sample
9103         eval font config sample [font actual $font]
9104         toplevel $top
9105         wm title $top [mc "Gitk font chooser"]
9106         label $top.l -textvariable fontparam(which)
9107         pack $top.l -side top
9108         set fontlist [lsort [font families]]
9109         frame $top.f
9110         listbox $top.f.fam -listvariable fontlist \
9111             -yscrollcommand [list $top.f.sb set]
9112         bind $top.f.fam <<ListboxSelect>> selfontfam
9113         scrollbar $top.f.sb -command [list $top.f.fam yview]
9114         pack $top.f.sb -side right -fill y
9115         pack $top.f.fam -side left -fill both -expand 1
9116         pack $top.f -side top -fill both -expand 1
9117         frame $top.g
9118         spinbox $top.g.size -from 4 -to 40 -width 4 \
9119             -textvariable fontparam(size) \
9120             -validatecommand {string is integer -strict %s}
9121         checkbutton $top.g.bold -padx 5 \
9122             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
9123             -variable fontparam(weight) -onvalue bold -offvalue normal
9124         checkbutton $top.g.ital -padx 5 \
9125             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
9126             -variable fontparam(slant) -onvalue italic -offvalue roman
9127         pack $top.g.size $top.g.bold $top.g.ital -side left
9128         pack $top.g -side top
9129         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
9130             -background white
9131         $top.c create text 100 25 -anchor center -text $which -font sample \
9132             -fill black -tags text
9133         bind $top.c <Configure> [list centertext $top.c]
9134         pack $top.c -side top -fill x
9135         frame $top.buts
9136         button $top.buts.ok -text [mc "OK"] -command fontok -default active
9137         button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
9138         grid $top.buts.ok $top.buts.can
9139         grid columnconfigure $top.buts 0 -weight 1 -uniform a
9140         grid columnconfigure $top.buts 1 -weight 1 -uniform a
9141         pack $top.buts -side bottom -fill x
9142         trace add variable fontparam write chg_fontparam
9143     } else {
9144         raise $top
9145         $top.c itemconf text -text $which
9146     }
9147     set i [lsearch -exact $fontlist $fontparam(family)]
9148     if {$i >= 0} {
9149         $top.f.fam selection set $i
9150         $top.f.fam see $i
9151     }
9152 }
9153
9154 proc centertext {w} {
9155     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
9156 }
9157
9158 proc fontok {} {
9159     global fontparam fontpref prefstop
9160
9161     set f $fontparam(font)
9162     set fontpref($f) [list $fontparam(family) $fontparam(size)]
9163     if {$fontparam(weight) eq "bold"} {
9164         lappend fontpref($f) "bold"
9165     }
9166     if {$fontparam(slant) eq "italic"} {
9167         lappend fontpref($f) "italic"
9168     }
9169     set w $prefstop.$f
9170     $w conf -text $fontparam(family) -font $fontpref($f)
9171
9172     fontcan
9173 }
9174
9175 proc fontcan {} {
9176     global fonttop fontparam
9177
9178     if {[info exists fonttop]} {
9179         catch {destroy $fonttop}
9180         catch {font delete sample}
9181         unset fonttop
9182         unset fontparam
9183     }
9184 }
9185
9186 proc selfontfam {} {
9187     global fonttop fontparam
9188
9189     set i [$fonttop.f.fam curselection]
9190     if {$i ne {}} {
9191         set fontparam(family) [$fonttop.f.fam get $i]
9192     }
9193 }
9194
9195 proc chg_fontparam {v sub op} {
9196     global fontparam
9197
9198     font config sample -$sub $fontparam($sub)
9199 }
9200
9201 proc doprefs {} {
9202     global maxwidth maxgraphpct
9203     global oldprefs prefstop showneartags showlocalchanges
9204     global bgcolor fgcolor ctext diffcolors selectbgcolor
9205     global tabstop limitdiffs autoselect extdifftool
9206
9207     set top .gitkprefs
9208     set prefstop $top
9209     if {[winfo exists $top]} {
9210         raise $top
9211         return
9212     }
9213     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9214                    limitdiffs tabstop} {
9215         set oldprefs($v) [set $v]
9216     }
9217     toplevel $top
9218     wm title $top [mc "Gitk preferences"]
9219     label $top.ldisp -text [mc "Commit list display options"]
9220     grid $top.ldisp - -sticky w -pady 10
9221     label $top.spacer -text " "
9222     label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
9223         -font optionfont
9224     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
9225     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
9226     label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
9227         -font optionfont
9228     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
9229     grid x $top.maxpctl $top.maxpct -sticky w
9230     frame $top.showlocal
9231     label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
9232     checkbutton $top.showlocal.b -variable showlocalchanges
9233     pack $top.showlocal.b $top.showlocal.l -side left
9234     grid x $top.showlocal -sticky w
9235     frame $top.autoselect
9236     label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont
9237     checkbutton $top.autoselect.b -variable autoselect
9238     pack $top.autoselect.b $top.autoselect.l -side left
9239     grid x $top.autoselect -sticky w
9240
9241     label $top.ddisp -text [mc "Diff display options"]
9242     grid $top.ddisp - -sticky w -pady 10
9243     label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
9244     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
9245     grid x $top.tabstopl $top.tabstop -sticky w
9246     frame $top.ntag
9247     label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
9248     checkbutton $top.ntag.b -variable showneartags
9249     pack $top.ntag.b $top.ntag.l -side left
9250     grid x $top.ntag -sticky w
9251     frame $top.ldiff
9252     label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
9253     checkbutton $top.ldiff.b -variable limitdiffs
9254     pack $top.ldiff.b $top.ldiff.l -side left
9255     grid x $top.ldiff -sticky w
9256
9257     entry $top.extdifft -textvariable extdifftool
9258     frame $top.extdifff
9259     label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
9260         -padx 10
9261     button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
9262         -command choose_extdiff
9263     pack $top.extdifff.l $top.extdifff.b -side left
9264     grid x $top.extdifff $top.extdifft -sticky w
9265
9266     label $top.cdisp -text [mc "Colors: press to choose"]
9267     grid $top.cdisp - -sticky w -pady 10
9268     label $top.bg -padx 40 -relief sunk -background $bgcolor
9269     button $top.bgbut -text [mc "Background"] -font optionfont \
9270         -command [list choosecolor bgcolor {} $top.bg background setbg]
9271     grid x $top.bgbut $top.bg -sticky w
9272     label $top.fg -padx 40 -relief sunk -background $fgcolor
9273     button $top.fgbut -text [mc "Foreground"] -font optionfont \
9274         -command [list choosecolor fgcolor {} $top.fg foreground setfg]
9275     grid x $top.fgbut $top.fg -sticky w
9276     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
9277     button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
9278         -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
9279                       [list $ctext tag conf d0 -foreground]]
9280     grid x $top.diffoldbut $top.diffold -sticky w
9281     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
9282     button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
9283         -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
9284                       [list $ctext tag conf d1 -foreground]]
9285     grid x $top.diffnewbut $top.diffnew -sticky w
9286     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
9287     button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
9288         -command [list choosecolor diffcolors 2 $top.hunksep \
9289                       "diff hunk header" \
9290                       [list $ctext tag conf hunksep -foreground]]
9291     grid x $top.hunksepbut $top.hunksep -sticky w
9292     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
9293     button $top.selbgbut -text [mc "Select bg"] -font optionfont \
9294         -command [list choosecolor selectbgcolor {} $top.selbgsep background setselbg]
9295     grid x $top.selbgbut $top.selbgsep -sticky w
9296
9297     label $top.cfont -text [mc "Fonts: press to choose"]
9298     grid $top.cfont - -sticky w -pady 10
9299     mkfontdisp mainfont $top [mc "Main font"]
9300     mkfontdisp textfont $top [mc "Diff display font"]
9301     mkfontdisp uifont $top [mc "User interface font"]
9302
9303     frame $top.buts
9304     button $top.buts.ok -text [mc "OK"] -command prefsok -default active
9305     button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
9306     grid $top.buts.ok $top.buts.can
9307     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9308     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9309     grid $top.buts - - -pady 10 -sticky ew
9310     bind $top <Visibility> "focus $top.buts.ok"
9311 }
9312
9313 proc choose_extdiff {} {
9314     global extdifftool
9315
9316     set prog [tk_getOpenFile -title "External diff tool" -multiple false]
9317     if {$prog ne {}} {
9318         set extdifftool $prog
9319     }
9320 }
9321
9322 proc choosecolor {v vi w x cmd} {
9323     global $v
9324
9325     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
9326                -title [mc "Gitk: choose color for %s" $x]]
9327     if {$c eq {}} return
9328     $w conf -background $c
9329     lset $v $vi $c
9330     eval $cmd $c
9331 }
9332
9333 proc setselbg {c} {
9334     global bglist cflist
9335     foreach w $bglist {
9336         $w configure -selectbackground $c
9337     }
9338     $cflist tag configure highlight \
9339         -background [$cflist cget -selectbackground]
9340     allcanvs itemconf secsel -fill $c
9341 }
9342
9343 proc setbg {c} {
9344     global bglist
9345
9346     foreach w $bglist {
9347         $w conf -background $c
9348     }
9349 }
9350
9351 proc setfg {c} {
9352     global fglist canv
9353
9354     foreach w $fglist {
9355         $w conf -foreground $c
9356     }
9357     allcanvs itemconf text -fill $c
9358     $canv itemconf circle -outline $c
9359 }
9360
9361 proc prefscan {} {
9362     global oldprefs prefstop
9363
9364     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9365                    limitdiffs tabstop} {
9366         global $v
9367         set $v $oldprefs($v)
9368     }
9369     catch {destroy $prefstop}
9370     unset prefstop
9371     fontcan
9372 }
9373
9374 proc prefsok {} {
9375     global maxwidth maxgraphpct
9376     global oldprefs prefstop showneartags showlocalchanges
9377     global fontpref mainfont textfont uifont
9378     global limitdiffs treediffs
9379
9380     catch {destroy $prefstop}
9381     unset prefstop
9382     fontcan
9383     set fontchanged 0
9384     if {$mainfont ne $fontpref(mainfont)} {
9385         set mainfont $fontpref(mainfont)
9386         parsefont mainfont $mainfont
9387         eval font configure mainfont [fontflags mainfont]
9388         eval font configure mainfontbold [fontflags mainfont 1]
9389         setcoords
9390         set fontchanged 1
9391     }
9392     if {$textfont ne $fontpref(textfont)} {
9393         set textfont $fontpref(textfont)
9394         parsefont textfont $textfont
9395         eval font configure textfont [fontflags textfont]
9396         eval font configure textfontbold [fontflags textfont 1]
9397     }
9398     if {$uifont ne $fontpref(uifont)} {
9399         set uifont $fontpref(uifont)
9400         parsefont uifont $uifont
9401         eval font configure uifont [fontflags uifont]
9402     }
9403     settabs
9404     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
9405         if {$showlocalchanges} {
9406             doshowlocalchanges
9407         } else {
9408             dohidelocalchanges
9409         }
9410     }
9411     if {$limitdiffs != $oldprefs(limitdiffs)} {
9412         # treediffs elements are limited by path
9413         catch {unset treediffs}
9414     }
9415     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
9416         || $maxgraphpct != $oldprefs(maxgraphpct)} {
9417         redisplay
9418     } elseif {$showneartags != $oldprefs(showneartags) ||
9419           $limitdiffs != $oldprefs(limitdiffs)} {
9420         reselectline
9421     }
9422 }
9423
9424 proc formatdate {d} {
9425     global datetimeformat
9426     if {$d ne {}} {
9427         set d [clock format $d -format $datetimeformat]
9428     }
9429     return $d
9430 }
9431
9432 # This list of encoding names and aliases is distilled from
9433 # http://www.iana.org/assignments/character-sets.
9434 # Not all of them are supported by Tcl.
9435 set encoding_aliases {
9436     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
9437       ISO646-US US-ASCII us IBM367 cp367 csASCII }
9438     { ISO-10646-UTF-1 csISO10646UTF1 }
9439     { ISO_646.basic:1983 ref csISO646basic1983 }
9440     { INVARIANT csINVARIANT }
9441     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
9442     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
9443     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
9444     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
9445     { NATS-DANO iso-ir-9-1 csNATSDANO }
9446     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
9447     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
9448     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
9449     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
9450     { ISO-2022-KR csISO2022KR }
9451     { EUC-KR csEUCKR }
9452     { ISO-2022-JP csISO2022JP }
9453     { ISO-2022-JP-2 csISO2022JP2 }
9454     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
9455       csISO13JISC6220jp }
9456     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
9457     { IT iso-ir-15 ISO646-IT csISO15Italian }
9458     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
9459     { ES iso-ir-17 ISO646-ES csISO17Spanish }
9460     { greek7-old iso-ir-18 csISO18Greek7Old }
9461     { latin-greek iso-ir-19 csISO19LatinGreek }
9462     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
9463     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
9464     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
9465     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
9466     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
9467     { BS_viewdata iso-ir-47 csISO47BSViewdata }
9468     { INIS iso-ir-49 csISO49INIS }
9469     { INIS-8 iso-ir-50 csISO50INIS8 }
9470     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
9471     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
9472     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
9473     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
9474     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
9475     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
9476       csISO60Norwegian1 }
9477     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
9478     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
9479     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
9480     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
9481     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
9482     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
9483     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
9484     { greek7 iso-ir-88 csISO88Greek7 }
9485     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
9486     { iso-ir-90 csISO90 }
9487     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
9488     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
9489       csISO92JISC62991984b }
9490     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
9491     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
9492     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
9493       csISO95JIS62291984handadd }
9494     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
9495     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
9496     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
9497     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
9498       CP819 csISOLatin1 }
9499     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
9500     { T.61-7bit iso-ir-102 csISO102T617bit }
9501     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
9502     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
9503     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
9504     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
9505     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
9506     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
9507     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
9508     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
9509       arabic csISOLatinArabic }
9510     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
9511     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
9512     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
9513       greek greek8 csISOLatinGreek }
9514     { T.101-G2 iso-ir-128 csISO128T101G2 }
9515     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
9516       csISOLatinHebrew }
9517     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
9518     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
9519     { CSN_369103 iso-ir-139 csISO139CSN369103 }
9520     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
9521     { ISO_6937-2-add iso-ir-142 csISOTextComm }
9522     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
9523     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
9524       csISOLatinCyrillic }
9525     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
9526     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
9527     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
9528     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
9529     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
9530     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
9531     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
9532     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
9533     { ISO_10367-box iso-ir-155 csISO10367Box }
9534     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
9535     { latin-lap lap iso-ir-158 csISO158Lap }
9536     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
9537     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
9538     { us-dk csUSDK }
9539     { dk-us csDKUS }
9540     { JIS_X0201 X0201 csHalfWidthKatakana }
9541     { KSC5636 ISO646-KR csKSC5636 }
9542     { ISO-10646-UCS-2 csUnicode }
9543     { ISO-10646-UCS-4 csUCS4 }
9544     { DEC-MCS dec csDECMCS }
9545     { hp-roman8 roman8 r8 csHPRoman8 }
9546     { macintosh mac csMacintosh }
9547     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
9548       csIBM037 }
9549     { IBM038 EBCDIC-INT cp038 csIBM038 }
9550     { IBM273 CP273 csIBM273 }
9551     { IBM274 EBCDIC-BE CP274 csIBM274 }
9552     { IBM275 EBCDIC-BR cp275 csIBM275 }
9553     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
9554     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
9555     { IBM280 CP280 ebcdic-cp-it csIBM280 }
9556     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
9557     { IBM284 CP284 ebcdic-cp-es csIBM284 }
9558     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
9559     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
9560     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
9561     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
9562     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
9563     { IBM424 cp424 ebcdic-cp-he csIBM424 }
9564     { IBM437 cp437 437 csPC8CodePage437 }
9565     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
9566     { IBM775 cp775 csPC775Baltic }
9567     { IBM850 cp850 850 csPC850Multilingual }
9568     { IBM851 cp851 851 csIBM851 }
9569     { IBM852 cp852 852 csPCp852 }
9570     { IBM855 cp855 855 csIBM855 }
9571     { IBM857 cp857 857 csIBM857 }
9572     { IBM860 cp860 860 csIBM860 }
9573     { IBM861 cp861 861 cp-is csIBM861 }
9574     { IBM862 cp862 862 csPC862LatinHebrew }
9575     { IBM863 cp863 863 csIBM863 }
9576     { IBM864 cp864 csIBM864 }
9577     { IBM865 cp865 865 csIBM865 }
9578     { IBM866 cp866 866 csIBM866 }
9579     { IBM868 CP868 cp-ar csIBM868 }
9580     { IBM869 cp869 869 cp-gr csIBM869 }
9581     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
9582     { IBM871 CP871 ebcdic-cp-is csIBM871 }
9583     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
9584     { IBM891 cp891 csIBM891 }
9585     { IBM903 cp903 csIBM903 }
9586     { IBM904 cp904 904 csIBBM904 }
9587     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
9588     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
9589     { IBM1026 CP1026 csIBM1026 }
9590     { EBCDIC-AT-DE csIBMEBCDICATDE }
9591     { EBCDIC-AT-DE-A csEBCDICATDEA }
9592     { EBCDIC-CA-FR csEBCDICCAFR }
9593     { EBCDIC-DK-NO csEBCDICDKNO }
9594     { EBCDIC-DK-NO-A csEBCDICDKNOA }
9595     { EBCDIC-FI-SE csEBCDICFISE }
9596     { EBCDIC-FI-SE-A csEBCDICFISEA }
9597     { EBCDIC-FR csEBCDICFR }
9598     { EBCDIC-IT csEBCDICIT }
9599     { EBCDIC-PT csEBCDICPT }
9600     { EBCDIC-ES csEBCDICES }
9601     { EBCDIC-ES-A csEBCDICESA }
9602     { EBCDIC-ES-S csEBCDICESS }
9603     { EBCDIC-UK csEBCDICUK }
9604     { EBCDIC-US csEBCDICUS }
9605     { UNKNOWN-8BIT csUnknown8BiT }
9606     { MNEMONIC csMnemonic }
9607     { MNEM csMnem }
9608     { VISCII csVISCII }
9609     { VIQR csVIQR }
9610     { KOI8-R csKOI8R }
9611     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9612     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9613     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9614     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9615     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9616     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9617     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9618     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9619     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9620     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9621     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9622     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9623     { IBM1047 IBM-1047 }
9624     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9625     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9626     { UNICODE-1-1 csUnicode11 }
9627     { CESU-8 csCESU-8 }
9628     { BOCU-1 csBOCU-1 }
9629     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9630     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9631       l8 }
9632     { ISO-8859-15 ISO_8859-15 Latin-9 }
9633     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9634     { GBK CP936 MS936 windows-936 }
9635     { JIS_Encoding csJISEncoding }
9636     { Shift_JIS MS_Kanji csShiftJIS }
9637     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9638       EUC-JP }
9639     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9640     { ISO-10646-UCS-Basic csUnicodeASCII }
9641     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9642     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9643     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9644     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9645     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9646     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9647     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9648     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9649     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9650     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9651     { Adobe-Standard-Encoding csAdobeStandardEncoding }
9652     { Ventura-US csVenturaUS }
9653     { Ventura-International csVenturaInternational }
9654     { PC8-Danish-Norwegian csPC8DanishNorwegian }
9655     { PC8-Turkish csPC8Turkish }
9656     { IBM-Symbols csIBMSymbols }
9657     { IBM-Thai csIBMThai }
9658     { HP-Legal csHPLegal }
9659     { HP-Pi-font csHPPiFont }
9660     { HP-Math8 csHPMath8 }
9661     { Adobe-Symbol-Encoding csHPPSMath }
9662     { HP-DeskTop csHPDesktop }
9663     { Ventura-Math csVenturaMath }
9664     { Microsoft-Publishing csMicrosoftPublishing }
9665     { Windows-31J csWindows31J }
9666     { GB2312 csGB2312 }
9667     { Big5 csBig5 }
9668 }
9669
9670 proc tcl_encoding {enc} {
9671     global encoding_aliases
9672     set names [encoding names]
9673     set lcnames [string tolower $names]
9674     set enc [string tolower $enc]
9675     set i [lsearch -exact $lcnames $enc]
9676     if {$i < 0} {
9677         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9678         if {[regsub {^iso[-_]} $enc iso encx]} {
9679             set i [lsearch -exact $lcnames $encx]
9680         }
9681     }
9682     if {$i < 0} {
9683         foreach l $encoding_aliases {
9684             set ll [string tolower $l]
9685             if {[lsearch -exact $ll $enc] < 0} continue
9686             # look through the aliases for one that tcl knows about
9687             foreach e $ll {
9688                 set i [lsearch -exact $lcnames $e]
9689                 if {$i < 0} {
9690                     if {[regsub {^iso[-_]} $e iso ex]} {
9691                         set i [lsearch -exact $lcnames $ex]
9692                     }
9693                 }
9694                 if {$i >= 0} break
9695             }
9696             break
9697         }
9698     }
9699     if {$i >= 0} {
9700         return [lindex $names $i]
9701     }
9702     return {}
9703 }
9704
9705 # First check that Tcl/Tk is recent enough
9706 if {[catch {package require Tk 8.4} err]} {
9707     show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9708                      Gitk requires at least Tcl/Tk 8.4."]
9709     exit 1
9710 }
9711
9712 # defaults...
9713 set wrcomcmd "git diff-tree --stdin -p --pretty"
9714
9715 set gitencoding {}
9716 catch {
9717     set gitencoding [exec git config --get i18n.commitencoding]
9718 }
9719 if {$gitencoding == ""} {
9720     set gitencoding "utf-8"
9721 }
9722 set tclencoding [tcl_encoding $gitencoding]
9723 if {$tclencoding == {}} {
9724     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
9725 }
9726
9727 set mainfont {Helvetica 9}
9728 set textfont {Courier 9}
9729 set uifont {Helvetica 9 bold}
9730 set tabstop 8
9731 set findmergefiles 0
9732 set maxgraphpct 50
9733 set maxwidth 16
9734 set revlistorder 0
9735 set fastdate 0
9736 set uparrowlen 5
9737 set downarrowlen 5
9738 set mingaplen 100
9739 set cmitmode "patch"
9740 set wrapcomment "none"
9741 set showneartags 1
9742 set maxrefs 20
9743 set maxlinelen 200
9744 set showlocalchanges 1
9745 set limitdiffs 1
9746 set datetimeformat "%Y-%m-%d %H:%M:%S"
9747 set autoselect 1
9748
9749 set extdifftool "meld"
9750
9751 set colors {green red blue magenta darkgrey brown orange}
9752 set bgcolor white
9753 set fgcolor black
9754 set diffcolors {red "#00a000" blue}
9755 set diffcontext 3
9756 set ignorespace 0
9757 set selectbgcolor gray85
9758
9759 ## For msgcat loading, first locate the installation location.
9760 if { [info exists ::env(GITK_MSGSDIR)] } {
9761     ## Msgsdir was manually set in the environment.
9762     set gitk_msgsdir $::env(GITK_MSGSDIR)
9763 } else {
9764     ## Let's guess the prefix from argv0.
9765     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
9766     set gitk_libdir [file join $gitk_prefix share gitk lib]
9767     set gitk_msgsdir [file join $gitk_libdir msgs]
9768     unset gitk_prefix
9769 }
9770
9771 ## Internationalization (i18n) through msgcat and gettext. See
9772 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
9773 package require msgcat
9774 namespace import ::msgcat::mc
9775 ## And eventually load the actual message catalog
9776 ::msgcat::mcload $gitk_msgsdir
9777
9778 catch {source ~/.gitk}
9779
9780 font create optionfont -family sans-serif -size -12
9781
9782 parsefont mainfont $mainfont
9783 eval font create mainfont [fontflags mainfont]
9784 eval font create mainfontbold [fontflags mainfont 1]
9785
9786 parsefont textfont $textfont
9787 eval font create textfont [fontflags textfont]
9788 eval font create textfontbold [fontflags textfont 1]
9789
9790 parsefont uifont $uifont
9791 eval font create uifont [fontflags uifont]
9792
9793 setoptions
9794
9795 # check that we can find a .git directory somewhere...
9796 if {[catch {set gitdir [gitdir]}]} {
9797     show_error {} . [mc "Cannot find a git repository here."]
9798     exit 1
9799 }
9800 if {![file isdirectory $gitdir]} {
9801     show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
9802     exit 1
9803 }
9804
9805 set revtreeargs {}
9806 set cmdline_files {}
9807 set i 0
9808 set revtreeargscmd {}
9809 foreach arg $argv {
9810     switch -glob -- $arg {
9811         "" { }
9812         "--" {
9813             set cmdline_files [lrange $argv [expr {$i + 1}] end]
9814             break
9815         }
9816         "--argscmd=*" {
9817             set revtreeargscmd [string range $arg 10 end]
9818         }
9819         default {
9820             lappend revtreeargs $arg
9821         }
9822     }
9823     incr i
9824 }
9825
9826 if {$i >= [llength $argv] && $revtreeargs ne {}} {
9827     # no -- on command line, but some arguments (other than --argscmd)
9828     if {[catch {
9829         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
9830         set cmdline_files [split $f "\n"]
9831         set n [llength $cmdline_files]
9832         set revtreeargs [lrange $revtreeargs 0 end-$n]
9833         # Unfortunately git rev-parse doesn't produce an error when
9834         # something is both a revision and a filename.  To be consistent
9835         # with git log and git rev-list, check revtreeargs for filenames.
9836         foreach arg $revtreeargs {
9837             if {[file exists $arg]} {
9838                 show_error {} . [mc "Ambiguous argument '%s': both revision\
9839                                  and filename" $arg]
9840                 exit 1
9841             }
9842         }
9843     } err]} {
9844         # unfortunately we get both stdout and stderr in $err,
9845         # so look for "fatal:".
9846         set i [string first "fatal:" $err]
9847         if {$i > 0} {
9848             set err [string range $err [expr {$i + 6}] end]
9849         }
9850         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
9851         exit 1
9852     }
9853 }
9854
9855 set nullid "0000000000000000000000000000000000000000"
9856 set nullid2 "0000000000000000000000000000000000000001"
9857 set nullfile "/dev/null"
9858
9859 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
9860
9861 set runq {}
9862 set history {}
9863 set historyindex 0
9864 set fh_serial 0
9865 set nhl_names {}
9866 set highlight_paths {}
9867 set findpattern {}
9868 set searchdirn -forwards
9869 set boldrows {}
9870 set boldnamerows {}
9871 set diffelide {0 0}
9872 set markingmatches 0
9873 set linkentercount 0
9874 set need_redisplay 0
9875 set nrows_drawn 0
9876 set firsttabstop 0
9877
9878 set nextviewnum 1
9879 set curview 0
9880 set selectedview 0
9881 set selectedhlview [mc "None"]
9882 set highlight_related [mc "None"]
9883 set highlight_files {}
9884 set viewfiles(0) {}
9885 set viewperm(0) 0
9886 set viewargs(0) {}
9887 set viewargscmd(0) {}
9888
9889 set numcommits 0
9890 set loginstance 0
9891 set cmdlineok 0
9892 set stopped 0
9893 set stuffsaved 0
9894 set patchnum 0
9895 set lserial 0
9896 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
9897 setcoords
9898 makewindow
9899 # wait for the window to become visible
9900 tkwait visibility .
9901 wm title . "[file tail $argv0]: [file tail [pwd]]"
9902 readrefs
9903
9904 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
9905     # create a view for the files/dirs specified on the command line
9906     set curview 1
9907     set selectedview 1
9908     set nextviewnum 2
9909     set viewname(1) [mc "Command line"]
9910     set viewfiles(1) $cmdline_files
9911     set viewargs(1) $revtreeargs
9912     set viewargscmd(1) $revtreeargscmd
9913     set viewperm(1) 0
9914     set vdatemode(1) 0
9915     addviewmenu 1
9916     .bar.view entryconf [mc "Edit view..."] -state normal
9917     .bar.view entryconf [mc "Delete view"] -state normal
9918 }
9919
9920 if {[info exists permviews]} {
9921     foreach v $permviews {
9922         set n $nextviewnum
9923         incr nextviewnum
9924         set viewname($n) [lindex $v 0]
9925         set viewfiles($n) [lindex $v 1]
9926         set viewargs($n) [lindex $v 2]
9927         set viewargscmd($n) [lindex $v 3]
9928         set viewperm($n) 1
9929         addviewmenu $n
9930     }
9931 }
9932 getcommits