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