gitk

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