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