gitk

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