gitk

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