2 # Tcl ignores the next line -*- tcl -*- \
 
   5 # Copyright © 2005-2009 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.
 
  14     if {[info exists env(GIT_DIR)]} {
 
  17         return [exec git rev-parse --git-dir]
 
  21 # A simple scheduler for compute-intensive stuff.
 
  22 # The aim is to make sure that event handlers for GUI actions can
 
  23 # run at least every 50-100 ms.  Unfortunately fileevent handlers are
 
  24 # run before X event handlers, so reading from a fast source can
 
  25 # make the GUI completely unresponsive.
 
  27     global isonrunq runq currunq
 
  30     if {[info exists isonrunq($script)]} return
 
  31     if {$runq eq {} && ![info exists currunq]} {
 
  34     lappend runq [list {} $script]
 
  35     set isonrunq($script) 1
 
  38 proc filerun {fd script} {
 
  39     fileevent $fd readable [list filereadable $fd $script]
 
  42 proc filereadable {fd script} {
 
  45     fileevent $fd readable {}
 
  46     if {$runq eq {} && ![info exists currunq]} {
 
  49     lappend runq [list $fd $script]
 
  55     for {set i 0} {$i < [llength $runq]} {} {
 
  56         if {[lindex $runq $i 0] eq $fd} {
 
  57             set runq [lreplace $runq $i $i]
 
  65     global isonrunq runq currunq
 
  67     set tstart [clock clicks -milliseconds]
 
  69     while {[llength $runq] > 0} {
 
  70         set fd [lindex $runq 0 0]
 
  71         set script [lindex $runq 0 1]
 
  72         set currunq [lindex $runq 0]
 
  73         set runq [lrange $runq 1 end]
 
  74         set repeat [eval $script]
 
  76         set t1 [clock clicks -milliseconds]
 
  77         set t [expr {$t1 - $t0}]
 
  78         if {$repeat ne {} && $repeat} {
 
  79             if {$fd eq {} || $repeat == 2} {
 
  80                 # script returns 1 if it wants to be readded
 
  81                 # file readers return 2 if they could do more straight away
 
  82                 lappend runq [list $fd $script]
 
  84                 fileevent $fd readable [list filereadable $fd $script]
 
  86         } elseif {$fd eq {}} {
 
  87             unset isonrunq($script)
 
  90         if {$t1 - $tstart >= 80} break
 
  97 proc reg_instance {fd} {
 
  98     global commfd leftover loginstance
 
 100     set i [incr loginstance]
 
 106 proc unmerged_files {files} {
 
 109     # find the list of unmerged files
 
 113         set fd [open "| git ls-files -u" r]
 
 115         show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
 
 118     while {[gets $fd line] >= 0} {
 
 119         set i [string first "\t" $line]
 
 121         set fname [string range $line [expr {$i+1}] end]
 
 122         if {[lsearch -exact $mlist $fname] >= 0} continue
 
 124         if {$files eq {} || [path_filter $files $fname]} {
 
 132 proc parseviewargs {n arglist} {
 
 133     global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
 
 134     global worddiff git_version
 
 142     set origargs $arglist
 
 146     foreach arg $arglist {
 
 153         switch -glob -- $arg {
 
 157                 # remove from origargs in case we hit an unknown option
 
 158                 set origargs [lreplace $origargs $i $i]
 
 162             "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
 
 163             "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
 
 164             "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
 
 165             "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
 
 166             "--ignore-space-change" - "-U*" - "--unified=*" {
 
 167                 # These request or affect diff output, which we don't want.
 
 168                 # Some could be used to set our defaults for diff display.
 
 169                 lappend diffargs $arg
 
 171             "--raw" - "--patch-with-raw" - "--patch-with-stat" -
 
 172             "--name-only" - "--name-status" - "--color" -
 
 173             "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
 
 174             "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
 
 175             "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
 
 176             "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
 
 177             "--objects" - "--objects-edge" - "--reverse" {
 
 178                 # These cause our parsing of git log's output to fail, or else
 
 179                 # they're options we want to set ourselves, so ignore them.
 
 181             "--color-words*" - "--word-diff=color" {
 
 182                 # These trigger a word diff in the console interface,
 
 183                 # so help the user by enabling our own support
 
 184                 if {[package vcompare $git_version "1.7.2"] >= 0} {
 
 185                     set worddiff [mc "Color words"]
 
 189                 if {[package vcompare $git_version "1.7.2"] >= 0} {
 
 190                     set worddiff [mc "Markup words"]
 
 193             "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
 
 194             "--check" - "--exit-code" - "--quiet" - "--topo-order" -
 
 195             "--full-history" - "--dense" - "--sparse" -
 
 196             "--follow" - "--left-right" - "--encoding=*" {
 
 197                 # These are harmless, and some are even useful
 
 200             "--diff-filter=*" - "--no-merges" - "--unpacked" -
 
 201             "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
 
 202             "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
 
 203             "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
 
 204             "--remove-empty" - "--first-parent" - "--cherry-pick" -
 
 205             "-S*" - "--pickaxe-all" - "--pickaxe-regex" -
 
 206             "--simplify-by-decoration" {
 
 207                 # These mean that we get a subset of the commits
 
 212                 # This appears to be the only one that has a value as a
 
 213                 # separate word following it
 
 223                 # git rev-parse doesn't understand --merge
 
 224                 lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
 
 226             "--no-replace-objects" {
 
 227                 set env(GIT_NO_REPLACE_OBJECTS) "1"
 
 230                 # Other flag arguments including -<n>
 
 231                 if {[string is digit -strict [string range $arg 1 end]]} {
 
 234                     # a flag argument that we don't recognize;
 
 235                     # that means we can't optimize
 
 241                 # Non-flag arguments specify commits or ranges of commits
 
 242                 if {[string match "*...*" $arg]} {
 
 243                     lappend revargs --gitk-symmetric-diff-marker
 
 249     set vdflags($n) $diffargs
 
 250     set vflags($n) $glflags
 
 251     set vrevs($n) $revargs
 
 252     set vfiltered($n) $filtered
 
 253     set vorigargs($n) $origargs
 
 257 proc parseviewrevs {view revs} {
 
 258     global vposids vnegids
 
 263     if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
 
 264         # we get stdout followed by stderr in $err
 
 265         # for an unknown rev, git rev-parse echoes it and then errors out
 
 266         set errlines [split $err "\n"]
 
 268         for {set l 0} {$l < [llength $errlines]} {incr l} {
 
 269             set line [lindex $errlines $l]
 
 270             if {!([string length $line] == 40 && [string is xdigit $line])} {
 
 271                 if {[string match "fatal:*" $line]} {
 
 272                     if {[string match "fatal: ambiguous argument*" $line]
 
 274                         if {[llength $badrev] == 1} {
 
 275                             set err "unknown revision $badrev"
 
 277                             set err "unknown revisions: [join $badrev ", "]"
 
 280                         set err [join [lrange $errlines $l end] "\n"]
 
 287         error_popup "[mc "Error parsing revisions:"] $err"
 
 294     foreach id [split $ids "\n"] {
 
 295         if {$id eq "--gitk-symmetric-diff-marker"} {
 
 297         } elseif {[string match "^*" $id]} {
 
 304             lappend neg [string range $id 1 end]
 
 309                 lset ret end $id...[lindex $ret end]
 
 315     set vposids($view) $pos
 
 316     set vnegids($view) $neg
 
 320 # Start off a git log process and arrange to read its output
 
 321 proc start_rev_list {view} {
 
 322     global startmsecs commitidx viewcomplete curview
 
 324     global viewargs viewargscmd viewfiles vfilelimit
 
 325     global showlocalchanges
 
 326     global viewactive viewinstances vmergeonly
 
 327     global mainheadid viewmainheadid viewmainheadid_orig
 
 328     global vcanopt vflags vrevs vorigargs
 
 331     set startmsecs [clock clicks -milliseconds]
 
 332     set commitidx($view) 0
 
 333     # these are set this way for the error exits
 
 334     set viewcomplete($view) 1
 
 335     set viewactive($view) 0
 
 338     set args $viewargs($view)
 
 339     if {$viewargscmd($view) ne {}} {
 
 341             set str [exec sh -c $viewargscmd($view)]
 
 343             error_popup "[mc "Error executing --argscmd command:"] $err"
 
 346         set args [concat $args [split $str "\n"]]
 
 348     set vcanopt($view) [parseviewargs $view $args]
 
 350     set files $viewfiles($view)
 
 351     if {$vmergeonly($view)} {
 
 352         set files [unmerged_files $files]
 
 355             if {$nr_unmerged == 0} {
 
 356                 error_popup [mc "No files selected: --merge specified but\
 
 357                              no files are unmerged."]
 
 359                 error_popup [mc "No files selected: --merge specified but\
 
 360                              no unmerged files are within file limit."]
 
 365     set vfilelimit($view) $files
 
 367     if {$vcanopt($view)} {
 
 368         set revs [parseviewrevs $view $vrevs($view)]
 
 372         set args [concat $vflags($view) $revs]
 
 374         set args $vorigargs($view)
 
 378         set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 
 379                         --parents --boundary $args "--" $files] r]
 
 381         error_popup "[mc "Error executing git log:"] $err"
 
 384     set i [reg_instance $fd]
 
 385     set viewinstances($view) [list $i]
 
 386     set viewmainheadid($view) $mainheadid
 
 387     set viewmainheadid_orig($view) $mainheadid
 
 388     if {$files ne {} && $mainheadid ne {}} {
 
 389         get_viewmainhead $view
 
 391     if {$showlocalchanges && $viewmainheadid($view) ne {}} {
 
 392         interestedin $viewmainheadid($view) dodiffindex
 
 394     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 
 395     if {$tclencoding != {}} {
 
 396         fconfigure $fd -encoding $tclencoding
 
 398     filerun $fd [list getcommitlines $fd $i $view 0]
 
 399     nowbusy $view [mc "Reading"]
 
 400     set viewcomplete($view) 0
 
 401     set viewactive($view) 1
 
 405 proc stop_instance {inst} {
 
 406     global commfd leftover
 
 408     set fd $commfd($inst)
 
 412         if {$::tcl_platform(platform) eq {windows}} {
 
 421     unset leftover($inst)
 
 424 proc stop_backends {} {
 
 427     foreach inst [array names commfd] {
 
 432 proc stop_rev_list {view} {
 
 435     foreach inst $viewinstances($view) {
 
 438     set viewinstances($view) {}
 
 441 proc reset_pending_select {selid} {
 
 442     global pending_select mainheadid selectheadid
 
 445         set pending_select $selid
 
 446     } elseif {$selectheadid ne {}} {
 
 447         set pending_select $selectheadid
 
 449         set pending_select $mainheadid
 
 453 proc getcommits {selid} {
 
 454     global canv curview need_redisplay viewactive
 
 457     if {[start_rev_list $curview]} {
 
 458         reset_pending_select $selid
 
 459         show_status [mc "Reading commits..."]
 
 462         show_status [mc "No commits selected"]
 
 466 proc updatecommits {} {
 
 467     global curview vcanopt vorigargs vfilelimit viewinstances
 
 468     global viewactive viewcomplete tclencoding
 
 469     global startmsecs showneartags showlocalchanges
 
 470     global mainheadid viewmainheadid viewmainheadid_orig pending_select
 
 472     global varcid vposids vnegids vflags vrevs
 
 475     set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
 
 478     if {$mainheadid ne $viewmainheadid_orig($view)} {
 
 479         if {$showlocalchanges} {
 
 482         set viewmainheadid($view) $mainheadid
 
 483         set viewmainheadid_orig($view) $mainheadid
 
 484         if {$vfilelimit($view) ne {}} {
 
 485             get_viewmainhead $view
 
 488     if {$showlocalchanges} {
 
 491     if {$vcanopt($view)} {
 
 492         set oldpos $vposids($view)
 
 493         set oldneg $vnegids($view)
 
 494         set revs [parseviewrevs $view $vrevs($view)]
 
 498         # note: getting the delta when negative refs change is hard,
 
 499         # and could require multiple git log invocations, so in that
 
 500         # case we ask git log for all the commits (not just the delta)
 
 501         if {$oldneg eq $vnegids($view)} {
 
 504             # take out positive refs that we asked for before or
 
 505             # that we have already seen
 
 507                 if {[string length $rev] == 40} {
 
 508                     if {[lsearch -exact $oldpos $rev] < 0
 
 509                         && ![info exists varcid($view,$rev)]} {
 
 514                     lappend $newrevs $rev
 
 517             if {$npos == 0} return
 
 519             set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
 
 521         set args [concat $vflags($view) $revs --not $oldpos]
 
 523         set args $vorigargs($view)
 
 526         set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 
 527                         --parents --boundary $args "--" $vfilelimit($view)] r]
 
 529         error_popup "[mc "Error executing git log:"] $err"
 
 532     if {$viewactive($view) == 0} {
 
 533         set startmsecs [clock clicks -milliseconds]
 
 535     set i [reg_instance $fd]
 
 536     lappend viewinstances($view) $i
 
 537     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 
 538     if {$tclencoding != {}} {
 
 539         fconfigure $fd -encoding $tclencoding
 
 541     filerun $fd [list getcommitlines $fd $i $view 1]
 
 542     incr viewactive($view)
 
 543     set viewcomplete($view) 0
 
 544     reset_pending_select {}
 
 545     nowbusy $view [mc "Reading"]
 
 551 proc reloadcommits {} {
 
 552     global curview viewcomplete selectedline currentid thickerline
 
 553     global showneartags treediffs commitinterest cached_commitrow
 
 557     if {$selectedline ne {}} {
 
 561     if {!$viewcomplete($curview)} {
 
 562         stop_rev_list $curview
 
 566     catch {unset currentid}
 
 567     catch {unset thickerline}
 
 568     catch {unset treediffs}
 
 575     catch {unset commitinterest}
 
 576     catch {unset cached_commitrow}
 
 577     catch {unset targetid}
 
 583 # This makes a string representation of a positive integer which
 
 584 # sorts as a string in numerical order
 
 587         return [format "%x" $n]
 
 588     } elseif {$n < 256} {
 
 589         return [format "x%.2x" $n]
 
 590     } elseif {$n < 65536} {
 
 591         return [format "y%.4x" $n]
 
 593     return [format "z%.8x" $n]
 
 596 # Procedures used in reordering commits from git log (without
 
 597 # --topo-order) into the order for display.
 
 599 proc varcinit {view} {
 
 600     global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
 
 601     global vtokmod varcmod vrowmod varcix vlastins
 
 603     set varcstart($view) {{}}
 
 604     set vupptr($view) {0}
 
 605     set vdownptr($view) {0}
 
 606     set vleftptr($view) {0}
 
 607     set vbackptr($view) {0}
 
 608     set varctok($view) {{}}
 
 609     set varcrow($view) {{}}
 
 610     set vtokmod($view) {}
 
 613     set varcix($view) {{}}
 
 614     set vlastins($view) {0}
 
 617 proc resetvarcs {view} {
 
 618     global varcid varccommits parents children vseedcount ordertok
 
 620     foreach vid [array names varcid $view,*] {
 
 625     # some commits might have children but haven't been seen yet
 
 626     foreach vid [array names children $view,*] {
 
 629     foreach va [array names varccommits $view,*] {
 
 630         unset varccommits($va)
 
 632     foreach vd [array names vseedcount $view,*] {
 
 633         unset vseedcount($vd)
 
 635     catch {unset ordertok}
 
 638 # returns a list of the commits with no children
 
 640     global vdownptr vleftptr varcstart
 
 643     set a [lindex $vdownptr($v) 0]
 
 645         lappend ret [lindex $varcstart($v) $a]
 
 646         set a [lindex $vleftptr($v) $a]
 
 651 proc newvarc {view id} {
 
 652     global varcid varctok parents children vdatemode
 
 653     global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
 
 654     global commitdata commitinfo vseedcount varccommits vlastins
 
 656     set a [llength $varctok($view)]
 
 658     if {[llength $children($vid)] == 0 || $vdatemode($view)} {
 
 659         if {![info exists commitinfo($id)]} {
 
 660             parsecommit $id $commitdata($id) 1
 
 662         set cdate [lindex $commitinfo($id) 4]
 
 663         if {![string is integer -strict $cdate]} {
 
 666         if {![info exists vseedcount($view,$cdate)]} {
 
 667             set vseedcount($view,$cdate) -1
 
 669         set c [incr vseedcount($view,$cdate)]
 
 670         set cdate [expr {$cdate ^ 0xffffffff}]
 
 671         set tok "s[strrep $cdate][strrep $c]"
 
 676     if {[llength $children($vid)] > 0} {
 
 677         set kid [lindex $children($vid) end]
 
 678         set k $varcid($view,$kid)
 
 679         if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
 
 682             set tok [lindex $varctok($view) $k]
 
 686         set i [lsearch -exact $parents($view,$ki) $id]
 
 687         set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 
 688         append tok [strrep $j]
 
 690     set c [lindex $vlastins($view) $ka]
 
 691     if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
 
 693         set b [lindex $vdownptr($view) $ka]
 
 695         set b [lindex $vleftptr($view) $c]
 
 697     while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 
 699         set b [lindex $vleftptr($view) $c]
 
 702         lset vdownptr($view) $ka $a
 
 703         lappend vbackptr($view) 0
 
 705         lset vleftptr($view) $c $a
 
 706         lappend vbackptr($view) $c
 
 708     lset vlastins($view) $ka $a
 
 709     lappend vupptr($view) $ka
 
 710     lappend vleftptr($view) $b
 
 712         lset vbackptr($view) $b $a
 
 714     lappend varctok($view) $tok
 
 715     lappend varcstart($view) $id
 
 716     lappend vdownptr($view) 0
 
 717     lappend varcrow($view) {}
 
 718     lappend varcix($view) {}
 
 719     set varccommits($view,$a) {}
 
 720     lappend vlastins($view) 0
 
 724 proc splitvarc {p v} {
 
 725     global varcid varcstart varccommits varctok vtokmod
 
 726     global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
 
 728     set oa $varcid($v,$p)
 
 729     set otok [lindex $varctok($v) $oa]
 
 730     set ac $varccommits($v,$oa)
 
 731     set i [lsearch -exact $varccommits($v,$oa) $p]
 
 733     set na [llength $varctok($v)]
 
 734     # "%" sorts before "0"...
 
 735     set tok "$otok%[strrep $i]"
 
 736     lappend varctok($v) $tok
 
 737     lappend varcrow($v) {}
 
 738     lappend varcix($v) {}
 
 739     set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 
 740     set varccommits($v,$na) [lrange $ac $i end]
 
 741     lappend varcstart($v) $p
 
 742     foreach id $varccommits($v,$na) {
 
 743         set varcid($v,$id) $na
 
 745     lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 
 746     lappend vlastins($v) [lindex $vlastins($v) $oa]
 
 747     lset vdownptr($v) $oa $na
 
 748     lset vlastins($v) $oa 0
 
 749     lappend vupptr($v) $oa
 
 750     lappend vleftptr($v) 0
 
 751     lappend vbackptr($v) 0
 
 752     for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 
 753         lset vupptr($v) $b $na
 
 755     if {[string compare $otok $vtokmod($v)] <= 0} {
 
 760 proc renumbervarc {a v} {
 
 761     global parents children varctok varcstart varccommits
 
 762     global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
 
 764     set t1 [clock clicks -milliseconds]
 
 770         if {[info exists isrelated($a)]} {
 
 772             set id [lindex $varccommits($v,$a) end]
 
 773             foreach p $parents($v,$id) {
 
 774                 if {[info exists varcid($v,$p)]} {
 
 775                     set isrelated($varcid($v,$p)) 1
 
 780         set b [lindex $vdownptr($v) $a]
 
 783                 set b [lindex $vleftptr($v) $a]
 
 785                 set a [lindex $vupptr($v) $a]
 
 791         if {![info exists kidchanged($a)]} continue
 
 792         set id [lindex $varcstart($v) $a]
 
 793         if {[llength $children($v,$id)] > 1} {
 
 794             set children($v,$id) [lsort -command [list vtokcmp $v] \
 
 797         set oldtok [lindex $varctok($v) $a]
 
 798         if {!$vdatemode($v)} {
 
 804         set kid [last_real_child $v,$id]
 
 806             set k $varcid($v,$kid)
 
 807             if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
 
 810                 set tok [lindex $varctok($v) $k]
 
 814             set i [lsearch -exact $parents($v,$ki) $id]
 
 815             set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 
 816             append tok [strrep $j]
 
 818         if {$tok eq $oldtok} {
 
 821         set id [lindex $varccommits($v,$a) end]
 
 822         foreach p $parents($v,$id) {
 
 823             if {[info exists varcid($v,$p)]} {
 
 824                 set kidchanged($varcid($v,$p)) 1
 
 829         lset varctok($v) $a $tok
 
 830         set b [lindex $vupptr($v) $a]
 
 832             if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
 
 835             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 
 838             set c [lindex $vbackptr($v) $a]
 
 839             set d [lindex $vleftptr($v) $a]
 
 841                 lset vdownptr($v) $b $d
 
 843                 lset vleftptr($v) $c $d
 
 846                 lset vbackptr($v) $d $c
 
 848             if {[lindex $vlastins($v) $b] == $a} {
 
 849                 lset vlastins($v) $b $c
 
 851             lset vupptr($v) $a $ka
 
 852             set c [lindex $vlastins($v) $ka]
 
 854                     [string compare $tok [lindex $varctok($v) $c]] < 0} {
 
 856                 set b [lindex $vdownptr($v) $ka]
 
 858                 set b [lindex $vleftptr($v) $c]
 
 861                       [string compare $tok [lindex $varctok($v) $b]] >= 0} {
 
 863                 set b [lindex $vleftptr($v) $c]
 
 866                 lset vdownptr($v) $ka $a
 
 867                 lset vbackptr($v) $a 0
 
 869                 lset vleftptr($v) $c $a
 
 870                 lset vbackptr($v) $a $c
 
 872             lset vleftptr($v) $a $b
 
 874                 lset vbackptr($v) $b $a
 
 876             lset vlastins($v) $ka $a
 
 879     foreach id [array names sortkids] {
 
 880         if {[llength $children($v,$id)] > 1} {
 
 881             set children($v,$id) [lsort -command [list vtokcmp $v] \
 
 885     set t2 [clock clicks -milliseconds]
 
 886     #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 
 889 # Fix up the graph after we have found out that in view $v,
 
 890 # $p (a commit that we have already seen) is actually the parent
 
 891 # of the last commit in arc $a.
 
 892 proc fix_reversal {p a v} {
 
 893     global varcid varcstart varctok vupptr
 
 895     set pa $varcid($v,$p)
 
 896     if {$p ne [lindex $varcstart($v) $pa]} {
 
 898         set pa $varcid($v,$p)
 
 900     # seeds always need to be renumbered
 
 901     if {[lindex $vupptr($v) $pa] == 0 ||
 
 902         [string compare [lindex $varctok($v) $a] \
 
 903              [lindex $varctok($v) $pa]] > 0} {
 
 908 proc insertrow {id p v} {
 
 909     global cmitlisted children parents varcid varctok vtokmod
 
 910     global varccommits ordertok commitidx numcommits curview
 
 911     global targetid targetrow
 
 915     set cmitlisted($vid) 1
 
 916     set children($vid) {}
 
 917     set parents($vid) [list $p]
 
 918     set a [newvarc $v $id]
 
 920     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
 
 923     lappend varccommits($v,$a) $id
 
 925     if {[llength [lappend children($vp) $id]] > 1} {
 
 926         set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
 
 927         catch {unset ordertok}
 
 929     fix_reversal $p $a $v
 
 931     if {$v == $curview} {
 
 932         set numcommits $commitidx($v)
 
 934         if {[info exists targetid]} {
 
 935             if {![comes_before $targetid $p]} {
 
 942 proc insertfakerow {id p} {
 
 943     global varcid varccommits parents children cmitlisted
 
 944     global commitidx varctok vtokmod targetid targetrow curview numcommits
 
 948     set i [lsearch -exact $varccommits($v,$a) $p]
 
 950         puts "oops: insertfakerow can't find [shortids $p] on arc $a"
 
 953     set children($v,$id) {}
 
 954     set parents($v,$id) [list $p]
 
 955     set varcid($v,$id) $a
 
 956     lappend children($v,$p) $id
 
 957     set cmitlisted($v,$id) 1
 
 958     set numcommits [incr commitidx($v)]
 
 959     # note we deliberately don't update varcstart($v) even if $i == 0
 
 960     set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
 
 962     if {[info exists targetid]} {
 
 963         if {![comes_before $targetid $p]} {
 
 971 proc removefakerow {id} {
 
 972     global varcid varccommits parents children commitidx
 
 973     global varctok vtokmod cmitlisted currentid selectedline
 
 974     global targetid curview numcommits
 
 977     if {[llength $parents($v,$id)] != 1} {
 
 978         puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
 
 981     set p [lindex $parents($v,$id) 0]
 
 982     set a $varcid($v,$id)
 
 983     set i [lsearch -exact $varccommits($v,$a) $id]
 
 985         puts "oops: removefakerow can't find [shortids $id] on arc $a"
 
 989     set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
 
 990     unset parents($v,$id)
 
 991     unset children($v,$id)
 
 992     unset cmitlisted($v,$id)
 
 993     set numcommits [incr commitidx($v) -1]
 
 994     set j [lsearch -exact $children($v,$p) $id]
 
 996         set children($v,$p) [lreplace $children($v,$p) $j $j]
 
 999     if {[info exist currentid] && $id eq $currentid} {
 
1003     if {[info exists targetid] && $targetid eq $id} {
 
1010 proc real_children {vp} {
 
1011     global children nullid nullid2
 
1014     foreach id $children($vp) {
 
1015         if {$id ne $nullid && $id ne $nullid2} {
 
1022 proc first_real_child {vp} {
 
1023     global children nullid nullid2
 
1025     foreach id $children($vp) {
 
1026         if {$id ne $nullid && $id ne $nullid2} {
 
1033 proc last_real_child {vp} {
 
1034     global children nullid nullid2
 
1036     set kids $children($vp)
 
1037     for {set i [llength $kids]} {[incr i -1] >= 0} {} {
 
1038         set id [lindex $kids $i]
 
1039         if {$id ne $nullid && $id ne $nullid2} {
 
1046 proc vtokcmp {v a b} {
 
1047     global varctok varcid
 
1049     return [string compare [lindex $varctok($v) $varcid($v,$a)] \
 
1050                 [lindex $varctok($v) $varcid($v,$b)]]
 
1053 # This assumes that if lim is not given, the caller has checked that
 
1054 # arc a's token is less than $vtokmod($v)
 
1055 proc modify_arc {v a {lim {}}} {
 
1056     global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
 
1059         set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
 
1062             set r [lindex $varcrow($v) $a]
 
1063             if {$r ne {} && $vrowmod($v) <= $r + $lim} return
 
1066     set vtokmod($v) [lindex $varctok($v) $a]
 
1068     if {$v == $curview} {
 
1069         while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
 
1070             set a [lindex $vupptr($v) $a]
 
1076                 set lim [llength $varccommits($v,$a)]
 
1078             set r [expr {[lindex $varcrow($v) $a] + $lim}]
 
1085 proc update_arcrows {v} {
 
1086     global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
 
1087     global varcid vrownum varcorder varcix varccommits
 
1088     global vupptr vdownptr vleftptr varctok
 
1089     global displayorder parentlist curview cached_commitrow
 
1091     if {$vrowmod($v) == $commitidx($v)} return
 
1092     if {$v == $curview} {
 
1093         if {[llength $displayorder] > $vrowmod($v)} {
 
1094             set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
 
1095             set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
 
1097         catch {unset cached_commitrow}
 
1099     set narctot [expr {[llength $varctok($v)] - 1}]
 
1101     while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
 
1102         # go up the tree until we find something that has a row number,
 
1103         # or we get to a seed
 
1104         set a [lindex $vupptr($v) $a]
 
1107         set a [lindex $vdownptr($v) 0]
 
1110         set varcorder($v) [list $a]
 
1111         lset varcix($v) $a 0
 
1112         lset varcrow($v) $a 0
 
1116         set arcn [lindex $varcix($v) $a]
 
1117         if {[llength $vrownum($v)] > $arcn + 1} {
 
1118             set vrownum($v) [lrange $vrownum($v) 0 $arcn]
 
1119             set varcorder($v) [lrange $varcorder($v) 0 $arcn]
 
1121         set row [lindex $varcrow($v) $a]
 
1125         incr row [llength $varccommits($v,$a)]
 
1126         # go down if possible
 
1127         set b [lindex $vdownptr($v) $a]
 
1129             # if not, go left, or go up until we can go left
 
1131                 set b [lindex $vleftptr($v) $a]
 
1133                 set a [lindex $vupptr($v) $a]
 
1139         lappend vrownum($v) $row
 
1140         lappend varcorder($v) $a
 
1141         lset varcix($v) $a $arcn
 
1142         lset varcrow($v) $a $row
 
1144     set vtokmod($v) [lindex $varctok($v) $p]
 
1146     set vrowmod($v) $row
 
1147     if {[info exists currentid]} {
 
1148         set selectedline [rowofcommit $currentid]
 
1152 # Test whether view $v contains commit $id
 
1153 proc commitinview {id v} {
 
1156     return [info exists varcid($v,$id)]
 
1159 # Return the row number for commit $id in the current view
 
1160 proc rowofcommit {id} {
 
1161     global varcid varccommits varcrow curview cached_commitrow
 
1162     global varctok vtokmod
 
1165     if {![info exists varcid($v,$id)]} {
 
1166         puts "oops rowofcommit no arc for [shortids $id]"
 
1169     set a $varcid($v,$id)
 
1170     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
 
1173     if {[info exists cached_commitrow($id)]} {
 
1174         return $cached_commitrow($id)
 
1176     set i [lsearch -exact $varccommits($v,$a) $id]
 
1178         puts "oops didn't find commit [shortids $id] in arc $a"
 
1181     incr i [lindex $varcrow($v) $a]
 
1182     set cached_commitrow($id) $i
 
1186 # Returns 1 if a is on an earlier row than b, otherwise 0
 
1187 proc comes_before {a b} {
 
1188     global varcid varctok curview
 
1191     if {$a eq $b || ![info exists varcid($v,$a)] || \
 
1192             ![info exists varcid($v,$b)]} {
 
1195     if {$varcid($v,$a) != $varcid($v,$b)} {
 
1196         return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
 
1197                            [lindex $varctok($v) $varcid($v,$b)]] < 0}]
 
1199     return [expr {[rowofcommit $a] < [rowofcommit $b]}]
 
1202 proc bsearch {l elt} {
 
1203     if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
 
1208     while {$hi - $lo > 1} {
 
1209         set mid [expr {int(($lo + $hi) / 2)}]
 
1210         set t [lindex $l $mid]
 
1213         } elseif {$elt > $t} {
 
1222 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
 
1223 proc make_disporder {start end} {
 
1224     global vrownum curview commitidx displayorder parentlist
 
1225     global varccommits varcorder parents vrowmod varcrow
 
1226     global d_valid_start d_valid_end
 
1228     if {$end > $vrowmod($curview)} {
 
1229         update_arcrows $curview
 
1231     set ai [bsearch $vrownum($curview) $start]
 
1232     set start [lindex $vrownum($curview) $ai]
 
1233     set narc [llength $vrownum($curview)]
 
1234     for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
 
1235         set a [lindex $varcorder($curview) $ai]
 
1236         set l [llength $displayorder]
 
1237         set al [llength $varccommits($curview,$a)]
 
1238         if {$l < $r + $al} {
 
1240                 set pad [ntimes [expr {$r - $l}] {}]
 
1241                 set displayorder [concat $displayorder $pad]
 
1242                 set parentlist [concat $parentlist $pad]
 
1243             } elseif {$l > $r} {
 
1244                 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
 
1245                 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
 
1247             foreach id $varccommits($curview,$a) {
 
1248                 lappend displayorder $id
 
1249                 lappend parentlist $parents($curview,$id)
 
1251         } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
 
1253             foreach id $varccommits($curview,$a) {
 
1254                 lset displayorder $i $id
 
1255                 lset parentlist $i $parents($curview,$id)
 
1263 proc commitonrow {row} {
 
1266     set id [lindex $displayorder $row]
 
1268         make_disporder $row [expr {$row + 1}]
 
1269         set id [lindex $displayorder $row]
 
1274 proc closevarcs {v} {
 
1275     global varctok varccommits varcid parents children
 
1276     global cmitlisted commitidx vtokmod
 
1278     set missing_parents 0
 
1280     set narcs [llength $varctok($v)]
 
1281     for {set a 1} {$a < $narcs} {incr a} {
 
1282         set id [lindex $varccommits($v,$a) end]
 
1283         foreach p $parents($v,$id) {
 
1284             if {[info exists varcid($v,$p)]} continue
 
1285             # add p as a new commit
 
1286             incr missing_parents
 
1287             set cmitlisted($v,$p) 0
 
1288             set parents($v,$p) {}
 
1289             if {[llength $children($v,$p)] == 1 &&
 
1290                 [llength $parents($v,$id)] == 1} {
 
1293                 set b [newvarc $v $p]
 
1295             set varcid($v,$p) $b
 
1296             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 
1299             lappend varccommits($v,$b) $p
 
1301             set scripts [check_interest $p $scripts]
 
1304     if {$missing_parents > 0} {
 
1305         foreach s $scripts {
 
1311 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
 
1312 # Assumes we already have an arc for $rwid.
 
1313 proc rewrite_commit {v id rwid} {
 
1314     global children parents varcid varctok vtokmod varccommits
 
1316     foreach ch $children($v,$id) {
 
1317         # make $rwid be $ch's parent in place of $id
 
1318         set i [lsearch -exact $parents($v,$ch) $id]
 
1320             puts "oops rewrite_commit didn't find $id in parent list for $ch"
 
1322         set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
 
1323         # add $ch to $rwid's children and sort the list if necessary
 
1324         if {[llength [lappend children($v,$rwid) $ch]] > 1} {
 
1325             set children($v,$rwid) [lsort -command [list vtokcmp $v] \
 
1326                                         $children($v,$rwid)]
 
1328         # fix the graph after joining $id to $rwid
 
1329         set a $varcid($v,$ch)
 
1330         fix_reversal $rwid $a $v
 
1331         # parentlist is wrong for the last element of arc $a
 
1332         # even if displayorder is right, hence the 3rd arg here
 
1333         modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
 
1337 # Mechanism for registering a command to be executed when we come
 
1338 # across a particular commit.  To handle the case when only the
 
1339 # prefix of the commit is known, the commitinterest array is now
 
1340 # indexed by the first 4 characters of the ID.  Each element is a
 
1341 # list of id, cmd pairs.
 
1342 proc interestedin {id cmd} {
 
1343     global commitinterest
 
1345     lappend commitinterest([string range $id 0 3]) $id $cmd
 
1348 proc check_interest {id scripts} {
 
1349     global commitinterest
 
1351     set prefix [string range $id 0 3]
 
1352     if {[info exists commitinterest($prefix)]} {
 
1354         foreach {i script} $commitinterest($prefix) {
 
1355             if {[string match "$i*" $id]} {
 
1356                 lappend scripts [string map [list "%I" $id "%P" $i] $script]
 
1358                 lappend newlist $i $script
 
1361         if {$newlist ne {}} {
 
1362             set commitinterest($prefix) $newlist
 
1364             unset commitinterest($prefix)
 
1370 proc getcommitlines {fd inst view updating}  {
 
1371     global cmitlisted leftover
 
1372     global commitidx commitdata vdatemode
 
1373     global parents children curview hlview
 
1374     global idpending ordertok
 
1375     global varccommits varcid varctok vtokmod vfilelimit
 
1377     set stuff [read $fd 500000]
 
1378     # git log doesn't terminate the last commit with a null...
 
1379     if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
 
1386         global commfd viewcomplete viewactive viewname
 
1387         global viewinstances
 
1389         set i [lsearch -exact $viewinstances($view) $inst]
 
1391             set viewinstances($view) [lreplace $viewinstances($view) $i $i]
 
1393         # set it blocking so we wait for the process to terminate
 
1394         fconfigure $fd -blocking 1
 
1395         if {[catch {close $fd} err]} {
 
1397             if {$view != $curview} {
 
1398                 set fv " for the \"$viewname($view)\" view"
 
1400             if {[string range $err 0 4] == "usage"} {
 
1401                 set err "Gitk: error reading commits$fv:\
 
1402                         bad arguments to git log."
 
1403                 if {$viewname($view) eq "Command line"} {
 
1405                         "  (Note: arguments to gitk are passed to git log\
 
1406                          to allow selection of commits to be displayed.)"
 
1409                 set err "Error reading commits$fv: $err"
 
1413         if {[incr viewactive($view) -1] <= 0} {
 
1414             set viewcomplete($view) 1
 
1415             # Check if we have seen any ids listed as parents that haven't
 
1416             # appeared in the list
 
1420         if {$view == $curview} {
 
1429         set i [string first "\0" $stuff $start]
 
1431             append leftover($inst) [string range $stuff $start end]
 
1435             set cmit $leftover($inst)
 
1436             append cmit [string range $stuff 0 [expr {$i - 1}]]
 
1437             set leftover($inst) {}
 
1439             set cmit [string range $stuff $start [expr {$i - 1}]]
 
1441         set start [expr {$i + 1}]
 
1442         set j [string first "\n" $cmit]
 
1445         if {$j >= 0 && [string match "commit *" $cmit]} {
 
1446             set ids [string range $cmit 7 [expr {$j - 1}]]
 
1447             if {[string match {[-^<>]*} $ids]} {
 
1448                 switch -- [string index $ids 0] {
 
1454                 set ids [string range $ids 1 end]
 
1458                 if {[string length $id] != 40} {
 
1466             if {[string length $shortcmit] > 80} {
 
1467                 set shortcmit "[string range $shortcmit 0 80]..."
 
1469             error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
 
1472         set id [lindex $ids 0]
 
1475         if {!$listed && $updating && ![info exists varcid($vid)] &&
 
1476             $vfilelimit($view) ne {}} {
 
1477             # git log doesn't rewrite parents for unlisted commits
 
1478             # when doing path limiting, so work around that here
 
1479             # by working out the rewritten parent with git rev-list
 
1480             # and if we already know about it, using the rewritten
 
1481             # parent as a substitute parent for $id's children.
 
1483                 set rwid [exec git rev-list --first-parent --max-count=1 \
 
1484                               $id -- $vfilelimit($view)]
 
1486                 if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
 
1487                     # use $rwid in place of $id
 
1488                     rewrite_commit $view $id $rwid
 
1495         if {[info exists varcid($vid)]} {
 
1496             if {$cmitlisted($vid) || !$listed} continue
 
1500             set olds [lrange $ids 1 end]
 
1504         set commitdata($id) [string range $cmit [expr {$j + 1}] end]
 
1505         set cmitlisted($vid) $listed
 
1506         set parents($vid) $olds
 
1507         if {![info exists children($vid)]} {
 
1508             set children($vid) {}
 
1509         } elseif {$a == 0 && [llength $children($vid)] == 1} {
 
1510             set k [lindex $children($vid) 0]
 
1511             if {[llength $parents($view,$k)] == 1 &&
 
1512                 (!$vdatemode($view) ||
 
1513                  $varcid($view,$k) == [llength $varctok($view)] - 1)} {
 
1514                 set a $varcid($view,$k)
 
1519             set a [newvarc $view $id]
 
1521         if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
 
1524         if {![info exists varcid($vid)]} {
 
1526             lappend varccommits($view,$a) $id
 
1527             incr commitidx($view)
 
1532             if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
 
1534                 if {[llength [lappend children($vp) $id]] > 1 &&
 
1535                     [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
 
1536                     set children($vp) [lsort -command [list vtokcmp $view] \
 
1538                     catch {unset ordertok}
 
1540                 if {[info exists varcid($view,$p)]} {
 
1541                     fix_reversal $p $a $view
 
1547         set scripts [check_interest $id $scripts]
 
1551         global numcommits hlview
 
1553         if {$view == $curview} {
 
1554             set numcommits $commitidx($view)
 
1557         if {[info exists hlview] && $view == $hlview} {
 
1558             # we never actually get here...
 
1561         foreach s $scripts {
 
1568 proc chewcommits {} {
 
1569     global curview hlview viewcomplete
 
1570     global pending_select
 
1573     if {$viewcomplete($curview)} {
 
1574         global commitidx varctok
 
1575         global numcommits startmsecs
 
1577         if {[info exists pending_select]} {
 
1579             reset_pending_select {}
 
1581             if {[commitinview $pending_select $curview]} {
 
1582                 selectline [rowofcommit $pending_select] 1
 
1584                 set row [first_real_row]
 
1588         if {$commitidx($curview) > 0} {
 
1589             #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
 
1590             #puts "overall $ms ms for $numcommits commits"
 
1591             #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
 
1593             show_status [mc "No commits selected"]
 
1600 proc do_readcommit {id} {
 
1603     # Invoke git-log to handle automatic encoding conversion
 
1604     set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
 
1605     # Read the results using i18n.logoutputencoding
 
1606     fconfigure $fd -translation lf -eofchar {}
 
1607     if {$tclencoding != {}} {
 
1608         fconfigure $fd -encoding $tclencoding
 
1610     set contents [read $fd]
 
1612     # Remove the heading line
 
1613     regsub {^commit [0-9a-f]+\n} $contents {} contents
 
1618 proc readcommit {id} {
 
1619     if {[catch {set contents [do_readcommit $id]}]} return
 
1620     parsecommit $id $contents 1
 
1623 proc parsecommit {id contents listed} {
 
1624     global commitinfo cdate
 
1633     set hdrend [string first "\n\n" $contents]
 
1635         # should never happen...
 
1636         set hdrend [string length $contents]
 
1638     set header [string range $contents 0 [expr {$hdrend - 1}]]
 
1639     set comment [string range $contents [expr {$hdrend + 2}] end]
 
1640     foreach line [split $header "\n"] {
 
1641         set line [split $line " "]
 
1642         set tag [lindex $line 0]
 
1643         if {$tag == "author"} {
 
1644             set audate [lindex $line end-1]
 
1645             set auname [join [lrange $line 1 end-2] " "]
 
1646         } elseif {$tag == "committer"} {
 
1647             set comdate [lindex $line end-1]
 
1648             set comname [join [lrange $line 1 end-2] " "]
 
1652     # take the first non-blank line of the comment as the headline
 
1653     set headline [string trimleft $comment]
 
1654     set i [string first "\n" $headline]
 
1656         set headline [string range $headline 0 $i]
 
1658     set headline [string trimright $headline]
 
1659     set i [string first "\r" $headline]
 
1661         set headline [string trimright [string range $headline 0 $i]]
 
1664         # git log indents the comment by 4 spaces;
 
1665         # if we got this via git cat-file, add the indentation
 
1667         foreach line [split $comment "\n"] {
 
1668             append newcomment "    "
 
1669             append newcomment $line
 
1670             append newcomment "\n"
 
1672         set comment $newcomment
 
1674     if {$comdate != {}} {
 
1675         set cdate($id) $comdate
 
1677     set commitinfo($id) [list $headline $auname $audate \
 
1678                              $comname $comdate $comment]
 
1681 proc getcommit {id} {
 
1682     global commitdata commitinfo
 
1684     if {[info exists commitdata($id)]} {
 
1685         parsecommit $id $commitdata($id) 1
 
1688         if {![info exists commitinfo($id)]} {
 
1689             set commitinfo($id) [list [mc "No commit information available"]]
 
1695 # Expand an abbreviated commit ID to a list of full 40-char IDs that match
 
1696 # and are present in the current view.
 
1697 # This is fairly slow...
 
1698 proc longid {prefix} {
 
1699     global varcid curview
 
1702     foreach match [array names varcid "$curview,$prefix*"] {
 
1703         lappend ids [lindex [split $match ","] 1]
 
1709     global tagids idtags headids idheads tagobjid
 
1710     global otherrefids idotherrefs mainhead mainheadid
 
1711     global selecthead selectheadid
 
1714     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
 
1717     set refd [open [list | git show-ref -d] r]
 
1718     while {[gets $refd line] >= 0} {
 
1719         if {[string index $line 40] ne " "} continue
 
1720         set id [string range $line 0 39]
 
1721         set ref [string range $line 41 end]
 
1722         if {![string match "refs/*" $ref]} continue
 
1723         set name [string range $ref 5 end]
 
1724         if {[string match "remotes/*" $name]} {
 
1725             if {![string match "*/HEAD" $name] && !$hideremotes} {
 
1726                 set headids($name) $id
 
1727                 lappend idheads($id) $name
 
1729         } elseif {[string match "heads/*" $name]} {
 
1730             set name [string range $name 6 end]
 
1731             set headids($name) $id
 
1732             lappend idheads($id) $name
 
1733         } elseif {[string match "tags/*" $name]} {
 
1734             # this lets refs/tags/foo^{} overwrite refs/tags/foo,
 
1735             # which is what we want since the former is the commit ID
 
1736             set name [string range $name 5 end]
 
1737             if {[string match "*^{}" $name]} {
 
1738                 set name [string range $name 0 end-3]
 
1740                 set tagobjid($name) $id
 
1742             set tagids($name) $id
 
1743             lappend idtags($id) $name
 
1745             set otherrefids($name) $id
 
1746             lappend idotherrefs($id) $name
 
1753         set mainheadid [exec git rev-parse HEAD]
 
1754         set thehead [exec git symbolic-ref HEAD]
 
1755         if {[string match "refs/heads/*" $thehead]} {
 
1756             set mainhead [string range $thehead 11 end]
 
1760     if {$selecthead ne {}} {
 
1762             set selectheadid [exec git rev-parse --verify $selecthead]
 
1767 # skip over fake commits
 
1768 proc first_real_row {} {
 
1769     global nullid nullid2 numcommits
 
1771     for {set row 0} {$row < $numcommits} {incr row} {
 
1772         set id [commitonrow $row]
 
1773         if {$id ne $nullid && $id ne $nullid2} {
 
1780 # update things for a head moved to a child of its previous location
 
1781 proc movehead {id name} {
 
1782     global headids idheads
 
1784     removehead $headids($name) $name
 
1785     set headids($name) $id
 
1786     lappend idheads($id) $name
 
1789 # update things when a head has been removed
 
1790 proc removehead {id name} {
 
1791     global headids idheads
 
1793     if {$idheads($id) eq $name} {
 
1796         set i [lsearch -exact $idheads($id) $name]
 
1798             set idheads($id) [lreplace $idheads($id) $i $i]
 
1801     unset headids($name)
 
1804 proc ttk_toplevel {w args} {
 
1806     eval [linsert $args 0 ::toplevel $w]
 
1808         place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
 
1813 proc make_transient {window origin} {
 
1816     # In MacOS Tk 8.4 transient appears to work by setting
 
1817     # overrideredirect, which is utterly useless, since the
 
1818     # windows get no border, and are not even kept above
 
1820     if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
 
1822     wm transient $window $origin
 
1824     # Windows fails to place transient windows normally, so
 
1825     # schedule a callback to center them on the parent.
 
1826     if {[tk windowingsystem] eq {win32}} {
 
1827         after idle [list tk::PlaceWindow $window widget $origin]
 
1831 proc show_error {w top msg {mc mc}} {
 
1833     if {![info exists NS]} {set NS ""}
 
1834     if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
 
1835     message $w.m -text $msg -justify center -aspect 400
 
1836     pack $w.m -side top -fill x -padx 20 -pady 20
 
1837     ${NS}::button $w.ok -default active -text [$mc OK] -command "destroy $top"
 
1838     pack $w.ok -side bottom -fill x
 
1839     bind $top <Visibility> "grab $top; focus $top"
 
1840     bind $top <Key-Return> "destroy $top"
 
1841     bind $top <Key-space>  "destroy $top"
 
1842     bind $top <Key-Escape> "destroy $top"
 
1846 proc error_popup {msg {owner .}} {
 
1847     if {[tk windowingsystem] eq "win32"} {
 
1848         tk_messageBox -icon error -type ok -title [wm title .] \
 
1849             -parent $owner -message $msg
 
1853         make_transient $w $owner
 
1854         show_error $w $w $msg
 
1858 proc confirm_popup {msg {owner .}} {
 
1859     global confirm_ok NS
 
1863     make_transient $w $owner
 
1864     message $w.m -text $msg -justify center -aspect 400
 
1865     pack $w.m -side top -fill x -padx 20 -pady 20
 
1866     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
 
1867     pack $w.ok -side left -fill x
 
1868     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
 
1869     pack $w.cancel -side right -fill x
 
1870     bind $w <Visibility> "grab $w; focus $w"
 
1871     bind $w <Key-Return> "set confirm_ok 1; destroy $w"
 
1872     bind $w <Key-space>  "set confirm_ok 1; destroy $w"
 
1873     bind $w <Key-Escape> "destroy $w"
 
1874     tk::PlaceWindow $w widget $owner
 
1879 proc setoptions {} {
 
1880     if {[tk windowingsystem] ne "win32"} {
 
1881         option add *Panedwindow.showHandle 1 startupFile
 
1882         option add *Panedwindow.sashRelief raised startupFile
 
1883         if {[tk windowingsystem] ne "aqua"} {
 
1884             option add *Menu.font uifont startupFile
 
1887         option add *Menu.TearOff 0 startupFile
 
1889     option add *Button.font uifont startupFile
 
1890     option add *Checkbutton.font uifont startupFile
 
1891     option add *Radiobutton.font uifont startupFile
 
1892     option add *Menubutton.font uifont startupFile
 
1893     option add *Label.font uifont startupFile
 
1894     option add *Message.font uifont startupFile
 
1895     option add *Entry.font textfont startupFile
 
1896     option add *Text.font textfont startupFile
 
1897     option add *Labelframe.font uifont startupFile
 
1898     option add *Spinbox.font textfont startupFile
 
1899     option add *Listbox.font mainfont startupFile
 
1902 # Make a menu and submenus.
 
1903 # m is the window name for the menu, items is the list of menu items to add.
 
1904 # Each item is a list {mc label type description options...}
 
1905 # mc is ignored; it's so we can put mc there to alert xgettext
 
1906 # label is the string that appears in the menu
 
1907 # type is cascade, command or radiobutton (should add checkbutton)
 
1908 # description depends on type; it's the sublist for cascade, the
 
1909 # command to invoke for command, or {variable value} for radiobutton
 
1910 proc makemenu {m items} {
 
1912     if {[tk windowingsystem] eq {aqua}} {
 
1918         set name [mc [lindex $i 1]]
 
1919         set type [lindex $i 2]
 
1920         set thing [lindex $i 3]
 
1921         set params [list $type]
 
1923             set u [string first "&" [string map {&& x} $name]]
 
1924             lappend params -label [string map {&& & & {}} $name]
 
1926                 lappend params -underline $u
 
1931                 set submenu [string tolower [string map {& ""} [lindex $i 1]]]
 
1932                 lappend params -menu $m.$submenu
 
1935                 lappend params -command $thing
 
1938                 lappend params -variable [lindex $thing 0] \
 
1939                     -value [lindex $thing 1]
 
1942         set tail [lrange $i 4 end]
 
1943         regsub -all {\yMeta1\y} $tail $Meta1 tail
 
1944         eval $m add $params $tail
 
1945         if {$type eq "cascade"} {
 
1946             makemenu $m.$submenu $thing
 
1951 # translate string and remove ampersands
 
1953     return [string map {&& & & {}} [mc $str]]
 
1956 proc makedroplist {w varname args} {
 
1960         foreach label $args {
 
1961             set cx [string length $label]
 
1962             if {$cx > $width} {set width $cx}
 
1964         set gm [ttk::combobox $w -width $width -state readonly\
 
1965                     -textvariable $varname -values $args]
 
1967         set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
 
1972 proc makewindow {} {
 
1973     global canv canv2 canv3 linespc charspc ctext cflist cscroll
 
1975     global findtype findtypemenu findloc findstring fstring geometry
 
1976     global entries sha1entry sha1string sha1but
 
1977     global diffcontextstring diffcontext
 
1979     global maincursor textcursor curtextcursor
 
1980     global rowctxmenu fakerowmenu mergemax wrapcomment
 
1981     global highlight_files gdttype
 
1982     global searchstring sstring
 
1983     global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
 
1984     global headctxmenu progresscanv progressitem progresscoords statusw
 
1985     global fprogitem fprogcoord lastprogupdate progupdatepending
 
1986     global rprogitem rprogcoord rownumsel numcommits
 
1987     global have_tk85 use_ttk NS
 
1991     # The "mc" arguments here are purely so that xgettext
 
1992     # sees the following string as needing to be translated
 
1995             {mc "Update" command updatecommits -accelerator F5}
 
1996             {mc "Reload" command reloadcommits -accelerator Meta1-F5}
 
1997             {mc "Reread references" command rereadrefs}
 
1998             {mc "List references" command showrefs -accelerator F2}
 
2000             {mc "Start git gui" command {exec git gui &}}
 
2002             {mc "Quit" command doquit -accelerator Meta1-Q}
 
2006             {mc "Preferences" command doprefs}
 
2010             {mc "New view..." command {newview 0} -accelerator Shift-F4}
 
2011             {mc "Edit view..." command editview -state disabled -accelerator F4}
 
2012             {mc "Delete view" command delview -state disabled}
 
2014             {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
 
2016     if {[tk windowingsystem] ne "aqua"} {
 
2019             {mc "About gitk" command about}
 
2020             {mc "Key bindings" command keys}
 
2022         set bar [list $file $edit $view $help]
 
2024         proc ::tk::mac::ShowPreferences {} {doprefs}
 
2025         proc ::tk::mac::Quit {} {doquit}
 
2026         lset file end [lreplace [lindex $file end] end-1 end]
 
2028         xx "Apple" cascade {
 
2029             {mc "About gitk" command about}
 
2034             {mc "Key bindings" command keys}
 
2036         set bar [list $apple $file $view $help]
 
2039     . configure -menu .bar
 
2042         # cover the non-themed toplevel with a themed frame.
 
2043         place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
 
2046     # the gui has upper and lower half, parts of a paned window.
 
2047     ${NS}::panedwindow .ctop -orient vertical
 
2049     # possibly use assumed geometry
 
2050     if {![info exists geometry(pwsash0)]} {
 
2051         set geometry(topheight) [expr {15 * $linespc}]
 
2052         set geometry(topwidth) [expr {80 * $charspc}]
 
2053         set geometry(botheight) [expr {15 * $linespc}]
 
2054         set geometry(botwidth) [expr {50 * $charspc}]
 
2055         set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
 
2056         set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
 
2059     # the upper half will have a paned window, a scroll bar to the right, and some stuff below
 
2060     ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
 
2061     ${NS}::frame .tf.histframe
 
2062     ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
 
2064         .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
 
2067     # create three canvases
 
2068     set cscroll .tf.histframe.csb
 
2069     set canv .tf.histframe.pwclist.canv
 
2071         -selectbackground $selectbgcolor \
 
2072         -background $bgcolor -bd 0 \
 
2073         -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
 
2074     .tf.histframe.pwclist add $canv
 
2075     set canv2 .tf.histframe.pwclist.canv2
 
2077         -selectbackground $selectbgcolor \
 
2078         -background $bgcolor -bd 0 -yscrollincr $linespc
 
2079     .tf.histframe.pwclist add $canv2
 
2080     set canv3 .tf.histframe.pwclist.canv3
 
2082         -selectbackground $selectbgcolor \
 
2083         -background $bgcolor -bd 0 -yscrollincr $linespc
 
2084     .tf.histframe.pwclist add $canv3
 
2086         bind .tf.histframe.pwclist <Map> {
 
2088             .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
 
2089             .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
 
2092         eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
 
2093         eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
 
2096     # a scroll bar to rule them
 
2097     ${NS}::scrollbar $cscroll -command {allcanvs yview}
 
2098     if {!$use_ttk} {$cscroll configure -highlightthickness 0}
 
2099     pack $cscroll -side right -fill y
 
2100     bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
 
2101     lappend bglist $canv $canv2 $canv3
 
2102     pack .tf.histframe.pwclist -fill both -expand 1 -side left
 
2104     # we have two button bars at bottom of top frame. Bar 1
 
2105     ${NS}::frame .tf.bar
 
2106     ${NS}::frame .tf.lbar -height 15
 
2108     set sha1entry .tf.bar.sha1
 
2109     set entries $sha1entry
 
2110     set sha1but .tf.bar.sha1label
 
2111     button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
 
2112         -command gotocommit -width 8
 
2113     $sha1but conf -disabledforeground [$sha1but cget -foreground]
 
2114     pack .tf.bar.sha1label -side left
 
2115     ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
 
2116     trace add variable sha1string write sha1change
 
2117     pack $sha1entry -side left -pady 2
 
2119     image create bitmap bm-left -data {
 
2120         #define left_width 16
 
2121         #define left_height 16
 
2122         static unsigned char left_bits[] = {
 
2123         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
 
2124         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
 
2125         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
 
2127     image create bitmap bm-right -data {
 
2128         #define right_width 16
 
2129         #define right_height 16
 
2130         static unsigned char right_bits[] = {
 
2131         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
 
2132         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
 
2133         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
 
2135     ${NS}::button .tf.bar.leftbut -image bm-left -command goback \
 
2136         -state disabled -width 26
 
2137     pack .tf.bar.leftbut -side left -fill y
 
2138     ${NS}::button .tf.bar.rightbut -image bm-right -command goforw \
 
2139         -state disabled -width 26
 
2140     pack .tf.bar.rightbut -side left -fill y
 
2142     ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
 
2144     ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
 
2145         -relief sunken -anchor e
 
2146     ${NS}::label .tf.bar.rowlabel2 -text "/"
 
2147     ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
 
2148         -relief sunken -anchor e
 
2149     pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
 
2152         foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
 
2155     trace add variable selectedline write selectedline_change
 
2157     # Status label and progress bar
 
2158     set statusw .tf.bar.status
 
2159     ${NS}::label $statusw -width 15 -relief sunken
 
2160     pack $statusw -side left -padx 5
 
2162         set progresscanv [ttk::progressbar .tf.bar.progress]
 
2164         set h [expr {[font metrics uifont -linespace] + 2}]
 
2165         set progresscanv .tf.bar.progress
 
2166         canvas $progresscanv -relief sunken -height $h -borderwidth 2
 
2167         set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
 
2168         set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
 
2169         set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
 
2171     pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
 
2172     set progresscoords {0 0}
 
2175     bind $progresscanv <Configure> adjustprogress
 
2176     set lastprogupdate [clock clicks -milliseconds]
 
2177     set progupdatepending 0
 
2179     # build up the bottom bar of upper window
 
2180     ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
 
2181     ${NS}::button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
 
2182     ${NS}::button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
 
2183     ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
 
2184     pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
 
2186     set gdttype [mc "containing:"]
 
2187     set gm [makedroplist .tf.lbar.gdttype gdttype \
 
2188                 [mc "containing:"] \
 
2189                 [mc "touching paths:"] \
 
2190                 [mc "adding/removing string:"]]
 
2191     trace add variable gdttype write gdttype_change
 
2192     pack .tf.lbar.gdttype -side left -fill y
 
2195     set fstring .tf.lbar.findstring
 
2196     lappend entries $fstring
 
2197     ${NS}::entry $fstring -width 30 -textvariable findstring
 
2198     trace add variable findstring write find_change
 
2199     set findtype [mc "Exact"]
 
2200     set findtypemenu [makedroplist .tf.lbar.findtype \
 
2201                           findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
 
2202     trace add variable findtype write findcom_change
 
2203     set findloc [mc "All fields"]
 
2204     makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
 
2205         [mc "Comments"] [mc "Author"] [mc "Committer"]
 
2206     trace add variable findloc write find_change
 
2207     pack .tf.lbar.findloc -side right
 
2208     pack .tf.lbar.findtype -side right
 
2209     pack $fstring -side left -expand 1 -fill x
 
2211     # Finish putting the upper half of the viewer together
 
2212     pack .tf.lbar -in .tf -side bottom -fill x
 
2213     pack .tf.bar -in .tf -side bottom -fill x
 
2214     pack .tf.histframe -fill both -side top -expand 1
 
2217         .ctop paneconfigure .tf -height $geometry(topheight)
 
2218         .ctop paneconfigure .tf -width $geometry(topwidth)
 
2221     # now build up the bottom
 
2222     ${NS}::panedwindow .pwbottom -orient horizontal
 
2224     # lower left, a text box over search bar, scroll bar to the right
 
2225     # if we know window height, then that will set the lower text height, otherwise
 
2226     # we set lower text height which will drive window height
 
2227     if {[info exists geometry(main)]} {
 
2228         ${NS}::frame .bleft -width $geometry(botwidth)
 
2230         ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
 
2232     ${NS}::frame .bleft.top
 
2233     ${NS}::frame .bleft.mid
 
2234     ${NS}::frame .bleft.bottom
 
2236     ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
 
2237     pack .bleft.top.search -side left -padx 5
 
2238     set sstring .bleft.top.sstring
 
2240     ${NS}::entry $sstring -width 20 -textvariable searchstring
 
2241     lappend entries $sstring
 
2242     trace add variable searchstring write incrsearch
 
2243     pack $sstring -side left -expand 1 -fill x
 
2244     ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
 
2245         -command changediffdisp -variable diffelide -value {0 0}
 
2246     ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
 
2247         -command changediffdisp -variable diffelide -value {0 1}
 
2248     ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
 
2249         -command changediffdisp -variable diffelide -value {1 0}
 
2250     ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
 
2251     pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
 
2252     spinbox .bleft.mid.diffcontext -width 5 \
 
2253         -from 0 -increment 1 -to 10000000 \
 
2254         -validate all -validatecommand "diffcontextvalidate %P" \
 
2255         -textvariable diffcontextstring
 
2256     .bleft.mid.diffcontext set $diffcontext
 
2257     trace add variable diffcontextstring write diffcontextchange
 
2258     lappend entries .bleft.mid.diffcontext
 
2259     pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
 
2260     ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
 
2261         -command changeignorespace -variable ignorespace
 
2262     pack .bleft.mid.ignspace -side left -padx 5
 
2264     set worddiff [mc "Line diff"]
 
2265     if {[package vcompare $git_version "1.7.2"] >= 0} {
 
2266         makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
 
2267             [mc "Markup words"] [mc "Color words"]
 
2268         trace add variable worddiff write changeworddiff
 
2269         pack .bleft.mid.worddiff -side left -padx 5
 
2272     set ctext .bleft.bottom.ctext
 
2273     text $ctext -background $bgcolor -foreground $fgcolor \
 
2274         -state disabled -font textfont \
 
2275         -yscrollcommand scrolltext -wrap none \
 
2276         -xscrollcommand ".bleft.bottom.sbhorizontal set"
 
2278         $ctext conf -tabstyle wordprocessor
 
2280     ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
 
2281     ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
 
2282     pack .bleft.top -side top -fill x
 
2283     pack .bleft.mid -side top -fill x
 
2284     grid $ctext .bleft.bottom.sb -sticky nsew
 
2285     grid .bleft.bottom.sbhorizontal -sticky ew
 
2286     grid columnconfigure .bleft.bottom 0 -weight 1
 
2287     grid rowconfigure .bleft.bottom 0 -weight 1
 
2288     grid rowconfigure .bleft.bottom 1 -weight 0
 
2289     pack .bleft.bottom -side top -fill both -expand 1
 
2290     lappend bglist $ctext
 
2291     lappend fglist $ctext
 
2293     $ctext tag conf comment -wrap $wrapcomment
 
2294     $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
 
2295     $ctext tag conf hunksep -fore [lindex $diffcolors 2]
 
2296     $ctext tag conf d0 -fore [lindex $diffcolors 0]
 
2297     $ctext tag conf dresult -fore [lindex $diffcolors 1]
 
2298     $ctext tag conf m0 -fore red
 
2299     $ctext tag conf m1 -fore blue
 
2300     $ctext tag conf m2 -fore green
 
2301     $ctext tag conf m3 -fore purple
 
2302     $ctext tag conf m4 -fore brown
 
2303     $ctext tag conf m5 -fore "#009090"
 
2304     $ctext tag conf m6 -fore magenta
 
2305     $ctext tag conf m7 -fore "#808000"
 
2306     $ctext tag conf m8 -fore "#009000"
 
2307     $ctext tag conf m9 -fore "#ff0080"
 
2308     $ctext tag conf m10 -fore cyan
 
2309     $ctext tag conf m11 -fore "#b07070"
 
2310     $ctext tag conf m12 -fore "#70b0f0"
 
2311     $ctext tag conf m13 -fore "#70f0b0"
 
2312     $ctext tag conf m14 -fore "#f0b070"
 
2313     $ctext tag conf m15 -fore "#ff70b0"
 
2314     $ctext tag conf mmax -fore darkgrey
 
2316     $ctext tag conf mresult -font textfontbold
 
2317     $ctext tag conf msep -font textfontbold
 
2318     $ctext tag conf found -back yellow
 
2320     .pwbottom add .bleft
 
2322         .pwbottom paneconfigure .bleft -width $geometry(botwidth)
 
2326     ${NS}::frame .bright
 
2327     ${NS}::frame .bright.mode
 
2328     ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
 
2329         -command reselectline -variable cmitmode -value "patch"
 
2330     ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
 
2331         -command reselectline -variable cmitmode -value "tree"
 
2332     grid .bright.mode.patch .bright.mode.tree -sticky ew
 
2333     pack .bright.mode -side top -fill x
 
2334     set cflist .bright.cfiles
 
2335     set indent [font measure mainfont "nn"]
 
2337         -selectbackground $selectbgcolor \
 
2338         -background $bgcolor -foreground $fgcolor \
 
2340         -tabs [list $indent [expr {2 * $indent}]] \
 
2341         -yscrollcommand ".bright.sb set" \
 
2342         -cursor [. cget -cursor] \
 
2343         -spacing1 1 -spacing3 1
 
2344     lappend bglist $cflist
 
2345     lappend fglist $cflist
 
2346     ${NS}::scrollbar .bright.sb -command "$cflist yview"
 
2347     pack .bright.sb -side right -fill y
 
2348     pack $cflist -side left -fill both -expand 1
 
2349     $cflist tag configure highlight \
 
2350         -background [$cflist cget -selectbackground]
 
2351     $cflist tag configure bold -font mainfontbold
 
2353     .pwbottom add .bright
 
2356     # restore window width & height if known
 
2357     if {[info exists geometry(main)]} {
 
2358         if {[scan $geometry(main) "%dx%d" w h] >= 2} {
 
2359             if {$w > [winfo screenwidth .]} {
 
2360                 set w [winfo screenwidth .]
 
2362             if {$h > [winfo screenheight .]} {
 
2363                 set h [winfo screenheight .]
 
2365             wm geometry . "${w}x$h"
 
2369     if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
 
2370         wm state . $geometry(state)
 
2373     if {[tk windowingsystem] eq {aqua}} {
 
2384             %W sashpos 0 $::geometry(topheight)
 
2386         bind .pwbottom <Map> {
 
2388             %W sashpos 0 $::geometry(botwidth)
 
2392     bind .pwbottom <Configure> {resizecdetpanes %W %w}
 
2393     pack .ctop -fill both -expand 1
 
2394     bindall <1> {selcanvline %W %x %y}
 
2395     #bindall <B1-Motion> {selcanvline %W %x %y}
 
2396     if {[tk windowingsystem] == "win32"} {
 
2397         bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
 
2398         bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
 
2400         bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
 
2401         bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
 
2402         if {[tk windowingsystem] eq "aqua"} {
 
2403             bindall <MouseWheel> {
 
2404                 set delta [expr {- (%D)}]
 
2405                 allcanvs yview scroll $delta units
 
2407             bindall <Shift-MouseWheel> {
 
2408                 set delta [expr {- (%D)}]
 
2409                 $canv xview scroll $delta units
 
2413     bindall <$::BM> "canvscan mark %W %x %y"
 
2414     bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
 
2415     bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
 
2416     bind . <$M1B-Key-w> doquit
 
2417     bindkey <Home> selfirstline
 
2418     bindkey <End> sellastline
 
2419     bind . <Key-Up> "selnextline -1"
 
2420     bind . <Key-Down> "selnextline 1"
 
2421     bind . <Shift-Key-Up> "dofind -1 0"
 
2422     bind . <Shift-Key-Down> "dofind 1 0"
 
2423     bindkey <Key-Right> "goforw"
 
2424     bindkey <Key-Left> "goback"
 
2425     bind . <Key-Prior> "selnextpage -1"
 
2426     bind . <Key-Next> "selnextpage 1"
 
2427     bind . <$M1B-Home> "allcanvs yview moveto 0.0"
 
2428     bind . <$M1B-End> "allcanvs yview moveto 1.0"
 
2429     bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
 
2430     bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
 
2431     bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
 
2432     bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
 
2433     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
 
2434     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
 
2435     bindkey <Key-space> "$ctext yview scroll 1 pages"
 
2436     bindkey p "selnextline -1"
 
2437     bindkey n "selnextline 1"
 
2440     bindkey i "selnextline -1"
 
2441     bindkey k "selnextline 1"
 
2445     bindkey d "$ctext yview scroll 18 units"
 
2446     bindkey u "$ctext yview scroll -18 units"
 
2447     bindkey / {focus $fstring}
 
2448     bindkey <Key-KP_Divide> {focus $fstring}
 
2449     bindkey <Key-Return> {dofind 1 1}
 
2450     bindkey ? {dofind -1 1}
 
2452     bind . <F5> updatecommits
 
2453     bind . <$M1B-F5> reloadcommits
 
2454     bind . <F2> showrefs
 
2455     bind . <Shift-F4> {newview 0}
 
2456     catch { bind . <Shift-Key-XF86_Switch_VT_4> {newview 0} }
 
2457     bind . <F4> edit_or_newview
 
2458     bind . <$M1B-q> doquit
 
2459     bind . <$M1B-f> {dofind 1 1}
 
2460     bind . <$M1B-g> {dofind 1 0}
 
2461     bind . <$M1B-r> dosearchback
 
2462     bind . <$M1B-s> dosearch
 
2463     bind . <$M1B-equal> {incrfont 1}
 
2464     bind . <$M1B-plus> {incrfont 1}
 
2465     bind . <$M1B-KP_Add> {incrfont 1}
 
2466     bind . <$M1B-minus> {incrfont -1}
 
2467     bind . <$M1B-KP_Subtract> {incrfont -1}
 
2468     wm protocol . WM_DELETE_WINDOW doquit
 
2469     bind . <Destroy> {stop_backends}
 
2470     bind . <Button-1> "click %W"
 
2471     bind $fstring <Key-Return> {dofind 1 1}
 
2472     bind $sha1entry <Key-Return> {gotocommit; break}
 
2473     bind $sha1entry <<PasteSelection>> clearsha1
 
2474     bind $cflist <1> {sel_flist %W %x %y; break}
 
2475     bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
 
2476     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
 
2478     bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
 
2479     bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
 
2480     bind $ctext <Button-1> {focus %W}
 
2482     set maincursor [. cget -cursor]
 
2483     set textcursor [$ctext cget -cursor]
 
2484     set curtextcursor $textcursor
 
2486     set rowctxmenu .rowctxmenu
 
2487     makemenu $rowctxmenu {
 
2488         {mc "Diff this -> selected" command {diffvssel 0}}
 
2489         {mc "Diff selected -> this" command {diffvssel 1}}
 
2490         {mc "Make patch" command mkpatch}
 
2491         {mc "Create tag" command mktag}
 
2492         {mc "Write commit to file" command writecommit}
 
2493         {mc "Create new branch" command mkbranch}
 
2494         {mc "Cherry-pick this commit" command cherrypick}
 
2495         {mc "Reset HEAD branch to here" command resethead}
 
2496         {mc "Mark this commit" command markhere}
 
2497         {mc "Return to mark" command gotomark}
 
2498         {mc "Find descendant of this and mark" command find_common_desc}
 
2499         {mc "Compare with marked commit" command compare_commits}
 
2501     $rowctxmenu configure -tearoff 0
 
2503     set fakerowmenu .fakerowmenu
 
2504     makemenu $fakerowmenu {
 
2505         {mc "Diff this -> selected" command {diffvssel 0}}
 
2506         {mc "Diff selected -> this" command {diffvssel 1}}
 
2507         {mc "Make patch" command mkpatch}
 
2509     $fakerowmenu configure -tearoff 0
 
2511     set headctxmenu .headctxmenu
 
2512     makemenu $headctxmenu {
 
2513         {mc "Check out this branch" command cobranch}
 
2514         {mc "Remove this branch" command rmbranch}
 
2516     $headctxmenu configure -tearoff 0
 
2519     set flist_menu .flistctxmenu
 
2520     makemenu $flist_menu {
 
2521         {mc "Highlight this too" command {flist_hl 0}}
 
2522         {mc "Highlight this only" command {flist_hl 1}}
 
2523         {mc "External diff" command {external_diff}}
 
2524         {mc "Blame parent commit" command {external_blame 1}}
 
2526     $flist_menu configure -tearoff 0
 
2529     set diff_menu .diffctxmenu
 
2530     makemenu $diff_menu {
 
2531         {mc "Show origin of this line" command show_line_source}
 
2532         {mc "Run git gui blame on this line" command {external_blame_diff}}
 
2534     $diff_menu configure -tearoff 0
 
2537 # Windows sends all mouse wheel events to the current focused window, not
 
2538 # the one where the mouse hovers, so bind those events here and redirect
 
2539 # to the correct window
 
2540 proc windows_mousewheel_redirector {W X Y D} {
 
2541     global canv canv2 canv3
 
2542     set w [winfo containing -displayof $W $X $Y]
 
2544         set u [expr {$D < 0 ? 5 : -5}]
 
2545         if {$w == $canv || $w == $canv2 || $w == $canv3} {
 
2546             allcanvs yview scroll $u units
 
2549                 $w yview scroll $u units
 
2555 # Update row number label when selectedline changes
 
2556 proc selectedline_change {n1 n2 op} {
 
2557     global selectedline rownumsel
 
2559     if {$selectedline eq {}} {
 
2562         set rownumsel [expr {$selectedline + 1}]
 
2566 # mouse-2 makes all windows scan vertically, but only the one
 
2567 # the cursor is in scans horizontally
 
2568 proc canvscan {op w x y} {
 
2569     global canv canv2 canv3
 
2570     foreach c [list $canv $canv2 $canv3] {
 
2579 proc scrollcanv {cscroll f0 f1} {
 
2580     $cscroll set $f0 $f1
 
2585 # when we make a key binding for the toplevel, make sure
 
2586 # it doesn't get triggered when that key is pressed in the
 
2587 # find string entry widget.
 
2588 proc bindkey {ev script} {
 
2591     set escript [bind Entry $ev]
 
2592     if {$escript == {}} {
 
2593         set escript [bind Entry <Key>]
 
2595     foreach e $entries {
 
2596         bind $e $ev "$escript; break"
 
2600 # set the focus back to the toplevel for any click outside
 
2603     global ctext entries
 
2604     foreach e [concat $entries $ctext] {
 
2605         if {$w == $e} return
 
2610 # Adjust the progress bar for a change in requested extent or canvas size
 
2611 proc adjustprogress {} {
 
2612     global progresscanv progressitem progresscoords
 
2613     global fprogitem fprogcoord lastprogupdate progupdatepending
 
2614     global rprogitem rprogcoord use_ttk
 
2617         $progresscanv configure -value [expr {int($fprogcoord * 100)}]
 
2621     set w [expr {[winfo width $progresscanv] - 4}]
 
2622     set x0 [expr {$w * [lindex $progresscoords 0]}]
 
2623     set x1 [expr {$w * [lindex $progresscoords 1]}]
 
2624     set h [winfo height $progresscanv]
 
2625     $progresscanv coords $progressitem $x0 0 $x1 $h
 
2626     $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
 
2627     $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
 
2628     set now [clock clicks -milliseconds]
 
2629     if {$now >= $lastprogupdate + 100} {
 
2630         set progupdatepending 0
 
2632     } elseif {!$progupdatepending} {
 
2633         set progupdatepending 1
 
2634         after [expr {$lastprogupdate + 100 - $now}] doprogupdate
 
2638 proc doprogupdate {} {
 
2639     global lastprogupdate progupdatepending
 
2641     if {$progupdatepending} {
 
2642         set progupdatepending 0
 
2643         set lastprogupdate [clock clicks -milliseconds]
 
2648 proc savestuff {w} {
 
2649     global canv canv2 canv3 mainfont textfont uifont tabstop
 
2650     global stuffsaved findmergefiles maxgraphpct
 
2651     global maxwidth showneartags showlocalchanges
 
2652     global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
 
2653     global cmitmode wrapcomment datetimeformat limitdiffs
 
2654     global colors uicolor bgcolor fgcolor diffcolors diffcontext selectbgcolor
 
2655     global autoselect autosellen extdifftool perfile_attrs markbgcolor use_ttk
 
2656     global hideremotes want_ttk
 
2658     if {$stuffsaved} return
 
2659     if {![winfo viewable .]} return
 
2661         if {[file exists ~/.gitk-new]} {file delete -force ~/.gitk-new}
 
2662         set f [open "~/.gitk-new" w]
 
2663         if {$::tcl_platform(platform) eq {windows}} {
 
2664             file attributes "~/.gitk-new" -hidden true
 
2666         puts $f [list set mainfont $mainfont]
 
2667         puts $f [list set textfont $textfont]
 
2668         puts $f [list set uifont $uifont]
 
2669         puts $f [list set tabstop $tabstop]
 
2670         puts $f [list set findmergefiles $findmergefiles]
 
2671         puts $f [list set maxgraphpct $maxgraphpct]
 
2672         puts $f [list set maxwidth $maxwidth]
 
2673         puts $f [list set cmitmode $cmitmode]
 
2674         puts $f [list set wrapcomment $wrapcomment]
 
2675         puts $f [list set autoselect $autoselect]
 
2676         puts $f [list set autosellen $autosellen]
 
2677         puts $f [list set showneartags $showneartags]
 
2678         puts $f [list set hideremotes $hideremotes]
 
2679         puts $f [list set showlocalchanges $showlocalchanges]
 
2680         puts $f [list set datetimeformat $datetimeformat]
 
2681         puts $f [list set limitdiffs $limitdiffs]
 
2682         puts $f [list set uicolor $uicolor]
 
2683         puts $f [list set want_ttk $want_ttk]
 
2684         puts $f [list set bgcolor $bgcolor]
 
2685         puts $f [list set fgcolor $fgcolor]
 
2686         puts $f [list set colors $colors]
 
2687         puts $f [list set diffcolors $diffcolors]
 
2688         puts $f [list set markbgcolor $markbgcolor]
 
2689         puts $f [list set diffcontext $diffcontext]
 
2690         puts $f [list set selectbgcolor $selectbgcolor]
 
2691         puts $f [list set extdifftool $extdifftool]
 
2692         puts $f [list set perfile_attrs $perfile_attrs]
 
2694         puts $f "set geometry(main) [wm geometry .]"
 
2695         puts $f "set geometry(state) [wm state .]"
 
2696         puts $f "set geometry(topwidth) [winfo width .tf]"
 
2697         puts $f "set geometry(topheight) [winfo height .tf]"
 
2699             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
 
2700             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
 
2702             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
 
2703             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
 
2705         puts $f "set geometry(botwidth) [winfo width .bleft]"
 
2706         puts $f "set geometry(botheight) [winfo height .bleft]"
 
2708         puts -nonewline $f "set permviews {"
 
2709         for {set v 0} {$v < $nextviewnum} {incr v} {
 
2710             if {$viewperm($v)} {
 
2711                 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
 
2716         file rename -force "~/.gitk-new" "~/.gitk"
 
2721 proc resizeclistpanes {win w} {
 
2722     global oldwidth use_ttk
 
2723     if {[info exists oldwidth($win)]} {
 
2725             set s0 [$win sashpos 0]
 
2726             set s1 [$win sashpos 1]
 
2728             set s0 [$win sash coord 0]
 
2729             set s1 [$win sash coord 1]
 
2732             set sash0 [expr {int($w/2 - 2)}]
 
2733             set sash1 [expr {int($w*5/6 - 2)}]
 
2735             set factor [expr {1.0 * $w / $oldwidth($win)}]
 
2736             set sash0 [expr {int($factor * [lindex $s0 0])}]
 
2737             set sash1 [expr {int($factor * [lindex $s1 0])}]
 
2741             if {$sash1 < $sash0 + 20} {
 
2742                 set sash1 [expr {$sash0 + 20}]
 
2744             if {$sash1 > $w - 10} {
 
2745                 set sash1 [expr {$w - 10}]
 
2746                 if {$sash0 > $sash1 - 20} {
 
2747                     set sash0 [expr {$sash1 - 20}]
 
2752             $win sashpos 0 $sash0
 
2753             $win sashpos 1 $sash1
 
2755             $win sash place 0 $sash0 [lindex $s0 1]
 
2756             $win sash place 1 $sash1 [lindex $s1 1]
 
2759     set oldwidth($win) $w
 
2762 proc resizecdetpanes {win w} {
 
2763     global oldwidth use_ttk
 
2764     if {[info exists oldwidth($win)]} {
 
2766             set s0 [$win sashpos 0]
 
2768             set s0 [$win sash coord 0]
 
2771             set sash0 [expr {int($w*3/4 - 2)}]
 
2773             set factor [expr {1.0 * $w / $oldwidth($win)}]
 
2774             set sash0 [expr {int($factor * [lindex $s0 0])}]
 
2778             if {$sash0 > $w - 15} {
 
2779                 set sash0 [expr {$w - 15}]
 
2783             $win sashpos 0 $sash0
 
2785             $win sash place 0 $sash0 [lindex $s0 1]
 
2788     set oldwidth($win) $w
 
2791 proc allcanvs args {
 
2792     global canv canv2 canv3
 
2798 proc bindall {event action} {
 
2799     global canv canv2 canv3
 
2800     bind $canv $event $action
 
2801     bind $canv2 $event $action
 
2802     bind $canv3 $event $action
 
2808     if {[winfo exists $w]} {
 
2813     wm title $w [mc "About gitk"]
 
2815     message $w.m -text [mc "
 
2816 Gitk - a commit viewer for git
 
2818 Copyright \u00a9 2005-2010 Paul Mackerras
 
2820 Use and redistribute under the terms of the GNU General Public License"] \
 
2821             -justify center -aspect 400 -border 2 -bg white -relief groove
 
2822     pack $w.m -side top -fill x -padx 2 -pady 2
 
2823     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
 
2824     pack $w.ok -side bottom
 
2825     bind $w <Visibility> "focus $w.ok"
 
2826     bind $w <Key-Escape> "destroy $w"
 
2827     bind $w <Key-Return> "destroy $w"
 
2828     tk::PlaceWindow $w widget .
 
2834     if {[winfo exists $w]} {
 
2838     if {[tk windowingsystem] eq {aqua}} {
 
2844     wm title $w [mc "Gitk key bindings"]
 
2846     message $w.m -text "
 
2847 [mc "Gitk key bindings:"]
 
2849 [mc "<%s-Q>             Quit" $M1T]
 
2850 [mc "<%s-W>             Close window" $M1T]
 
2851 [mc "<Home>             Move to first commit"]
 
2852 [mc "<End>              Move to last commit"]
 
2853 [mc "<Up>, p, i Move up one commit"]
 
2854 [mc "<Down>, n, k       Move down one commit"]
 
2855 [mc "<Left>, z, j       Go back in history list"]
 
2856 [mc "<Right>, x, l      Go forward in history list"]
 
2857 [mc "<PageUp>   Move up one page in commit list"]
 
2858 [mc "<PageDown> Move down one page in commit list"]
 
2859 [mc "<%s-Home>  Scroll to top of commit list" $M1T]
 
2860 [mc "<%s-End>   Scroll to bottom of commit list" $M1T]
 
2861 [mc "<%s-Up>    Scroll commit list up one line" $M1T]
 
2862 [mc "<%s-Down>  Scroll commit list down one line" $M1T]
 
2863 [mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
 
2864 [mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
 
2865 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
 
2866 [mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
 
2867 [mc "<Delete>, b        Scroll diff view up one page"]
 
2868 [mc "<Backspace>        Scroll diff view up one page"]
 
2869 [mc "<Space>            Scroll diff view down one page"]
 
2870 [mc "u          Scroll diff view up 18 lines"]
 
2871 [mc "d          Scroll diff view down 18 lines"]
 
2872 [mc "<%s-F>             Find" $M1T]
 
2873 [mc "<%s-G>             Move to next find hit" $M1T]
 
2874 [mc "<Return>   Move to next find hit"]
 
2875 [mc "/          Focus the search box"]
 
2876 [mc "?          Move to previous find hit"]
 
2877 [mc "f          Scroll diff view to next file"]
 
2878 [mc "<%s-S>             Search for next hit in diff view" $M1T]
 
2879 [mc "<%s-R>             Search for previous hit in diff view" $M1T]
 
2880 [mc "<%s-KP+>   Increase font size" $M1T]
 
2881 [mc "<%s-plus>  Increase font size" $M1T]
 
2882 [mc "<%s-KP->   Decrease font size" $M1T]
 
2883 [mc "<%s-minus> Decrease font size" $M1T]
 
2886             -justify left -bg white -border 2 -relief groove
 
2887     pack $w.m -side top -fill both -padx 2 -pady 2
 
2888     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
 
2889     bind $w <Key-Escape> [list destroy $w]
 
2890     pack $w.ok -side bottom
 
2891     bind $w <Visibility> "focus $w.ok"
 
2892     bind $w <Key-Escape> "destroy $w"
 
2893     bind $w <Key-Return> "destroy $w"
 
2896 # Procedures for manipulating the file list window at the
 
2897 # bottom right of the overall window.
 
2899 proc treeview {w l openlevs} {
 
2900     global treecontents treediropen treeheight treeparent treeindex
 
2910     set treecontents() {}
 
2911     $w conf -state normal
 
2913         while {[string range $f 0 $prefixend] ne $prefix} {
 
2914             if {$lev <= $openlevs} {
 
2915                 $w mark set e:$treeindex($prefix) "end -1c"
 
2916                 $w mark gravity e:$treeindex($prefix) left
 
2918             set treeheight($prefix) $ht
 
2919             incr ht [lindex $htstack end]
 
2920             set htstack [lreplace $htstack end end]
 
2921             set prefixend [lindex $prefendstack end]
 
2922             set prefendstack [lreplace $prefendstack end end]
 
2923             set prefix [string range $prefix 0 $prefixend]
 
2926         set tail [string range $f [expr {$prefixend+1}] end]
 
2927         while {[set slash [string first "/" $tail]] >= 0} {
 
2930             lappend prefendstack $prefixend
 
2931             incr prefixend [expr {$slash + 1}]
 
2932             set d [string range $tail 0 $slash]
 
2933             lappend treecontents($prefix) $d
 
2934             set oldprefix $prefix
 
2936             set treecontents($prefix) {}
 
2937             set treeindex($prefix) [incr ix]
 
2938             set treeparent($prefix) $oldprefix
 
2939             set tail [string range $tail [expr {$slash+1}] end]
 
2940             if {$lev <= $openlevs} {
 
2942                 set treediropen($prefix) [expr {$lev < $openlevs}]
 
2943                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
 
2944                 $w mark set d:$ix "end -1c"
 
2945                 $w mark gravity d:$ix left
 
2947                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
 
2949                 $w image create end -align center -image $bm -padx 1 \
 
2951                 $w insert end $d [highlight_tag $prefix]
 
2952                 $w mark set s:$ix "end -1c"
 
2953                 $w mark gravity s:$ix left
 
2958             if {$lev <= $openlevs} {
 
2961                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
 
2963                 $w insert end $tail [highlight_tag $f]
 
2965             lappend treecontents($prefix) $tail
 
2968     while {$htstack ne {}} {
 
2969         set treeheight($prefix) $ht
 
2970         incr ht [lindex $htstack end]
 
2971         set htstack [lreplace $htstack end end]
 
2972         set prefixend [lindex $prefendstack end]
 
2973         set prefendstack [lreplace $prefendstack end end]
 
2974         set prefix [string range $prefix 0 $prefixend]
 
2976     $w conf -state disabled
 
2979 proc linetoelt {l} {
 
2980     global treeheight treecontents
 
2985         foreach e $treecontents($prefix) {
 
2990             if {[string index $e end] eq "/"} {
 
2991                 set n $treeheight($prefix$e)
 
3003 proc highlight_tree {y prefix} {
 
3004     global treeheight treecontents cflist
 
3006     foreach e $treecontents($prefix) {
 
3008         if {[highlight_tag $path] ne {}} {
 
3009             $cflist tag add bold $y.0 "$y.0 lineend"
 
3012         if {[string index $e end] eq "/" && $treeheight($path) > 1} {
 
3013             set y [highlight_tree $y $path]
 
3019 proc treeclosedir {w dir} {
 
3020     global treediropen treeheight treeparent treeindex
 
3022     set ix $treeindex($dir)
 
3023     $w conf -state normal
 
3024     $w delete s:$ix e:$ix
 
3025     set treediropen($dir) 0
 
3026     $w image configure a:$ix -image tri-rt
 
3027     $w conf -state disabled
 
3028     set n [expr {1 - $treeheight($dir)}]
 
3029     while {$dir ne {}} {
 
3030         incr treeheight($dir) $n
 
3031         set dir $treeparent($dir)
 
3035 proc treeopendir {w dir} {
 
3036     global treediropen treeheight treeparent treecontents treeindex
 
3038     set ix $treeindex($dir)
 
3039     $w conf -state normal
 
3040     $w image configure a:$ix -image tri-dn
 
3041     $w mark set e:$ix s:$ix
 
3042     $w mark gravity e:$ix right
 
3045     set n [llength $treecontents($dir)]
 
3046     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
 
3049         incr treeheight($x) $n
 
3051     foreach e $treecontents($dir) {
 
3053         if {[string index $e end] eq "/"} {
 
3054             set iy $treeindex($de)
 
3055             $w mark set d:$iy e:$ix
 
3056             $w mark gravity d:$iy left
 
3057             $w insert e:$ix $str
 
3058             set treediropen($de) 0
 
3059             $w image create e:$ix -align center -image tri-rt -padx 1 \
 
3061             $w insert e:$ix $e [highlight_tag $de]
 
3062             $w mark set s:$iy e:$ix
 
3063             $w mark gravity s:$iy left
 
3064             set treeheight($de) 1
 
3066             $w insert e:$ix $str
 
3067             $w insert e:$ix $e [highlight_tag $de]
 
3070     $w mark gravity e:$ix right
 
3071     $w conf -state disabled
 
3072     set treediropen($dir) 1
 
3073     set top [lindex [split [$w index @0,0] .] 0]
 
3074     set ht [$w cget -height]
 
3075     set l [lindex [split [$w index s:$ix] .] 0]
 
3078     } elseif {$l + $n + 1 > $top + $ht} {
 
3079         set top [expr {$l + $n + 2 - $ht}]
 
3087 proc treeclick {w x y} {
 
3088     global treediropen cmitmode ctext cflist cflist_top
 
3090     if {$cmitmode ne "tree"} return
 
3091     if {![info exists cflist_top]} return
 
3092     set l [lindex [split [$w index "@$x,$y"] "."] 0]
 
3093     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
 
3094     $cflist tag add highlight $l.0 "$l.0 lineend"
 
3100     set e [linetoelt $l]
 
3101     if {[string index $e end] ne "/"} {
 
3103     } elseif {$treediropen($e)} {
 
3110 proc setfilelist {id} {
 
3111     global treefilelist cflist jump_to_here
 
3113     treeview $cflist $treefilelist($id) 0
 
3114     if {$jump_to_here ne {}} {
 
3115         set f [lindex $jump_to_here 0]
 
3116         if {[lsearch -exact $treefilelist($id) $f] >= 0} {
 
3122 image create bitmap tri-rt -background black -foreground blue -data {
 
3123     #define tri-rt_width 13
 
3124     #define tri-rt_height 13
 
3125     static unsigned char tri-rt_bits[] = {
 
3126        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
 
3127        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
 
3130     #define tri-rt-mask_width 13
 
3131     #define tri-rt-mask_height 13
 
3132     static unsigned char tri-rt-mask_bits[] = {
 
3133        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
 
3134        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
 
3137 image create bitmap tri-dn -background black -foreground blue -data {
 
3138     #define tri-dn_width 13
 
3139     #define tri-dn_height 13
 
3140     static unsigned char tri-dn_bits[] = {
 
3141        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
 
3142        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
 
3145     #define tri-dn-mask_width 13
 
3146     #define tri-dn-mask_height 13
 
3147     static unsigned char tri-dn-mask_bits[] = {
 
3148        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
 
3149        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
 
3153 image create bitmap reficon-T -background black -foreground yellow -data {
 
3154     #define tagicon_width 13
 
3155     #define tagicon_height 9
 
3156     static unsigned char tagicon_bits[] = {
 
3157        0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
 
3158        0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
 
3160     #define tagicon-mask_width 13
 
3161     #define tagicon-mask_height 9
 
3162     static unsigned char tagicon-mask_bits[] = {
 
3163        0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
 
3164        0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
 
3167     #define headicon_width 13
 
3168     #define headicon_height 9
 
3169     static unsigned char headicon_bits[] = {
 
3170        0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
 
3171        0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
 
3174     #define headicon-mask_width 13
 
3175     #define headicon-mask_height 9
 
3176     static unsigned char headicon-mask_bits[] = {
 
3177        0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
 
3178        0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
 
3180 image create bitmap reficon-H -background black -foreground green \
 
3181     -data $rectdata -maskdata $rectmask
 
3182 image create bitmap reficon-o -background black -foreground "#ddddff" \
 
3183     -data $rectdata -maskdata $rectmask
 
3185 proc init_flist {first} {
 
3186     global cflist cflist_top difffilestart
 
3188     $cflist conf -state normal
 
3189     $cflist delete 0.0 end
 
3191         $cflist insert end $first
 
3193         $cflist tag add highlight 1.0 "1.0 lineend"
 
3195         catch {unset cflist_top}
 
3197     $cflist conf -state disabled
 
3198     set difffilestart {}
 
3201 proc highlight_tag {f} {
 
3202     global highlight_paths
 
3204     foreach p $highlight_paths {
 
3205         if {[string match $p $f]} {
 
3212 proc highlight_filelist {} {
 
3213     global cmitmode cflist
 
3215     $cflist conf -state normal
 
3216     if {$cmitmode ne "tree"} {
 
3217         set end [lindex [split [$cflist index end] .] 0]
 
3218         for {set l 2} {$l < $end} {incr l} {
 
3219             set line [$cflist get $l.0 "$l.0 lineend"]
 
3220             if {[highlight_tag $line] ne {}} {
 
3221                 $cflist tag add bold $l.0 "$l.0 lineend"
 
3227     $cflist conf -state disabled
 
3230 proc unhighlight_filelist {} {
 
3233     $cflist conf -state normal
 
3234     $cflist tag remove bold 1.0 end
 
3235     $cflist conf -state disabled
 
3238 proc add_flist {fl} {
 
3241     $cflist conf -state normal
 
3243         $cflist insert end "\n"
 
3244         $cflist insert end $f [highlight_tag $f]
 
3246     $cflist conf -state disabled
 
3249 proc sel_flist {w x y} {
 
3250     global ctext difffilestart cflist cflist_top cmitmode
 
3252     if {$cmitmode eq "tree"} return
 
3253     if {![info exists cflist_top]} return
 
3254     set l [lindex [split [$w index "@$x,$y"] "."] 0]
 
3255     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
 
3256     $cflist tag add highlight $l.0 "$l.0 lineend"
 
3261         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
 
3265 proc pop_flist_menu {w X Y x y} {
 
3266     global ctext cflist cmitmode flist_menu flist_menu_file
 
3267     global treediffs diffids
 
3270     set l [lindex [split [$w index "@$x,$y"] "."] 0]
 
3272     if {$cmitmode eq "tree"} {
 
3273         set e [linetoelt $l]
 
3274         if {[string index $e end] eq "/"} return
 
3276         set e [lindex $treediffs($diffids) [expr {$l-2}]]
 
3278     set flist_menu_file $e
 
3279     set xdiffstate "normal"
 
3280     if {$cmitmode eq "tree"} {
 
3281         set xdiffstate "disabled"
 
3283     # Disable "External diff" item in tree mode
 
3284     $flist_menu entryconf 2 -state $xdiffstate
 
3285     tk_popup $flist_menu $X $Y
 
3288 proc find_ctext_fileinfo {line} {
 
3289     global ctext_file_names ctext_file_lines
 
3291     set ok [bsearch $ctext_file_lines $line]
 
3292     set tline [lindex $ctext_file_lines $ok]
 
3294     if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
 
3297         return [list [lindex $ctext_file_names $ok] $tline]
 
3301 proc pop_diff_menu {w X Y x y} {
 
3302     global ctext diff_menu flist_menu_file
 
3303     global diff_menu_txtpos diff_menu_line
 
3304     global diff_menu_filebase
 
3306     set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
 
3307     set diff_menu_line [lindex $diff_menu_txtpos 0]
 
3308     # don't pop up the menu on hunk-separator or file-separator lines
 
3309     if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
 
3313     set f [find_ctext_fileinfo $diff_menu_line]
 
3314     if {$f eq {}} return
 
3315     set flist_menu_file [lindex $f 0]
 
3316     set diff_menu_filebase [lindex $f 1]
 
3317     tk_popup $diff_menu $X $Y
 
3320 proc flist_hl {only} {
 
3321     global flist_menu_file findstring gdttype
 
3323     set x [shellquote $flist_menu_file]
 
3324     if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
 
3327         append findstring " " $x
 
3329     set gdttype [mc "touching paths:"]
 
3332 proc gitknewtmpdir {} {
 
3333     global diffnum gitktmpdir gitdir
 
3335     if {![info exists gitktmpdir]} {
 
3336         set gitktmpdir [file join [file dirname $gitdir] \
 
3337                             [format ".gitk-tmp.%s" [pid]]]
 
3338         if {[catch {file mkdir $gitktmpdir} err]} {
 
3339             error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
 
3346     set diffdir [file join $gitktmpdir $diffnum]
 
3347     if {[catch {file mkdir $diffdir} err]} {
 
3348         error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
 
3354 proc save_file_from_commit {filename output what} {
 
3357     if {[catch {exec git show $filename -- > $output} err]} {
 
3358         if {[string match "fatal: bad revision *" $err]} {
 
3361         error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
 
3367 proc external_diff_get_one_file {diffid filename diffdir} {
 
3368     global nullid nullid2 nullfile
 
3371     if {$diffid == $nullid} {
 
3372         set difffile [file join [file dirname $gitdir] $filename]
 
3373         if {[file exists $difffile]} {
 
3378     if {$diffid == $nullid2} {
 
3379         set difffile [file join $diffdir "\[index\] [file tail $filename]"]
 
3380         return [save_file_from_commit :$filename $difffile index]
 
3382     set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
 
3383     return [save_file_from_commit $diffid:$filename $difffile \
 
3387 proc external_diff {} {
 
3388     global nullid nullid2
 
3389     global flist_menu_file
 
3393     if {[llength $diffids] == 1} {
 
3394         # no reference commit given
 
3395         set diffidto [lindex $diffids 0]
 
3396         if {$diffidto eq $nullid} {
 
3397             # diffing working copy with index
 
3398             set diffidfrom $nullid2
 
3399         } elseif {$diffidto eq $nullid2} {
 
3400             # diffing index with HEAD
 
3401             set diffidfrom "HEAD"
 
3403             # use first parent commit
 
3404             global parentlist selectedline
 
3405             set diffidfrom [lindex $parentlist $selectedline 0]
 
3408         set diffidfrom [lindex $diffids 0]
 
3409         set diffidto [lindex $diffids 1]
 
3412     # make sure that several diffs wont collide
 
3413     set diffdir [gitknewtmpdir]
 
3414     if {$diffdir eq {}} return
 
3416     # gather files to diff
 
3417     set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
 
3418     set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
 
3420     if {$difffromfile ne {} && $difftofile ne {}} {
 
3421         set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
 
3422         if {[catch {set fl [open |$cmd r]} err]} {
 
3423             file delete -force $diffdir
 
3424             error_popup "$extdifftool: [mc "command failed:"] $err"
 
3426             fconfigure $fl -blocking 0
 
3427             filerun $fl [list delete_at_eof $fl $diffdir]
 
3432 proc find_hunk_blamespec {base line} {
 
3435     # Find and parse the hunk header
 
3436     set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
 
3437     if {$s_lix eq {}} return
 
3439     set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
 
3440     if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
 
3441             s_line old_specs osz osz1 new_line nsz]} {
 
3445     # base lines for the parents
 
3446     set base_lines [list $new_line]
 
3447     foreach old_spec [lrange [split $old_specs " "] 1 end] {
 
3448         if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
 
3449                 old_spec old_line osz]} {
 
3452         lappend base_lines $old_line
 
3455     # Now scan the lines to determine offset within the hunk
 
3456     set max_parent [expr {[llength $base_lines]-2}]
 
3458     set s_lno [lindex [split $s_lix "."] 0]
 
3460     # Determine if the line is removed
 
3461     set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
 
3462     if {[string match {[-+ ]*} $chunk]} {
 
3463         set removed_idx [string first "-" $chunk]
 
3464         # Choose a parent index
 
3465         if {$removed_idx >= 0} {
 
3466             set parent $removed_idx
 
3468             set unchanged_idx [string first " " $chunk]
 
3469             if {$unchanged_idx >= 0} {
 
3470                 set parent $unchanged_idx
 
3472                 # blame the current commit
 
3476         # then count other lines that belong to it
 
3477         for {set i $line} {[incr i -1] > $s_lno} {} {
 
3478             set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
 
3479             # Determine if the line is removed
 
3480             set removed_idx [string first "-" $chunk]
 
3482                 set code [string index $chunk $parent]
 
3483                 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
 
3487                 if {$removed_idx < 0} {
 
3497     incr dline [lindex $base_lines $parent]
 
3498     return [list $parent $dline]
 
3501 proc external_blame_diff {} {
 
3502     global currentid cmitmode
 
3503     global diff_menu_txtpos diff_menu_line
 
3504     global diff_menu_filebase flist_menu_file
 
3506     if {$cmitmode eq "tree"} {
 
3508         set line [expr {$diff_menu_line - $diff_menu_filebase}]
 
3510         set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
 
3512             set parent_idx [lindex $hinfo 0]
 
3513             set line [lindex $hinfo 1]
 
3520     external_blame $parent_idx $line
 
3523 # Find the SHA1 ID of the blob for file $fname in the index
 
3525 proc index_sha1 {fname} {
 
3526     set f [open [list | git ls-files -s $fname] r]
 
3527     while {[gets $f line] >= 0} {
 
3528         set info [lindex [split $line "\t"] 0]
 
3529         set stage [lindex $info 2]
 
3530         if {$stage eq "0" || $stage eq "2"} {
 
3532             return [lindex $info 1]
 
3539 # Turn an absolute path into one relative to the current directory
 
3540 proc make_relative {f} {
 
3541     if {[file pathtype $f] eq "relative"} {
 
3544     set elts [file split $f]
 
3545     set here [file split [pwd]]
 
3550         if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
 
3557     set elts [concat $res [lrange $elts $ei end]]
 
3558     return [eval file join $elts]
 
3561 proc external_blame {parent_idx {line {}}} {
 
3562     global flist_menu_file gitdir
 
3563     global nullid nullid2
 
3564     global parentlist selectedline currentid
 
3566     if {$parent_idx > 0} {
 
3567         set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
 
3569         set base_commit $currentid
 
3572     if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
 
3573         error_popup [mc "No such commit"]
 
3577     set cmdline [list git gui blame]
 
3578     if {$line ne {} && $line > 1} {
 
3579         lappend cmdline "--line=$line"
 
3581     set f [file join [file dirname $gitdir] $flist_menu_file]
 
3582     # Unfortunately it seems git gui blame doesn't like
 
3583     # being given an absolute path...
 
3584     set f [make_relative $f]
 
3585     lappend cmdline $base_commit $f
 
3586     if {[catch {eval exec $cmdline &} err]} {
 
3587         error_popup "[mc "git gui blame: command failed:"] $err"
 
3591 proc show_line_source {} {
 
3592     global cmitmode currentid parents curview blamestuff blameinst
 
3593     global diff_menu_line diff_menu_filebase flist_menu_file
 
3594     global nullid nullid2 gitdir
 
3597     if {$cmitmode eq "tree"} {
 
3599         set line [expr {$diff_menu_line - $diff_menu_filebase}]
 
3601         set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
 
3602         if {$h eq {}} return
 
3603         set pi [lindex $h 0]
 
3605             mark_ctext_line $diff_menu_line
 
3609         if {$currentid eq $nullid} {
 
3611                 # must be a merge in progress...
 
3613                     # get the last line from .git/MERGE_HEAD
 
3614                     set f [open [file join $gitdir MERGE_HEAD] r]
 
3615                     set id [lindex [split [read $f] "\n"] end-1]
 
3618                     error_popup [mc "Couldn't read merge head: %s" $err]
 
3621             } elseif {$parents($curview,$currentid) eq $nullid2} {
 
3622                 # need to do the blame from the index
 
3624                     set from_index [index_sha1 $flist_menu_file]
 
3626                     error_popup [mc "Error reading index: %s" $err]
 
3630                 set id $parents($curview,$currentid)
 
3633             set id [lindex $parents($curview,$currentid) $pi]
 
3635         set line [lindex $h 1]
 
3638     if {$from_index ne {}} {
 
3639         lappend blameargs | git cat-file blob $from_index
 
3641     lappend blameargs | git blame -p -L$line,+1
 
3642     if {$from_index ne {}} {
 
3643         lappend blameargs --contents -
 
3645         lappend blameargs $id
 
3647     lappend blameargs -- [file join [file dirname $gitdir] $flist_menu_file]
 
3649         set f [open $blameargs r]
 
3651         error_popup [mc "Couldn't start git blame: %s" $err]
 
3654     nowbusy blaming [mc "Searching"]
 
3655     fconfigure $f -blocking 0
 
3656     set i [reg_instance $f]
 
3657     set blamestuff($i) {}
 
3659     filerun $f [list read_line_source $f $i]
 
3662 proc stopblaming {} {
 
3665     if {[info exists blameinst]} {
 
3666         stop_instance $blameinst
 
3672 proc read_line_source {fd inst} {
 
3673     global blamestuff curview commfd blameinst nullid nullid2
 
3675     while {[gets $fd line] >= 0} {
 
3676         lappend blamestuff($inst) $line
 
3684     fconfigure $fd -blocking 1
 
3685     if {[catch {close $fd} err]} {
 
3686         error_popup [mc "Error running git blame: %s" $err]
 
3691     set line [split [lindex $blamestuff($inst) 0] " "]
 
3692     set id [lindex $line 0]
 
3693     set lnum [lindex $line 1]
 
3694     if {[string length $id] == 40 && [string is xdigit $id] &&
 
3695         [string is digit -strict $lnum]} {
 
3696         # look for "filename" line
 
3697         foreach l $blamestuff($inst) {
 
3698             if {[string match "filename *" $l]} {
 
3699                 set fname [string range $l 9 end]
 
3705         # all looks good, select it
 
3706         if {$id eq $nullid} {
 
3707             # blame uses all-zeroes to mean not committed,
 
3708             # which would mean a change in the index
 
3711         if {[commitinview $id $curview]} {
 
3712             selectline [rowofcommit $id] 1 [list $fname $lnum]
 
3714             error_popup [mc "That line comes from commit %s, \
 
3715                              which is not in this view" [shortids $id]]
 
3718         puts "oops couldn't parse git blame output"
 
3723 # delete $dir when we see eof on $f (presumably because the child has exited)
 
3724 proc delete_at_eof {f dir} {
 
3725     while {[gets $f line] >= 0} {}
 
3727         if {[catch {close $f} err]} {
 
3728             error_popup "[mc "External diff viewer failed:"] $err"
 
3730         file delete -force $dir
 
3736 # Functions for adding and removing shell-type quoting
 
3738 proc shellquote {str} {
 
3739     if {![string match "*\['\"\\ \t]*" $str]} {
 
3742     if {![string match "*\['\"\\]*" $str]} {
 
3745     if {![string match "*'*" $str]} {
 
3748     return "\"[string map {\" \\\" \\ \\\\} $str]\""
 
3751 proc shellarglist {l} {
 
3757         append str [shellquote $a]
 
3762 proc shelldequote {str} {
 
3767         if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
 
3768             append ret [string range $str $used end]
 
3769             set used [string length $str]
 
3772         set first [lindex $first 0]
 
3773         set ch [string index $str $first]
 
3774         if {$first > $used} {
 
3775             append ret [string range $str $used [expr {$first - 1}]]
 
3778         if {$ch eq " " || $ch eq "\t"} break
 
3781             set first [string first "'" $str $used]
 
3783                 error "unmatched single-quote"
 
3785             append ret [string range $str $used [expr {$first - 1}]]
 
3790             if {$used >= [string length $str]} {
 
3791                 error "trailing backslash"
 
3793             append ret [string index $str $used]
 
3798             if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
 
3799                 error "unmatched double-quote"
 
3801             set first [lindex $first 0]
 
3802             set ch [string index $str $first]
 
3803             if {$first > $used} {
 
3804                 append ret [string range $str $used [expr {$first - 1}]]
 
3807             if {$ch eq "\""} break
 
3809             append ret [string index $str $used]
 
3813     return [list $used $ret]
 
3816 proc shellsplit {str} {
 
3819         set str [string trimleft $str]
 
3820         if {$str eq {}} break
 
3821         set dq [shelldequote $str]
 
3822         set n [lindex $dq 0]
 
3823         set word [lindex $dq 1]
 
3824         set str [string range $str $n end]
 
3830 # Code to implement multiple views
 
3832 proc newview {ishighlight} {
 
3833     global nextviewnum newviewname newishighlight
 
3834     global revtreeargs viewargscmd newviewopts curview
 
3836     set newishighlight $ishighlight
 
3838     if {[winfo exists $top]} {
 
3842     decode_view_opts $nextviewnum $revtreeargs
 
3843     set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
 
3844     set newviewopts($nextviewnum,perm) 0
 
3845     set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
 
3846     vieweditor $top $nextviewnum [mc "Gitk view definition"]
 
3849 set known_view_options {
 
3850     {perm      b    .  {}               {mc "Remember this view"}}
 
3851     {reflabel  l    +  {}               {mc "References (space separated list):"}}
 
3852     {refs      t15  .. {}               {mc "Branches & tags:"}}
 
3853     {allrefs   b    *. "--all"          {mc "All refs"}}
 
3854     {branches  b    .  "--branches"     {mc "All (local) branches"}}
 
3855     {tags      b    .  "--tags"         {mc "All tags"}}
 
3856     {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
 
3857     {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
 
3858     {author    t15  .. "--author=*"     {mc "Author:"}}
 
3859     {committer t15  .  "--committer=*"  {mc "Committer:"}}
 
3860     {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
 
3861     {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
 
3862     {changes_l l    +  {}               {mc "Changes to Files:"}}
 
3863     {pickaxe_s r0   .  {}               {mc "Fixed String"}}
 
3864     {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
 
3865     {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
 
3866     {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
 
3867     {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
 
3868     {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
 
3869     {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
 
3870     {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
 
3871     {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
 
3872     {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
 
3873     {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
 
3874     {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
 
3875     {first     b    .  "--first-parent" {mc "Limit to first parent"}}
 
3876     {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
 
3877     {args      t50  *. {}               {mc "Additional arguments to git log:"}}
 
3878     {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
 
3879     {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
 
3882 # Convert $newviewopts($n, ...) into args for git log.
 
3883 proc encode_view_opts {n} {
 
3884     global known_view_options newviewopts
 
3887     foreach opt $known_view_options {
 
3888         set patterns [lindex $opt 3]
 
3889         if {$patterns eq {}} continue
 
3890         set pattern [lindex $patterns 0]
 
3892         if {[lindex $opt 1] eq "b"} {
 
3893             set val $newviewopts($n,[lindex $opt 0])
 
3895                 lappend rargs $pattern
 
3897         } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
 
3898             regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
 
3899             set val $newviewopts($n,$button_id)
 
3900             if {$val eq $value} {
 
3901                 lappend rargs $pattern
 
3904             set val $newviewopts($n,[lindex $opt 0])
 
3905             set val [string trim $val]
 
3907                 set pfix [string range $pattern 0 end-1]
 
3908                 lappend rargs $pfix$val
 
3912     set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
 
3913     return [concat $rargs [shellsplit $newviewopts($n,args)]]
 
3916 # Fill $newviewopts($n, ...) based on args for git log.
 
3917 proc decode_view_opts {n view_args} {
 
3918     global known_view_options newviewopts
 
3920     foreach opt $known_view_options {
 
3921         set id [lindex $opt 0]
 
3922         if {[lindex $opt 1] eq "b"} {
 
3925         } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
 
3927             regexp {^(.*_)} $id uselessvar id
 
3933         set newviewopts($n,$id) $val
 
3937     foreach arg $view_args {
 
3938         if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
 
3939             && ![info exists found(limit)]} {
 
3940             set newviewopts($n,limit) $cnt
 
3945         foreach opt $known_view_options {
 
3946             set id [lindex $opt 0]
 
3947             if {[info exists found($id)]} continue
 
3948             foreach pattern [lindex $opt 3] {
 
3949                 if {![string match $pattern $arg]} continue
 
3950                 if {[lindex $opt 1] eq "b"} {
 
3953                 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
 
3955                     regexp {^(.*_)} $id uselessvar id
 
3959                     set size [string length $pattern]
 
3960                     set val [string range $arg [expr {$size-1}] end]
 
3962                 set newviewopts($n,$id) $val
 
3966             if {[info exists val]} break
 
3968         if {[info exists val]} continue
 
3969         if {[regexp {^-} $arg]} {
 
3972             lappend refargs $arg
 
3975     set newviewopts($n,refs) [shellarglist $refargs]
 
3976     set newviewopts($n,args) [shellarglist $oargs]
 
3979 proc edit_or_newview {} {
 
3991     global viewname viewperm newviewname newviewopts
 
3992     global viewargs viewargscmd
 
3994     set top .gitkvedit-$curview
 
3995     if {[winfo exists $top]} {
 
3999     decode_view_opts $curview $viewargs($curview)
 
4000     set newviewname($curview)      $viewname($curview)
 
4001     set newviewopts($curview,perm) $viewperm($curview)
 
4002     set newviewopts($curview,cmd)  $viewargscmd($curview)
 
4003     vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
 
4006 proc vieweditor {top n title} {
 
4007     global newviewname newviewopts viewfiles bgcolor
 
4008     global known_view_options NS
 
4011     wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
 
4012     make_transient $top .
 
4015     ${NS}::frame $top.nfr
 
4016     ${NS}::label $top.nl -text [mc "View Name"]
 
4017     ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
 
4018     pack $top.nfr -in $top -fill x -pady 5 -padx 3
 
4019     pack $top.nl -in $top.nfr -side left -padx {0 5}
 
4020     pack $top.name -in $top.nfr -side left -padx {0 25}
 
4026     foreach opt $known_view_options {
 
4027         set id [lindex $opt 0]
 
4028         set type [lindex $opt 1]
 
4029         set flags [lindex $opt 2]
 
4030         set title [eval [lindex $opt 4]]
 
4033         if {$flags eq "+" || $flags eq "*"} {
 
4034             set cframe $top.fr$cnt
 
4036             ${NS}::frame $cframe
 
4037             pack $cframe -in $top -fill x -pady 3 -padx 3
 
4038             set cexpand [expr {$flags eq "*"}]
 
4039         } elseif {$flags eq ".." || $flags eq "*."} {
 
4040             set cframe $top.fr$cnt
 
4042             ${NS}::frame $cframe
 
4043             pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
 
4044             set cexpand [expr {$flags eq "*."}]
 
4050             ${NS}::label $cframe.l_$id -text $title
 
4051             pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
 
4052         } elseif {$type eq "b"} {
 
4053             ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
 
4054             pack $cframe.c_$id -in $cframe -side left \
 
4055                 -padx [list $lxpad 0] -expand $cexpand -anchor w
 
4056         } elseif {[regexp {^r(\d+)$} $type type sz]} {
 
4057             regexp {^(.*_)} $id uselessvar button_id
 
4058             ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
 
4059             pack $cframe.c_$id -in $cframe -side left \
 
4060                 -padx [list $lxpad 0] -expand $cexpand -anchor w
 
4061         } elseif {[regexp {^t(\d+)$} $type type sz]} {
 
4062             ${NS}::label $cframe.l_$id -text $title
 
4063             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
 
4064                 -textvariable newviewopts($n,$id)
 
4065             pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
 
4066             pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
 
4067         } elseif {[regexp {^t(\d+)=$} $type type sz]} {
 
4068             ${NS}::label $cframe.l_$id -text $title
 
4069             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
 
4070                 -textvariable newviewopts($n,$id)
 
4071             pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
 
4072             pack $cframe.e_$id -in $cframe -side top -fill x
 
4073         } elseif {$type eq "path"} {
 
4074             ${NS}::label $top.l -text $title
 
4075             pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
 
4076             text $top.t -width 40 -height 5 -background $bgcolor
 
4077             if {[info exists viewfiles($n)]} {
 
4078                 foreach f $viewfiles($n) {
 
4079                     $top.t insert end $f
 
4080                     $top.t insert end "\n"
 
4082                 $top.t delete {end - 1c} end
 
4083                 $top.t mark set insert 0.0
 
4085             pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
 
4089     ${NS}::frame $top.buts
 
4090     ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
 
4091     ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
 
4092     ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
 
4093     bind $top <Control-Return> [list newviewok $top $n]
 
4094     bind $top <F5> [list newviewok $top $n 1]
 
4095     bind $top <Escape> [list destroy $top]
 
4096     grid $top.buts.ok $top.buts.apply $top.buts.can
 
4097     grid columnconfigure $top.buts 0 -weight 1 -uniform a
 
4098     grid columnconfigure $top.buts 1 -weight 1 -uniform a
 
4099     grid columnconfigure $top.buts 2 -weight 1 -uniform a
 
4100     pack $top.buts -in $top -side top -fill x
 
4104 proc doviewmenu {m first cmd op argv} {
 
4105     set nmenu [$m index end]
 
4106     for {set i $first} {$i <= $nmenu} {incr i} {
 
4107         if {[$m entrycget $i -command] eq $cmd} {
 
4108             eval $m $op $i $argv
 
4114 proc allviewmenus {n op args} {
 
4117     doviewmenu .bar.view 5 [list showview $n] $op $args
 
4118     # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
 
4121 proc newviewok {top n {apply 0}} {
 
4122     global nextviewnum newviewperm newviewname newishighlight
 
4123     global viewname viewfiles viewperm selectedview curview
 
4124     global viewargs viewargscmd newviewopts viewhlmenu
 
4127         set newargs [encode_view_opts $n]
 
4129         error_popup "[mc "Error in commit selection arguments:"] $err" $top
 
4133     foreach f [split [$top.t get 0.0 end] "\n"] {
 
4134         set ft [string trim $f]
 
4139     if {![info exists viewfiles($n)]} {
 
4140         # creating a new view
 
4142         set viewname($n) $newviewname($n)
 
4143         set viewperm($n) $newviewopts($n,perm)
 
4144         set viewfiles($n) $files
 
4145         set viewargs($n) $newargs
 
4146         set viewargscmd($n) $newviewopts($n,cmd)
 
4148         if {!$newishighlight} {
 
4151             run addvhighlight $n
 
4154         # editing an existing view
 
4155         set viewperm($n) $newviewopts($n,perm)
 
4156         if {$newviewname($n) ne $viewname($n)} {
 
4157             set viewname($n) $newviewname($n)
 
4158             doviewmenu .bar.view 5 [list showview $n] \
 
4159                 entryconf [list -label $viewname($n)]
 
4160             # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
 
4161                 # entryconf [list -label $viewname($n) -value $viewname($n)]
 
4163         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
 
4164                 $newviewopts($n,cmd) ne $viewargscmd($n)} {
 
4165             set viewfiles($n) $files
 
4166             set viewargs($n) $newargs
 
4167             set viewargscmd($n) $newviewopts($n,cmd)
 
4168             if {$curview == $n} {
 
4174     catch {destroy $top}
 
4178     global curview viewperm hlview selectedhlview
 
4180     if {$curview == 0} return
 
4181     if {[info exists hlview] && $hlview == $curview} {
 
4182         set selectedhlview [mc "None"]
 
4185     allviewmenus $curview delete
 
4186     set viewperm($curview) 0
 
4190 proc addviewmenu {n} {
 
4191     global viewname viewhlmenu
 
4193     .bar.view add radiobutton -label $viewname($n) \
 
4194         -command [list showview $n] -variable selectedview -value $n
 
4195     #$viewhlmenu add radiobutton -label $viewname($n) \
 
4196     #   -command [list addvhighlight $n] -variable selectedhlview
 
4200     global curview cached_commitrow ordertok
 
4201     global displayorder parentlist rowidlist rowisopt rowfinal
 
4202     global colormap rowtextx nextcolor canvxmax
 
4203     global numcommits viewcomplete
 
4204     global selectedline currentid canv canvy0
 
4206     global pending_select mainheadid
 
4209     global hlview selectedhlview commitinterest
 
4211     if {$n == $curview} return
 
4213     set ymax [lindex [$canv cget -scrollregion] 3]
 
4214     set span [$canv yview]
 
4215     set ytop [expr {[lindex $span 0] * $ymax}]
 
4216     set ybot [expr {[lindex $span 1] * $ymax}]
 
4217     set yscreen [expr {($ybot - $ytop) / 2}]
 
4218     if {$selectedline ne {}} {
 
4219         set selid $currentid
 
4220         set y [yc $selectedline]
 
4221         if {$ytop < $y && $y < $ybot} {
 
4222             set yscreen [expr {$y - $ytop}]
 
4224     } elseif {[info exists pending_select]} {
 
4225         set selid $pending_select
 
4226         unset pending_select
 
4230     catch {unset treediffs}
 
4232     if {[info exists hlview] && $hlview == $n} {
 
4234         set selectedhlview [mc "None"]
 
4236     catch {unset commitinterest}
 
4237     catch {unset cached_commitrow}
 
4238     catch {unset ordertok}
 
4242     .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
 
4243     .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
 
4246     if {![info exists viewcomplete($n)]} {
 
4256     set numcommits $commitidx($n)
 
4258     catch {unset colormap}
 
4259     catch {unset rowtextx}
 
4261     set canvxmax [$canv cget -width]
 
4267     if {$selid ne {} && [commitinview $selid $n]} {
 
4268         set row [rowofcommit $selid]
 
4269         # try to get the selected row in the same position on the screen
 
4270         set ymax [lindex [$canv cget -scrollregion] 3]
 
4271         set ytop [expr {[yc $row] - $yscreen}]
 
4275         set yf [expr {$ytop * 1.0 / $ymax}]
 
4277     allcanvs yview moveto $yf
 
4281     } elseif {!$viewcomplete($n)} {
 
4282         reset_pending_select $selid
 
4284         reset_pending_select {}
 
4286         if {[commitinview $pending_select $curview]} {
 
4287             selectline [rowofcommit $pending_select] 1
 
4289             set row [first_real_row]
 
4290             if {$row < $numcommits} {
 
4295     if {!$viewcomplete($n)} {
 
4296         if {$numcommits == 0} {
 
4297             show_status [mc "Reading commits..."]
 
4299     } elseif {$numcommits == 0} {
 
4300         show_status [mc "No commits selected"]
 
4304 # Stuff relating to the highlighting facility
 
4306 proc ishighlighted {id} {
 
4307     global vhighlights fhighlights nhighlights rhighlights
 
4309     if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
 
4310         return $nhighlights($id)
 
4312     if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
 
4313         return $vhighlights($id)
 
4315     if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
 
4316         return $fhighlights($id)
 
4318     if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
 
4319         return $rhighlights($id)
 
4324 proc bolden {id font} {
 
4325     global canv linehtag currentid boldids need_redisplay markedid
 
4327     # need_redisplay = 1 means the display is stale and about to be redrawn
 
4328     if {$need_redisplay} return
 
4330     $canv itemconf $linehtag($id) -font $font
 
4331     if {[info exists currentid] && $id eq $currentid} {
 
4333         set t [eval $canv create rect [$canv bbox $linehtag($id)] \
 
4334                    -outline {{}} -tags secsel \
 
4335                    -fill [$canv cget -selectbackground]]
 
4338     if {[info exists markedid] && $id eq $markedid} {
 
4343 proc bolden_name {id font} {
 
4344     global canv2 linentag currentid boldnameids need_redisplay
 
4346     if {$need_redisplay} return
 
4347     lappend boldnameids $id
 
4348     $canv2 itemconf $linentag($id) -font $font
 
4349     if {[info exists currentid] && $id eq $currentid} {
 
4350         $canv2 delete secsel
 
4351         set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
 
4352                    -outline {{}} -tags secsel \
 
4353                    -fill [$canv2 cget -selectbackground]]
 
4362     foreach id $boldids {
 
4363         if {![ishighlighted $id]} {
 
4366             lappend stillbold $id
 
4369     set boldids $stillbold
 
4372 proc addvhighlight {n} {
 
4373     global hlview viewcomplete curview vhl_done commitidx
 
4375     if {[info exists hlview]} {
 
4379     if {$n != $curview && ![info exists viewcomplete($n)]} {
 
4382     set vhl_done $commitidx($hlview)
 
4383     if {$vhl_done > 0} {
 
4388 proc delvhighlight {} {
 
4389     global hlview vhighlights
 
4391     if {![info exists hlview]} return
 
4393     catch {unset vhighlights}
 
4397 proc vhighlightmore {} {
 
4398     global hlview vhl_done commitidx vhighlights curview
 
4400     set max $commitidx($hlview)
 
4401     set vr [visiblerows]
 
4402     set r0 [lindex $vr 0]
 
4403     set r1 [lindex $vr 1]
 
4404     for {set i $vhl_done} {$i < $max} {incr i} {
 
4405         set id [commitonrow $i $hlview]
 
4406         if {[commitinview $id $curview]} {
 
4407             set row [rowofcommit $id]
 
4408             if {$r0 <= $row && $row <= $r1} {
 
4409                 if {![highlighted $row]} {
 
4410                     bolden $id mainfontbold
 
4412                 set vhighlights($id) 1
 
4420 proc askvhighlight {row id} {
 
4421     global hlview vhighlights iddrawn
 
4423     if {[commitinview $id $hlview]} {
 
4424         if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
 
4425             bolden $id mainfontbold
 
4427         set vhighlights($id) 1
 
4429         set vhighlights($id) 0
 
4433 proc hfiles_change {} {
 
4434     global highlight_files filehighlight fhighlights fh_serial
 
4435     global highlight_paths
 
4437     if {[info exists filehighlight]} {
 
4438         # delete previous highlights
 
4439         catch {close $filehighlight}
 
4441         catch {unset fhighlights}
 
4443         unhighlight_filelist
 
4445     set highlight_paths {}
 
4446     after cancel do_file_hl $fh_serial
 
4448     if {$highlight_files ne {}} {
 
4449         after 300 do_file_hl $fh_serial
 
4453 proc gdttype_change {name ix op} {
 
4454     global gdttype highlight_files findstring findpattern
 
4457     if {$findstring ne {}} {
 
4458         if {$gdttype eq [mc "containing:"]} {
 
4459             if {$highlight_files ne {}} {
 
4460                 set highlight_files {}
 
4465             if {$findpattern ne {}} {
 
4469             set highlight_files $findstring
 
4474     # enable/disable findtype/findloc menus too
 
4477 proc find_change {name ix op} {
 
4478     global gdttype findstring highlight_files
 
4481     if {$gdttype eq [mc "containing:"]} {
 
4484         if {$highlight_files ne $findstring} {
 
4485             set highlight_files $findstring
 
4492 proc findcom_change args {
 
4493     global nhighlights boldnameids
 
4494     global findpattern findtype findstring gdttype
 
4497     # delete previous highlights, if any
 
4498     foreach id $boldnameids {
 
4499         bolden_name $id mainfont
 
4502     catch {unset nhighlights}
 
4505     if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
 
4507     } elseif {$findtype eq [mc "Regexp"]} {
 
4508         set findpattern $findstring
 
4510         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
 
4512         set findpattern "*$e*"
 
4516 proc makepatterns {l} {
 
4519         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
 
4520         if {[string index $ee end] eq "/"} {
 
4530 proc do_file_hl {serial} {
 
4531     global highlight_files filehighlight highlight_paths gdttype fhl_list
 
4533     if {$gdttype eq [mc "touching paths:"]} {
 
4534         if {[catch {set paths [shellsplit $highlight_files]}]} return
 
4535         set highlight_paths [makepatterns $paths]
 
4537         set gdtargs [concat -- $paths]
 
4538     } elseif {$gdttype eq [mc "adding/removing string:"]} {
 
4539         set gdtargs [list "-S$highlight_files"]
 
4541         # must be "containing:", i.e. we're searching commit info
 
4544     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
 
4545     set filehighlight [open $cmd r+]
 
4546     fconfigure $filehighlight -blocking 0
 
4547     filerun $filehighlight readfhighlight
 
4553 proc flushhighlights {} {
 
4554     global filehighlight fhl_list
 
4556     if {[info exists filehighlight]} {
 
4558         puts $filehighlight ""
 
4559         flush $filehighlight
 
4563 proc askfilehighlight {row id} {
 
4564     global filehighlight fhighlights fhl_list
 
4566     lappend fhl_list $id
 
4567     set fhighlights($id) -1
 
4568     puts $filehighlight $id
 
4571 proc readfhighlight {} {
 
4572     global filehighlight fhighlights curview iddrawn
 
4573     global fhl_list find_dirn
 
4575     if {![info exists filehighlight]} {
 
4579     while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
 
4580         set line [string trim $line]
 
4581         set i [lsearch -exact $fhl_list $line]
 
4582         if {$i < 0} continue
 
4583         for {set j 0} {$j < $i} {incr j} {
 
4584             set id [lindex $fhl_list $j]
 
4585             set fhighlights($id) 0
 
4587         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
 
4588         if {$line eq {}} continue
 
4589         if {![commitinview $line $curview]} continue
 
4590         if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
 
4591             bolden $line mainfontbold
 
4593         set fhighlights($line) 1
 
4595     if {[eof $filehighlight]} {
 
4597         puts "oops, git diff-tree died"
 
4598         catch {close $filehighlight}
 
4602     if {[info exists find_dirn]} {
 
4608 proc doesmatch {f} {
 
4609     global findtype findpattern
 
4611     if {$findtype eq [mc "Regexp"]} {
 
4612         return [regexp $findpattern $f]
 
4613     } elseif {$findtype eq [mc "IgnCase"]} {
 
4614         return [string match -nocase $findpattern $f]
 
4616         return [string match $findpattern $f]
 
4620 proc askfindhighlight {row id} {
 
4621     global nhighlights commitinfo iddrawn
 
4623     global markingmatches
 
4625     if {![info exists commitinfo($id)]} {
 
4628     set info $commitinfo($id)
 
4630     set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
 
4631     foreach f $info ty $fldtypes {
 
4632         if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
 
4634             if {$ty eq [mc "Author"]} {
 
4641     if {$isbold && [info exists iddrawn($id)]} {
 
4642         if {![ishighlighted $id]} {
 
4643             bolden $id mainfontbold
 
4645                 bolden_name $id mainfontbold
 
4648         if {$markingmatches} {
 
4649             markrowmatches $row $id
 
4652     set nhighlights($id) $isbold
 
4655 proc markrowmatches {row id} {
 
4656     global canv canv2 linehtag linentag commitinfo findloc
 
4658     set headline [lindex $commitinfo($id) 0]
 
4659     set author [lindex $commitinfo($id) 1]
 
4660     $canv delete match$row
 
4661     $canv2 delete match$row
 
4662     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
 
4663         set m [findmatches $headline]
 
4665             markmatches $canv $row $headline $linehtag($id) $m \
 
4666                 [$canv itemcget $linehtag($id) -font] $row
 
4669     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
 
4670         set m [findmatches $author]
 
4672             markmatches $canv2 $row $author $linentag($id) $m \
 
4673                 [$canv2 itemcget $linentag($id) -font] $row
 
4678 proc vrel_change {name ix op} {
 
4679     global highlight_related
 
4682     if {$highlight_related ne [mc "None"]} {
 
4687 # prepare for testing whether commits are descendents or ancestors of a
 
4688 proc rhighlight_sel {a} {
 
4689     global descendent desc_todo ancestor anc_todo
 
4690     global highlight_related
 
4692     catch {unset descendent}
 
4693     set desc_todo [list $a]
 
4694     catch {unset ancestor}
 
4695     set anc_todo [list $a]
 
4696     if {$highlight_related ne [mc "None"]} {
 
4702 proc rhighlight_none {} {
 
4705     catch {unset rhighlights}
 
4709 proc is_descendent {a} {
 
4710     global curview children descendent desc_todo
 
4713     set la [rowofcommit $a]
 
4717     for {set i 0} {$i < [llength $todo]} {incr i} {
 
4718         set do [lindex $todo $i]
 
4719         if {[rowofcommit $do] < $la} {
 
4720             lappend leftover $do
 
4723         foreach nk $children($v,$do) {
 
4724             if {![info exists descendent($nk)]} {
 
4725                 set descendent($nk) 1
 
4733             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
 
4737     set descendent($a) 0
 
4738     set desc_todo $leftover
 
4741 proc is_ancestor {a} {
 
4742     global curview parents ancestor anc_todo
 
4745     set la [rowofcommit $a]
 
4749     for {set i 0} {$i < [llength $todo]} {incr i} {
 
4750         set do [lindex $todo $i]
 
4751         if {![commitinview $do $v] || [rowofcommit $do] > $la} {
 
4752             lappend leftover $do
 
4755         foreach np $parents($v,$do) {
 
4756             if {![info exists ancestor($np)]} {
 
4765             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
 
4770     set anc_todo $leftover
 
4773 proc askrelhighlight {row id} {
 
4774     global descendent highlight_related iddrawn rhighlights
 
4775     global selectedline ancestor
 
4777     if {$selectedline eq {}} return
 
4779     if {$highlight_related eq [mc "Descendant"] ||
 
4780         $highlight_related eq [mc "Not descendant"]} {
 
4781         if {![info exists descendent($id)]} {
 
4784         if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
 
4787     } elseif {$highlight_related eq [mc "Ancestor"] ||
 
4788               $highlight_related eq [mc "Not ancestor"]} {
 
4789         if {![info exists ancestor($id)]} {
 
4792         if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
 
4796     if {[info exists iddrawn($id)]} {
 
4797         if {$isbold && ![ishighlighted $id]} {
 
4798             bolden $id mainfontbold
 
4801     set rhighlights($id) $isbold
 
4804 # Graph layout functions
 
4806 proc shortids {ids} {
 
4809         if {[llength $id] > 1} {
 
4810             lappend res [shortids $id]
 
4811         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
 
4812             lappend res [string range $id 0 7]
 
4823     for {set mask 1} {$mask <= $n} {incr mask $mask} {
 
4824         if {($n & $mask) != 0} {
 
4825             set ret [concat $ret $o]
 
4827         set o [concat $o $o]
 
4832 proc ordertoken {id} {
 
4833     global ordertok curview varcid varcstart varctok curview parents children
 
4834     global nullid nullid2
 
4836     if {[info exists ordertok($id)]} {
 
4837         return $ordertok($id)
 
4842         if {[info exists varcid($curview,$id)]} {
 
4843             set a $varcid($curview,$id)
 
4844             set p [lindex $varcstart($curview) $a]
 
4846             set p [lindex $children($curview,$id) 0]
 
4848         if {[info exists ordertok($p)]} {
 
4849             set tok $ordertok($p)
 
4852         set id [first_real_child $curview,$p]
 
4855             set tok [lindex $varctok($curview) $varcid($curview,$p)]
 
4858         if {[llength $parents($curview,$id)] == 1} {
 
4859             lappend todo [list $p {}]
 
4861             set j [lsearch -exact $parents($curview,$id) $p]
 
4863                 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
 
4865             lappend todo [list $p [strrep $j]]
 
4868     for {set i [llength $todo]} {[incr i -1] >= 0} {} {
 
4869         set p [lindex $todo $i 0]
 
4870         append tok [lindex $todo $i 1]
 
4871         set ordertok($p) $tok
 
4873     set ordertok($origid) $tok
 
4877 # Work out where id should go in idlist so that order-token
 
4878 # values increase from left to right
 
4879 proc idcol {idlist id {i 0}} {
 
4880     set t [ordertoken $id]
 
4884     if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
 
4885         if {$i > [llength $idlist]} {
 
4886             set i [llength $idlist]
 
4888         while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
 
4891         if {$t > [ordertoken [lindex $idlist $i]]} {
 
4892             while {[incr i] < [llength $idlist] &&
 
4893                    $t >= [ordertoken [lindex $idlist $i]]} {}
 
4899 proc initlayout {} {
 
4900     global rowidlist rowisopt rowfinal displayorder parentlist
 
4901     global numcommits canvxmax canv
 
4903     global colormap rowtextx
 
4912     set canvxmax [$canv cget -width]
 
4913     catch {unset colormap}
 
4914     catch {unset rowtextx}
 
4918 proc setcanvscroll {} {
 
4919     global canv canv2 canv3 numcommits linespc canvxmax canvy0
 
4920     global lastscrollset lastscrollrows
 
4922     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
 
4923     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
 
4924     $canv2 conf -scrollregion [list 0 0 0 $ymax]
 
4925     $canv3 conf -scrollregion [list 0 0 0 $ymax]
 
4926     set lastscrollset [clock clicks -milliseconds]
 
4927     set lastscrollrows $numcommits
 
4930 proc visiblerows {} {
 
4931     global canv numcommits linespc
 
4933     set ymax [lindex [$canv cget -scrollregion] 3]
 
4934     if {$ymax eq {} || $ymax == 0} return
 
4936     set y0 [expr {int([lindex $f 0] * $ymax)}]
 
4937     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
 
4941     set y1 [expr {int([lindex $f 1] * $ymax)}]
 
4942     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
 
4943     if {$r1 >= $numcommits} {
 
4944         set r1 [expr {$numcommits - 1}]
 
4946     return [list $r0 $r1]
 
4949 proc layoutmore {} {
 
4950     global commitidx viewcomplete curview
 
4951     global numcommits pending_select curview
 
4952     global lastscrollset lastscrollrows
 
4954     if {$lastscrollrows < 100 || $viewcomplete($curview) ||
 
4955         [clock clicks -milliseconds] - $lastscrollset > 500} {
 
4958     if {[info exists pending_select] &&
 
4959         [commitinview $pending_select $curview]} {
 
4961         selectline [rowofcommit $pending_select] 1
 
4966 # With path limiting, we mightn't get the actual HEAD commit,
 
4967 # so ask git rev-list what is the first ancestor of HEAD that
 
4968 # touches a file in the path limit.
 
4969 proc get_viewmainhead {view} {
 
4970     global viewmainheadid vfilelimit viewinstances mainheadid
 
4973         set rfd [open [concat | git rev-list -1 $mainheadid \
 
4974                            -- $vfilelimit($view)] r]
 
4975         set j [reg_instance $rfd]
 
4976         lappend viewinstances($view) $j
 
4977         fconfigure $rfd -blocking 0
 
4978         filerun $rfd [list getviewhead $rfd $j $view]
 
4979         set viewmainheadid($curview) {}
 
4983 # git rev-list should give us just 1 line to use as viewmainheadid($view)
 
4984 proc getviewhead {fd inst view} {
 
4985     global viewmainheadid commfd curview viewinstances showlocalchanges
 
4988     if {[gets $fd line] < 0} {
 
4992     } elseif {[string length $line] == 40 && [string is xdigit $line]} {
 
4995     set viewmainheadid($view) $id
 
4998     set i [lsearch -exact $viewinstances($view) $inst]
 
5000         set viewinstances($view) [lreplace $viewinstances($view) $i $i]
 
5002     if {$showlocalchanges && $id ne {} && $view == $curview} {
 
5008 proc doshowlocalchanges {} {
 
5009     global curview viewmainheadid
 
5011     if {$viewmainheadid($curview) eq {}} return
 
5012     if {[commitinview $viewmainheadid($curview) $curview]} {
 
5015         interestedin $viewmainheadid($curview) dodiffindex
 
5019 proc dohidelocalchanges {} {
 
5020     global nullid nullid2 lserial curview
 
5022     if {[commitinview $nullid $curview]} {
 
5023         removefakerow $nullid
 
5025     if {[commitinview $nullid2 $curview]} {
 
5026         removefakerow $nullid2
 
5031 # spawn off a process to do git diff-index --cached HEAD
 
5032 proc dodiffindex {} {
 
5033     global lserial showlocalchanges vfilelimit curview
 
5036     if {!$showlocalchanges || !$isworktree} return
 
5038     set cmd "|git diff-index --cached HEAD"
 
5039     if {$vfilelimit($curview) ne {}} {
 
5040         set cmd [concat $cmd -- $vfilelimit($curview)]
 
5042     set fd [open $cmd r]
 
5043     fconfigure $fd -blocking 0
 
5044     set i [reg_instance $fd]
 
5045     filerun $fd [list readdiffindex $fd $lserial $i]
 
5048 proc readdiffindex {fd serial inst} {
 
5049     global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
 
5053     if {[gets $fd line] < 0} {
 
5059     # we only need to see one line and we don't really care what it says...
 
5062     if {$serial != $lserial} {
 
5066     # now see if there are any local changes not checked in to the index
 
5067     set cmd "|git diff-files"
 
5068     if {$vfilelimit($curview) ne {}} {
 
5069         set cmd [concat $cmd -- $vfilelimit($curview)]
 
5071     set fd [open $cmd r]
 
5072     fconfigure $fd -blocking 0
 
5073     set i [reg_instance $fd]
 
5074     filerun $fd [list readdifffiles $fd $serial $i]
 
5076     if {$isdiff && ![commitinview $nullid2 $curview]} {
 
5077         # add the line for the changes in the index to the graph
 
5078         set hl [mc "Local changes checked in to index but not committed"]
 
5079         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
 
5080         set commitdata($nullid2) "\n    $hl\n"
 
5081         if {[commitinview $nullid $curview]} {
 
5082             removefakerow $nullid
 
5084         insertfakerow $nullid2 $viewmainheadid($curview)
 
5085     } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
 
5086         if {[commitinview $nullid $curview]} {
 
5087             removefakerow $nullid
 
5089         removefakerow $nullid2
 
5094 proc readdifffiles {fd serial inst} {
 
5095     global viewmainheadid nullid nullid2 curview
 
5096     global commitinfo commitdata lserial
 
5099     if {[gets $fd line] < 0} {
 
5105     # we only need to see one line and we don't really care what it says...
 
5108     if {$serial != $lserial} {
 
5112     if {$isdiff && ![commitinview $nullid $curview]} {
 
5113         # add the line for the local diff to the graph
 
5114         set hl [mc "Local uncommitted changes, not checked in to index"]
 
5115         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
 
5116         set commitdata($nullid) "\n    $hl\n"
 
5117         if {[commitinview $nullid2 $curview]} {
 
5120             set p $viewmainheadid($curview)
 
5122         insertfakerow $nullid $p
 
5123     } elseif {!$isdiff && [commitinview $nullid $curview]} {
 
5124         removefakerow $nullid
 
5129 proc nextuse {id row} {
 
5130     global curview children
 
5132     if {[info exists children($curview,$id)]} {
 
5133         foreach kid $children($curview,$id) {
 
5134             if {![commitinview $kid $curview]} {
 
5137             if {[rowofcommit $kid] > $row} {
 
5138                 return [rowofcommit $kid]
 
5142     if {[commitinview $id $curview]} {
 
5143         return [rowofcommit $id]
 
5148 proc prevuse {id row} {
 
5149     global curview children
 
5152     if {[info exists children($curview,$id)]} {
 
5153         foreach kid $children($curview,$id) {
 
5154             if {![commitinview $kid $curview]} break
 
5155             if {[rowofcommit $kid] < $row} {
 
5156                 set ret [rowofcommit $kid]
 
5163 proc make_idlist {row} {
 
5164     global displayorder parentlist uparrowlen downarrowlen mingaplen
 
5165     global commitidx curview children
 
5167     set r [expr {$row - $mingaplen - $downarrowlen - 1}]
 
5171     set ra [expr {$row - $downarrowlen}]
 
5175     set rb [expr {$row + $uparrowlen}]
 
5176     if {$rb > $commitidx($curview)} {
 
5177         set rb $commitidx($curview)
 
5179     make_disporder $r [expr {$rb + 1}]
 
5181     for {} {$r < $ra} {incr r} {
 
5182         set nextid [lindex $displayorder [expr {$r + 1}]]
 
5183         foreach p [lindex $parentlist $r] {
 
5184             if {$p eq $nextid} continue
 
5185             set rn [nextuse $p $r]
 
5187                 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
 
5188                 lappend ids [list [ordertoken $p] $p]
 
5192     for {} {$r < $row} {incr r} {
 
5193         set nextid [lindex $displayorder [expr {$r + 1}]]
 
5194         foreach p [lindex $parentlist $r] {
 
5195             if {$p eq $nextid} continue
 
5196             set rn [nextuse $p $r]
 
5197             if {$rn < 0 || $rn >= $row} {
 
5198                 lappend ids [list [ordertoken $p] $p]
 
5202     set id [lindex $displayorder $row]
 
5203     lappend ids [list [ordertoken $id] $id]
 
5205         foreach p [lindex $parentlist $r] {
 
5206             set firstkid [lindex $children($curview,$p) 0]
 
5207             if {[rowofcommit $firstkid] < $row} {
 
5208                 lappend ids [list [ordertoken $p] $p]
 
5212         set id [lindex $displayorder $r]
 
5214             set firstkid [lindex $children($curview,$id) 0]
 
5215             if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
 
5216                 lappend ids [list [ordertoken $id] $id]
 
5221     foreach idx [lsort -unique $ids] {
 
5222         lappend idlist [lindex $idx 1]
 
5227 proc rowsequal {a b} {
 
5228     while {[set i [lsearch -exact $a {}]] >= 0} {
 
5229         set a [lreplace $a $i $i]
 
5231     while {[set i [lsearch -exact $b {}]] >= 0} {
 
5232         set b [lreplace $b $i $i]
 
5234     return [expr {$a eq $b}]
 
5237 proc makeupline {id row rend col} {
 
5238     global rowidlist uparrowlen downarrowlen mingaplen
 
5240     for {set r $rend} {1} {set r $rstart} {
 
5241         set rstart [prevuse $id $r]
 
5242         if {$rstart < 0} return
 
5243         if {$rstart < $row} break
 
5245     if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
 
5246         set rstart [expr {$rend - $uparrowlen - 1}]
 
5248     for {set r $rstart} {[incr r] <= $row} {} {
 
5249         set idlist [lindex $rowidlist $r]
 
5250         if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
 
5251             set col [idcol $idlist $id $col]
 
5252             lset rowidlist $r [linsert $idlist $col $id]
 
5258 proc layoutrows {row endrow} {
 
5259     global rowidlist rowisopt rowfinal displayorder
 
5260     global uparrowlen downarrowlen maxwidth mingaplen
 
5261     global children parentlist
 
5262     global commitidx viewcomplete curview
 
5264     make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
 
5267         set rm1 [expr {$row - 1}]
 
5268         foreach id [lindex $rowidlist $rm1] {
 
5273         set final [lindex $rowfinal $rm1]
 
5275     for {} {$row < $endrow} {incr row} {
 
5276         set rm1 [expr {$row - 1}]
 
5277         if {$rm1 < 0 || $idlist eq {}} {
 
5278             set idlist [make_idlist $row]
 
5281             set id [lindex $displayorder $rm1]
 
5282             set col [lsearch -exact $idlist $id]
 
5283             set idlist [lreplace $idlist $col $col]
 
5284             foreach p [lindex $parentlist $rm1] {
 
5285                 if {[lsearch -exact $idlist $p] < 0} {
 
5286                     set col [idcol $idlist $p $col]
 
5287                     set idlist [linsert $idlist $col $p]
 
5288                     # if not the first child, we have to insert a line going up
 
5289                     if {$id ne [lindex $children($curview,$p) 0]} {
 
5290                         makeupline $p $rm1 $row $col
 
5294             set id [lindex $displayorder $row]
 
5295             if {$row > $downarrowlen} {
 
5296                 set termrow [expr {$row - $downarrowlen - 1}]
 
5297                 foreach p [lindex $parentlist $termrow] {
 
5298                     set i [lsearch -exact $idlist $p]
 
5299                     if {$i < 0} continue
 
5300                     set nr [nextuse $p $termrow]
 
5301                     if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
 
5302                         set idlist [lreplace $idlist $i $i]
 
5306             set col [lsearch -exact $idlist $id]
 
5308                 set col [idcol $idlist $id]
 
5309                 set idlist [linsert $idlist $col $id]
 
5310                 if {$children($curview,$id) ne {}} {
 
5311                     makeupline $id $rm1 $row $col
 
5314             set r [expr {$row + $uparrowlen - 1}]
 
5315             if {$r < $commitidx($curview)} {
 
5317                 foreach p [lindex $parentlist $r] {
 
5318                     if {[lsearch -exact $idlist $p] >= 0} continue
 
5319                     set fk [lindex $children($curview,$p) 0]
 
5320                     if {[rowofcommit $fk] < $row} {
 
5321                         set x [idcol $idlist $p $x]
 
5322                         set idlist [linsert $idlist $x $p]
 
5325                 if {[incr r] < $commitidx($curview)} {
 
5326                     set p [lindex $displayorder $r]
 
5327                     if {[lsearch -exact $idlist $p] < 0} {
 
5328                         set fk [lindex $children($curview,$p) 0]
 
5329                         if {$fk ne {} && [rowofcommit $fk] < $row} {
 
5330                             set x [idcol $idlist $p $x]
 
5331                             set idlist [linsert $idlist $x $p]
 
5337         if {$final && !$viewcomplete($curview) &&
 
5338             $row + $uparrowlen + $mingaplen + $downarrowlen
 
5339                 >= $commitidx($curview)} {
 
5342         set l [llength $rowidlist]
 
5344             lappend rowidlist $idlist
 
5346             lappend rowfinal $final
 
5347         } elseif {$row < $l} {
 
5348             if {![rowsequal $idlist [lindex $rowidlist $row]]} {
 
5349                 lset rowidlist $row $idlist
 
5352             lset rowfinal $row $final
 
5354             set pad [ntimes [expr {$row - $l}] {}]
 
5355             set rowidlist [concat $rowidlist $pad]
 
5356             lappend rowidlist $idlist
 
5357             set rowfinal [concat $rowfinal $pad]
 
5358             lappend rowfinal $final
 
5359             set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
 
5365 proc changedrow {row} {
 
5366     global displayorder iddrawn rowisopt need_redisplay
 
5368     set l [llength $rowisopt]
 
5370         lset rowisopt $row 0
 
5371         if {$row + 1 < $l} {
 
5372             lset rowisopt [expr {$row + 1}] 0
 
5373             if {$row + 2 < $l} {
 
5374                 lset rowisopt [expr {$row + 2}] 0
 
5378     set id [lindex $displayorder $row]
 
5379     if {[info exists iddrawn($id)]} {
 
5380         set need_redisplay 1
 
5384 proc insert_pad {row col npad} {
 
5387     set pad [ntimes $npad {}]
 
5388     set idlist [lindex $rowidlist $row]
 
5389     set bef [lrange $idlist 0 [expr {$col - 1}]]
 
5390     set aft [lrange $idlist $col end]
 
5391     set i [lsearch -exact $aft {}]
 
5393         set aft [lreplace $aft $i $i]
 
5395     lset rowidlist $row [concat $bef $pad $aft]
 
5399 proc optimize_rows {row col endrow} {
 
5400     global rowidlist rowisopt displayorder curview children
 
5405     for {} {$row < $endrow} {incr row; set col 0} {
 
5406         if {[lindex $rowisopt $row]} continue
 
5408         set y0 [expr {$row - 1}]
 
5409         set ym [expr {$row - 2}]
 
5410         set idlist [lindex $rowidlist $row]
 
5411         set previdlist [lindex $rowidlist $y0]
 
5412         if {$idlist eq {} || $previdlist eq {}} continue
 
5414             set pprevidlist [lindex $rowidlist $ym]
 
5415             if {$pprevidlist eq {}} continue
 
5421         for {} {$col < [llength $idlist]} {incr col} {
 
5422             set id [lindex $idlist $col]
 
5423             if {[lindex $previdlist $col] eq $id} continue
 
5428             set x0 [lsearch -exact $previdlist $id]
 
5429             if {$x0 < 0} continue
 
5430             set z [expr {$x0 - $col}]
 
5434                 set xm [lsearch -exact $pprevidlist $id]
 
5436                     set z0 [expr {$xm - $x0}]
 
5440                 # if row y0 is the first child of $id then it's not an arrow
 
5441                 if {[lindex $children($curview,$id) 0] ne
 
5442                     [lindex $displayorder $y0]} {
 
5446             if {!$isarrow && $id ne [lindex $displayorder $row] &&
 
5447                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
 
5450             # Looking at lines from this row to the previous row,
 
5451             # make them go straight up if they end in an arrow on
 
5452             # the previous row; otherwise make them go straight up
 
5454             if {$z < -1 || ($z < 0 && $isarrow)} {
 
5455                 # Line currently goes left too much;
 
5456                 # insert pads in the previous row, then optimize it
 
5457                 set npad [expr {-1 - $z + $isarrow}]
 
5458                 insert_pad $y0 $x0 $npad
 
5460                     optimize_rows $y0 $x0 $row
 
5462                 set previdlist [lindex $rowidlist $y0]
 
5463                 set x0 [lsearch -exact $previdlist $id]
 
5464                 set z [expr {$x0 - $col}]
 
5466                     set pprevidlist [lindex $rowidlist $ym]
 
5467                     set xm [lsearch -exact $pprevidlist $id]
 
5468                     set z0 [expr {$xm - $x0}]
 
5470             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
 
5471                 # Line currently goes right too much;
 
5472                 # insert pads in this line
 
5473                 set npad [expr {$z - 1 + $isarrow}]
 
5474                 insert_pad $row $col $npad
 
5475                 set idlist [lindex $rowidlist $row]
 
5477                 set z [expr {$x0 - $col}]
 
5480             if {$z0 eq {} && !$isarrow && $ym >= 0} {
 
5481                 # this line links to its first child on row $row-2
 
5482                 set id [lindex $displayorder $ym]
 
5483                 set xc [lsearch -exact $pprevidlist $id]
 
5485                     set z0 [expr {$xc - $x0}]
 
5488             # avoid lines jigging left then immediately right
 
5489             if {$z0 ne {} && $z < 0 && $z0 > 0} {
 
5490                 insert_pad $y0 $x0 1
 
5492                 optimize_rows $y0 $x0 $row
 
5493                 set previdlist [lindex $rowidlist $y0]
 
5497             # Find the first column that doesn't have a line going right
 
5498             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
 
5499                 set id [lindex $idlist $col]
 
5500                 if {$id eq {}} break
 
5501                 set x0 [lsearch -exact $previdlist $id]
 
5503                     # check if this is the link to the first child
 
5504                     set kid [lindex $displayorder $y0]
 
5505                     if {[lindex $children($curview,$id) 0] eq $kid} {
 
5506                         # it is, work out offset to child
 
5507                         set x0 [lsearch -exact $previdlist $kid]
 
5510                 if {$x0 <= $col} break
 
5512             # Insert a pad at that column as long as it has a line and
 
5513             # isn't the last column
 
5514             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
 
5515                 set idlist [linsert $idlist $col {}]
 
5516                 lset rowidlist $row $idlist
 
5524     global canvx0 linespc
 
5525     return [expr {$canvx0 + $col * $linespc}]
 
5529     global canvy0 linespc
 
5530     return [expr {$canvy0 + $row * $linespc}]
 
5533 proc linewidth {id} {
 
5534     global thickerline lthickness
 
5537     if {[info exists thickerline] && $id eq $thickerline} {
 
5538         set wid [expr {2 * $lthickness}]
 
5543 proc rowranges {id} {
 
5544     global curview children uparrowlen downarrowlen
 
5547     set kids $children($curview,$id)
 
5553     foreach child $kids {
 
5554         if {![commitinview $child $curview]} break
 
5555         set row [rowofcommit $child]
 
5556         if {![info exists prev]} {
 
5557             lappend ret [expr {$row + 1}]
 
5559             if {$row <= $prevrow} {
 
5560                 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
 
5562             # see if the line extends the whole way from prevrow to row
 
5563             if {$row > $prevrow + $uparrowlen + $downarrowlen &&
 
5564                 [lsearch -exact [lindex $rowidlist \
 
5565                             [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
 
5566                 # it doesn't, see where it ends
 
5567                 set r [expr {$prevrow + $downarrowlen}]
 
5568                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
 
5569                     while {[incr r -1] > $prevrow &&
 
5570                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
 
5572                     while {[incr r] <= $row &&
 
5573                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
 
5577                 # see where it starts up again
 
5578                 set r [expr {$row - $uparrowlen}]
 
5579                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
 
5580                     while {[incr r] < $row &&
 
5581                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
 
5583                     while {[incr r -1] >= $prevrow &&
 
5584                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
 
5590         if {$child eq $id} {
 
5599 proc drawlineseg {id row endrow arrowlow} {
 
5600     global rowidlist displayorder iddrawn linesegs
 
5601     global canv colormap linespc curview maxlinelen parentlist
 
5603     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
 
5604     set le [expr {$row + 1}]
 
5607         set c [lsearch -exact [lindex $rowidlist $le] $id]
 
5613         set x [lindex $displayorder $le]
 
5618         if {[info exists iddrawn($x)] || $le == $endrow} {
 
5619             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
 
5635     if {[info exists linesegs($id)]} {
 
5636         set lines $linesegs($id)
 
5638             set r0 [lindex $li 0]
 
5640                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
 
5650         set li [lindex $lines [expr {$i-1}]]
 
5651         set r1 [lindex $li 1]
 
5652         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
 
5657     set x [lindex $cols [expr {$le - $row}]]
 
5658     set xp [lindex $cols [expr {$le - 1 - $row}]]
 
5659     set dir [expr {$xp - $x}]
 
5661         set ith [lindex $lines $i 2]
 
5662         set coords [$canv coords $ith]
 
5663         set ah [$canv itemcget $ith -arrow]
 
5664         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
 
5665         set x2 [lindex $cols [expr {$le + 1 - $row}]]
 
5666         if {$x2 ne {} && $x - $x2 == $dir} {
 
5667             set coords [lrange $coords 0 end-2]
 
5670         set coords [list [xc $le $x] [yc $le]]
 
5673         set itl [lindex $lines [expr {$i-1}] 2]
 
5674         set al [$canv itemcget $itl -arrow]
 
5675         set arrowlow [expr {$al eq "last" || $al eq "both"}]
 
5676     } elseif {$arrowlow} {
 
5677         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
 
5678             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
 
5682     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
 
5683     for {set y $le} {[incr y -1] > $row} {} {
 
5685         set xp [lindex $cols [expr {$y - 1 - $row}]]
 
5686         set ndir [expr {$xp - $x}]
 
5687         if {$dir != $ndir || $xp < 0} {
 
5688             lappend coords [xc $y $x] [yc $y]
 
5694             # join parent line to first child
 
5695             set ch [lindex $displayorder $row]
 
5696             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
 
5698                 puts "oops: drawlineseg: child $ch not on row $row"
 
5699             } elseif {$xc != $x} {
 
5700                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
 
5701                     set d [expr {int(0.5 * $linespc)}]
 
5704                         set x2 [expr {$x1 - $d}]
 
5706                         set x2 [expr {$x1 + $d}]
 
5709                     set y1 [expr {$y2 + $d}]
 
5710                     lappend coords $x1 $y1 $x2 $y2
 
5711                 } elseif {$xc < $x - 1} {
 
5712                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
 
5713                 } elseif {$xc > $x + 1} {
 
5714                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
 
5718             lappend coords [xc $row $x] [yc $row]
 
5720             set xn [xc $row $xp]
 
5722             lappend coords $xn $yn
 
5726             set t [$canv create line $coords -width [linewidth $id] \
 
5727                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
 
5730             set lines [linsert $lines $i [list $row $le $t]]
 
5732             $canv coords $ith $coords
 
5733             if {$arrow ne $ah} {
 
5734                 $canv itemconf $ith -arrow $arrow
 
5736             lset lines $i 0 $row
 
5739         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
 
5740         set ndir [expr {$xo - $xp}]
 
5741         set clow [$canv coords $itl]
 
5742         if {$dir == $ndir} {
 
5743             set clow [lrange $clow 2 end]
 
5745         set coords [concat $coords $clow]
 
5747             lset lines [expr {$i-1}] 1 $le
 
5749             # coalesce two pieces
 
5751             set b [lindex $lines [expr {$i-1}] 0]
 
5752             set e [lindex $lines $i 1]
 
5753             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
 
5755         $canv coords $itl $coords
 
5756         if {$arrow ne $al} {
 
5757             $canv itemconf $itl -arrow $arrow
 
5761     set linesegs($id) $lines
 
5765 proc drawparentlinks {id row} {
 
5766     global rowidlist canv colormap curview parentlist
 
5767     global idpos linespc
 
5769     set rowids [lindex $rowidlist $row]
 
5770     set col [lsearch -exact $rowids $id]
 
5771     if {$col < 0} return
 
5772     set olds [lindex $parentlist $row]
 
5773     set row2 [expr {$row + 1}]
 
5774     set x [xc $row $col]
 
5777     set d [expr {int(0.5 * $linespc)}]
 
5778     set ymid [expr {$y + $d}]
 
5779     set ids [lindex $rowidlist $row2]
 
5780     # rmx = right-most X coord used
 
5783         set i [lsearch -exact $ids $p]
 
5785             puts "oops, parent $p of $id not in list"
 
5788         set x2 [xc $row2 $i]
 
5792         set j [lsearch -exact $rowids $p]
 
5794             # drawlineseg will do this one for us
 
5798         # should handle duplicated parents here...
 
5799         set coords [list $x $y]
 
5801             # if attaching to a vertical segment, draw a smaller
 
5802             # slant for visual distinctness
 
5805                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
 
5807                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
 
5809             } elseif {$i < $col && $i < $j} {
 
5810                 # segment slants towards us already
 
5811                 lappend coords [xc $row $j] $y
 
5813                 if {$i < $col - 1} {
 
5814                     lappend coords [expr {$x2 + $linespc}] $y
 
5815                 } elseif {$i > $col + 1} {
 
5816                     lappend coords [expr {$x2 - $linespc}] $y
 
5818                 lappend coords $x2 $y2
 
5821             lappend coords $x2 $y2
 
5823         set t [$canv create line $coords -width [linewidth $p] \
 
5824                    -fill $colormap($p) -tags lines.$p]
 
5828     if {$rmx > [lindex $idpos($id) 1]} {
 
5829         lset idpos($id) 1 $rmx
 
5834 proc drawlines {id} {
 
5837     $canv itemconf lines.$id -width [linewidth $id]
 
5840 proc drawcmittext {id row col} {
 
5841     global linespc canv canv2 canv3 fgcolor curview
 
5842     global cmitlisted commitinfo rowidlist parentlist
 
5843     global rowtextx idpos idtags idheads idotherrefs
 
5844     global linehtag linentag linedtag selectedline
 
5845     global canvxmax boldids boldnameids fgcolor markedid
 
5846     global mainheadid nullid nullid2 circleitem circlecolors ctxbut
 
5848     # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
 
5849     set listed $cmitlisted($curview,$id)
 
5850     if {$id eq $nullid} {
 
5852     } elseif {$id eq $nullid2} {
 
5854     } elseif {$id eq $mainheadid} {
 
5857         set ofill [lindex $circlecolors $listed]
 
5859     set x [xc $row $col]
 
5861     set orad [expr {$linespc / 3}]
 
5863         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
 
5864                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
 
5865                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
 
5866     } elseif {$listed == 3} {
 
5867         # triangle pointing left for left-side commits
 
5868         set t [$canv create polygon \
 
5869                    [expr {$x - $orad}] $y \
 
5870                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
 
5871                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
 
5872                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
 
5874         # triangle pointing right for right-side commits
 
5875         set t [$canv create polygon \
 
5876                    [expr {$x + $orad - 1}] $y \
 
5877                    [expr {$x - $orad}] [expr {$y - $orad}] \
 
5878                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
 
5879                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
 
5881     set circleitem($row) $t
 
5883     $canv bind $t <1> {selcanvline {} %x %y}
 
5884     set rmx [llength [lindex $rowidlist $row]]
 
5885     set olds [lindex $parentlist $row]
 
5887         set nextids [lindex $rowidlist [expr {$row + 1}]]
 
5889             set i [lsearch -exact $nextids $p]
 
5895     set xt [xc $row $rmx]
 
5896     set rowtextx($row) $xt
 
5897     set idpos($id) [list $x $xt $y]
 
5898     if {[info exists idtags($id)] || [info exists idheads($id)]
 
5899         || [info exists idotherrefs($id)]} {
 
5900         set xt [drawtags $id $x $xt $y]
 
5902     set headline [lindex $commitinfo($id) 0]
 
5903     set name [lindex $commitinfo($id) 1]
 
5904     set date [lindex $commitinfo($id) 2]
 
5905     set date [formatdate $date]
 
5908     set isbold [ishighlighted $id]
 
5911         set font mainfontbold
 
5913             lappend boldnameids $id
 
5914             set nfont mainfontbold
 
5917     set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
 
5918                            -text $headline -font $font -tags text]
 
5919     $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
 
5920     set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
 
5921                            -text $name -font $nfont -tags text]
 
5922     set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
 
5923                            -text $date -font mainfont -tags text]
 
5924     if {$selectedline == $row} {
 
5927     if {[info exists markedid] && $markedid eq $id} {
 
5930     set xr [expr {$xt + [font measure $font $headline]}]
 
5931     if {$xr > $canvxmax} {
 
5937 proc drawcmitrow {row} {
 
5938     global displayorder rowidlist nrows_drawn
 
5939     global iddrawn markingmatches
 
5940     global commitinfo numcommits
 
5941     global filehighlight fhighlights findpattern nhighlights
 
5942     global hlview vhighlights
 
5943     global highlight_related rhighlights
 
5945     if {$row >= $numcommits} return
 
5947     set id [lindex $displayorder $row]
 
5948     if {[info exists hlview] && ![info exists vhighlights($id)]} {
 
5949         askvhighlight $row $id
 
5951     if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
 
5952         askfilehighlight $row $id
 
5954     if {$findpattern ne {} && ![info exists nhighlights($id)]} {
 
5955         askfindhighlight $row $id
 
5957     if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
 
5958         askrelhighlight $row $id
 
5960     if {![info exists iddrawn($id)]} {
 
5961         set col [lsearch -exact [lindex $rowidlist $row] $id]
 
5963             puts "oops, row $row id $id not in list"
 
5966         if {![info exists commitinfo($id)]} {
 
5970         drawcmittext $id $row $col
 
5974     if {$markingmatches} {
 
5975         markrowmatches $row $id
 
5979 proc drawcommits {row {endrow {}}} {
 
5980     global numcommits iddrawn displayorder curview need_redisplay
 
5981     global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
 
5986     if {$endrow eq {}} {
 
5989     if {$endrow >= $numcommits} {
 
5990         set endrow [expr {$numcommits - 1}]
 
5993     set rl1 [expr {$row - $downarrowlen - 3}]
 
5997     set ro1 [expr {$row - 3}]
 
6001     set r2 [expr {$endrow + $uparrowlen + 3}]
 
6002     if {$r2 > $numcommits} {
 
6005     for {set r $rl1} {$r < $r2} {incr r} {
 
6006         if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
 
6010             set rl1 [expr {$r + 1}]
 
6016     optimize_rows $ro1 0 $r2
 
6017     if {$need_redisplay || $nrows_drawn > 2000} {
 
6021     # make the lines join to already-drawn rows either side
 
6022     set r [expr {$row - 1}]
 
6023     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
 
6026     set er [expr {$endrow + 1}]
 
6027     if {$er >= $numcommits ||
 
6028         ![info exists iddrawn([lindex $displayorder $er])]} {
 
6031     for {} {$r <= $er} {incr r} {
 
6032         set id [lindex $displayorder $r]
 
6033         set wasdrawn [info exists iddrawn($id)]
 
6035         if {$r == $er} break
 
6036         set nextid [lindex $displayorder [expr {$r + 1}]]
 
6037         if {$wasdrawn && [info exists iddrawn($nextid)]} continue
 
6038         drawparentlinks $id $r
 
6040         set rowids [lindex $rowidlist $r]
 
6041         foreach lid $rowids {
 
6042             if {$lid eq {}} continue
 
6043             if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
 
6045                 # see if this is the first child of any of its parents
 
6046                 foreach p [lindex $parentlist $r] {
 
6047                     if {[lsearch -exact $rowids $p] < 0} {
 
6048                         # make this line extend up to the child
 
6049                         set lineend($p) [drawlineseg $p $r $er 0]
 
6053                 set lineend($lid) [drawlineseg $lid $r $er 1]
 
6059 proc undolayout {row} {
 
6060     global uparrowlen mingaplen downarrowlen
 
6061     global rowidlist rowisopt rowfinal need_redisplay
 
6063     set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
 
6067     if {[llength $rowidlist] > $r} {
 
6069         set rowidlist [lrange $rowidlist 0 $r]
 
6070         set rowfinal [lrange $rowfinal 0 $r]
 
6071         set rowisopt [lrange $rowisopt 0 $r]
 
6072         set need_redisplay 1
 
6077 proc drawvisible {} {
 
6078     global canv linespc curview vrowmod selectedline targetrow targetid
 
6079     global need_redisplay cscroll numcommits
 
6081     set fs [$canv yview]
 
6082     set ymax [lindex [$canv cget -scrollregion] 3]
 
6083     if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
 
6084     set f0 [lindex $fs 0]
 
6085     set f1 [lindex $fs 1]
 
6086     set y0 [expr {int($f0 * $ymax)}]
 
6087     set y1 [expr {int($f1 * $ymax)}]
 
6089     if {[info exists targetid]} {
 
6090         if {[commitinview $targetid $curview]} {
 
6091             set r [rowofcommit $targetid]
 
6092             if {$r != $targetrow} {
 
6093                 # Fix up the scrollregion and change the scrolling position
 
6094                 # now that our target row has moved.
 
6095                 set diff [expr {($r - $targetrow) * $linespc}]
 
6098                 set ymax [lindex [$canv cget -scrollregion] 3]
 
6101                 set f0 [expr {$y0 / $ymax}]
 
6102                 set f1 [expr {$y1 / $ymax}]
 
6103                 allcanvs yview moveto $f0
 
6104                 $cscroll set $f0 $f1
 
6105                 set need_redisplay 1
 
6112     set row [expr {int(($y0 - 3) / $linespc) - 1}]
 
6113     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
 
6114     if {$endrow >= $vrowmod($curview)} {
 
6115         update_arcrows $curview
 
6117     if {$selectedline ne {} &&
 
6118         $row <= $selectedline && $selectedline <= $endrow} {
 
6119         set targetrow $selectedline
 
6120     } elseif {[info exists targetid]} {
 
6121         set targetrow [expr {int(($row + $endrow) / 2)}]
 
6123     if {[info exists targetrow]} {
 
6124         if {$targetrow >= $numcommits} {
 
6125             set targetrow [expr {$numcommits - 1}]
 
6127         set targetid [commitonrow $targetrow]
 
6129     drawcommits $row $endrow
 
6132 proc clear_display {} {
 
6133     global iddrawn linesegs need_redisplay nrows_drawn
 
6134     global vhighlights fhighlights nhighlights rhighlights
 
6135     global linehtag linentag linedtag boldids boldnameids
 
6138     catch {unset iddrawn}
 
6139     catch {unset linesegs}
 
6140     catch {unset linehtag}
 
6141     catch {unset linentag}
 
6142     catch {unset linedtag}
 
6145     catch {unset vhighlights}
 
6146     catch {unset fhighlights}
 
6147     catch {unset nhighlights}
 
6148     catch {unset rhighlights}
 
6149     set need_redisplay 0
 
6153 proc findcrossings {id} {
 
6154     global rowidlist parentlist numcommits displayorder
 
6158     foreach {s e} [rowranges $id] {
 
6159         if {$e >= $numcommits} {
 
6160             set e [expr {$numcommits - 1}]
 
6162         if {$e <= $s} continue
 
6163         for {set row $e} {[incr row -1] >= $s} {} {
 
6164             set x [lsearch -exact [lindex $rowidlist $row] $id]
 
6166             set olds [lindex $parentlist $row]
 
6167             set kid [lindex $displayorder $row]
 
6168             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
 
6169             if {$kidx < 0} continue
 
6170             set nextrow [lindex $rowidlist [expr {$row + 1}]]
 
6172                 set px [lsearch -exact $nextrow $p]
 
6173                 if {$px < 0} continue
 
6174                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
 
6175                     if {[lsearch -exact $ccross $p] >= 0} continue
 
6176                     if {$x == $px + ($kidx < $px? -1: 1)} {
 
6178                     } elseif {[lsearch -exact $cross $p] < 0} {
 
6185     return [concat $ccross {{}} $cross]
 
6188 proc assigncolor {id} {
 
6189     global colormap colors nextcolor
 
6190     global parents children children curview
 
6192     if {[info exists colormap($id)]} return
 
6193     set ncolors [llength $colors]
 
6194     if {[info exists children($curview,$id)]} {
 
6195         set kids $children($curview,$id)
 
6199     if {[llength $kids] == 1} {
 
6200         set child [lindex $kids 0]
 
6201         if {[info exists colormap($child)]
 
6202             && [llength $parents($curview,$child)] == 1} {
 
6203             set colormap($id) $colormap($child)
 
6209     foreach x [findcrossings $id] {
 
6211             # delimiter between corner crossings and other crossings
 
6212             if {[llength $badcolors] >= $ncolors - 1} break
 
6213             set origbad $badcolors
 
6215         if {[info exists colormap($x)]
 
6216             && [lsearch -exact $badcolors $colormap($x)] < 0} {
 
6217             lappend badcolors $colormap($x)
 
6220     if {[llength $badcolors] >= $ncolors} {
 
6221         set badcolors $origbad
 
6223     set origbad $badcolors
 
6224     if {[llength $badcolors] < $ncolors - 1} {
 
6225         foreach child $kids {
 
6226             if {[info exists colormap($child)]
 
6227                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
 
6228                 lappend badcolors $colormap($child)
 
6230             foreach p $parents($curview,$child) {
 
6231                 if {[info exists colormap($p)]
 
6232                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
 
6233                     lappend badcolors $colormap($p)
 
6237         if {[llength $badcolors] >= $ncolors} {
 
6238             set badcolors $origbad
 
6241     for {set i 0} {$i <= $ncolors} {incr i} {
 
6242         set c [lindex $colors $nextcolor]
 
6243         if {[incr nextcolor] >= $ncolors} {
 
6246         if {[lsearch -exact $badcolors $c]} break
 
6248     set colormap($id) $c
 
6251 proc bindline {t id} {
 
6254     $canv bind $t <Enter> "lineenter %x %y $id"
 
6255     $canv bind $t <Motion> "linemotion %x %y $id"
 
6256     $canv bind $t <Leave> "lineleave $id"
 
6257     $canv bind $t <Button-1> "lineclick %x %y $id 1"
 
6260 proc drawtags {id x xt y1} {
 
6261     global idtags idheads idotherrefs mainhead
 
6262     global linespc lthickness
 
6263     global canv rowtextx curview fgcolor bgcolor ctxbut
 
6268     if {[info exists idtags($id)]} {
 
6269         set marks $idtags($id)
 
6270         set ntags [llength $marks]
 
6272     if {[info exists idheads($id)]} {
 
6273         set marks [concat $marks $idheads($id)]
 
6274         set nheads [llength $idheads($id)]
 
6276     if {[info exists idotherrefs($id)]} {
 
6277         set marks [concat $marks $idotherrefs($id)]
 
6283     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
 
6284     set yt [expr {$y1 - 0.5 * $linespc}]
 
6285     set yb [expr {$yt + $linespc - 1}]
 
6289     foreach tag $marks {
 
6291         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
 
6292             set wid [font measure mainfontbold $tag]
 
6294             set wid [font measure mainfont $tag]
 
6298         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
 
6300     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
 
6301                -width $lthickness -fill black -tags tag.$id]
 
6303     foreach tag $marks x $xvals wid $wvals {
 
6304         set tag_quoted [string map {% %%} $tag]
 
6305         set xl [expr {$x + $delta}]
 
6306         set xr [expr {$x + $delta + $wid + $lthickness}]
 
6308         if {[incr ntags -1] >= 0} {
 
6310             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
 
6311                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
 
6312                        -width 1 -outline black -fill yellow -tags tag.$id]
 
6313             $canv bind $t <1> [list showtag $tag_quoted 1]
 
6314             set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
 
6316             # draw a head or other ref
 
6317             if {[incr nheads -1] >= 0} {
 
6319                 if {$tag eq $mainhead} {
 
6320                     set font mainfontbold
 
6325             set xl [expr {$xl - $delta/2}]
 
6326             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
 
6327                 -width 1 -outline black -fill $col -tags tag.$id
 
6328             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
 
6329                 set rwid [font measure mainfont $remoteprefix]
 
6330                 set xi [expr {$x + 1}]
 
6331                 set yti [expr {$yt + 1}]
 
6332                 set xri [expr {$x + $rwid}]
 
6333                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
 
6334                         -width 0 -fill "#ffddaa" -tags tag.$id
 
6337         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
 
6338                    -font $font -tags [list tag.$id text]]
 
6340             $canv bind $t <1> [list showtag $tag_quoted 1]
 
6341         } elseif {$nheads >= 0} {
 
6342             $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
 
6348 proc xcoord {i level ln} {
 
6349     global canvx0 xspc1 xspc2
 
6351     set x [expr {$canvx0 + $i * $xspc1($ln)}]
 
6352     if {$i > 0 && $i == $level} {
 
6353         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
 
6354     } elseif {$i > $level} {
 
6355         set x [expr {$x + $xspc2 - $xspc1($ln)}]
 
6360 proc show_status {msg} {
 
6364     $canv create text 3 3 -anchor nw -text $msg -font mainfont \
 
6365         -tags text -fill $fgcolor
 
6368 # Don't change the text pane cursor if it is currently the hand cursor,
 
6369 # showing that we are over a sha1 ID link.
 
6370 proc settextcursor {c} {
 
6371     global ctext curtextcursor
 
6373     if {[$ctext cget -cursor] == $curtextcursor} {
 
6374         $ctext config -cursor $c
 
6376     set curtextcursor $c
 
6379 proc nowbusy {what {name {}}} {
 
6380     global isbusy busyname statusw
 
6382     if {[array names isbusy] eq {}} {
 
6383         . config -cursor watch
 
6387     set busyname($what) $name
 
6389         $statusw conf -text $name
 
6393 proc notbusy {what} {
 
6394     global isbusy maincursor textcursor busyname statusw
 
6398         if {$busyname($what) ne {} &&
 
6399             [$statusw cget -text] eq $busyname($what)} {
 
6400             $statusw conf -text {}
 
6403     if {[array names isbusy] eq {}} {
 
6404         . config -cursor $maincursor
 
6405         settextcursor $textcursor
 
6409 proc findmatches {f} {
 
6410     global findtype findstring
 
6411     if {$findtype == [mc "Regexp"]} {
 
6412         set matches [regexp -indices -all -inline $findstring $f]
 
6415         if {$findtype == [mc "IgnCase"]} {
 
6416             set f [string tolower $f]
 
6417             set fs [string tolower $fs]
 
6421         set l [string length $fs]
 
6422         while {[set j [string first $fs $f $i]] >= 0} {
 
6423             lappend matches [list $j [expr {$j+$l-1}]]
 
6424             set i [expr {$j + $l}]
 
6430 proc dofind {{dirn 1} {wrap 1}} {
 
6431     global findstring findstartline findcurline selectedline numcommits
 
6432     global gdttype filehighlight fh_serial find_dirn findallowwrap
 
6434     if {[info exists find_dirn]} {
 
6435         if {$find_dirn == $dirn} return
 
6439     if {$findstring eq {} || $numcommits == 0} return
 
6440     if {$selectedline eq {}} {
 
6441         set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
 
6443         set findstartline $selectedline
 
6445     set findcurline $findstartline
 
6446     nowbusy finding [mc "Searching"]
 
6447     if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
 
6448         after cancel do_file_hl $fh_serial
 
6449         do_file_hl $fh_serial
 
6452     set findallowwrap $wrap
 
6456 proc stopfinding {} {
 
6457     global find_dirn findcurline fprogcoord
 
6459     if {[info exists find_dirn]} {
 
6470     global commitdata commitinfo numcommits findpattern findloc
 
6471     global findstartline findcurline findallowwrap
 
6472     global find_dirn gdttype fhighlights fprogcoord
 
6473     global curview varcorder vrownum varccommits vrowmod
 
6475     if {![info exists find_dirn]} {
 
6478     set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
 
6481     if {$find_dirn > 0} {
 
6483         if {$l >= $numcommits} {
 
6486         if {$l <= $findstartline} {
 
6487             set lim [expr {$findstartline + 1}]
 
6490             set moretodo $findallowwrap
 
6497         if {$l >= $findstartline} {
 
6498             set lim [expr {$findstartline - 1}]
 
6501             set moretodo $findallowwrap
 
6504     set n [expr {($lim - $l) * $find_dirn}]
 
6509     if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
 
6510         update_arcrows $curview
 
6514     set ai [bsearch $vrownum($curview) $l]
 
6515     set a [lindex $varcorder($curview) $ai]
 
6516     set arow [lindex $vrownum($curview) $ai]
 
6517     set ids [lindex $varccommits($curview,$a)]
 
6518     set arowend [expr {$arow + [llength $ids]}]
 
6519     if {$gdttype eq [mc "containing:"]} {
 
6520         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
 
6521             if {$l < $arow || $l >= $arowend} {
 
6523                 set a [lindex $varcorder($curview) $ai]
 
6524                 set arow [lindex $vrownum($curview) $ai]
 
6525                 set ids [lindex $varccommits($curview,$a)]
 
6526                 set arowend [expr {$arow + [llength $ids]}]
 
6528             set id [lindex $ids [expr {$l - $arow}]]
 
6529             # shouldn't happen unless git log doesn't give all the commits...
 
6530             if {![info exists commitdata($id)] ||
 
6531                 ![doesmatch $commitdata($id)]} {
 
6534             if {![info exists commitinfo($id)]} {
 
6537             set info $commitinfo($id)
 
6538             foreach f $info ty $fldtypes {
 
6539                 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
 
6548         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
 
6549             if {$l < $arow || $l >= $arowend} {
 
6551                 set a [lindex $varcorder($curview) $ai]
 
6552                 set arow [lindex $vrownum($curview) $ai]
 
6553                 set ids [lindex $varccommits($curview,$a)]
 
6554                 set arowend [expr {$arow + [llength $ids]}]
 
6556             set id [lindex $ids [expr {$l - $arow}]]
 
6557             if {![info exists fhighlights($id)]} {
 
6558                 # this sets fhighlights($id) to -1
 
6559                 askfilehighlight $l $id
 
6561             if {$fhighlights($id) > 0} {
 
6565             if {$fhighlights($id) < 0} {
 
6568                     set findcurline [expr {$l - $find_dirn}]
 
6573     if {$found || ($domore && !$moretodo)} {
 
6589         set findcurline [expr {$l - $find_dirn}]
 
6591     set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
 
6595     set fprogcoord [expr {$n * 1.0 / $numcommits}]
 
6600 proc findselectline {l} {
 
6601     global findloc commentend ctext findcurline markingmatches gdttype
 
6603     set markingmatches [expr {$gdttype eq [mc "containing:"]}]
 
6606     if {$markingmatches &&
 
6607         ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
 
6608         # highlight the matches in the comments
 
6609         set f [$ctext get 1.0 $commentend]
 
6610         set matches [findmatches $f]
 
6611         foreach match $matches {
 
6612             set start [lindex $match 0]
 
6613             set end [expr {[lindex $match 1] + 1}]
 
6614             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
 
6620 # mark the bits of a headline or author that match a find string
 
6621 proc markmatches {canv l str tag matches font row} {
 
6624     set bbox [$canv bbox $tag]
 
6625     set x0 [lindex $bbox 0]
 
6626     set y0 [lindex $bbox 1]
 
6627     set y1 [lindex $bbox 3]
 
6628     foreach match $matches {
 
6629         set start [lindex $match 0]
 
6630         set end [lindex $match 1]
 
6631         if {$start > $end} continue
 
6632         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
 
6633         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
 
6634         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
 
6635                    [expr {$x0+$xlen+2}] $y1 \
 
6636                    -outline {} -tags [list match$l matches] -fill yellow]
 
6638         if {$row == $selectedline} {
 
6639             $canv raise $t secsel
 
6644 proc unmarkmatches {} {
 
6645     global markingmatches
 
6647     allcanvs delete matches
 
6648     set markingmatches 0
 
6652 proc selcanvline {w x y} {
 
6653     global canv canvy0 ctext linespc
 
6655     set ymax [lindex [$canv cget -scrollregion] 3]
 
6656     if {$ymax == {}} return
 
6657     set yfrac [lindex [$canv yview] 0]
 
6658     set y [expr {$y + $yfrac * $ymax}]
 
6659     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
 
6664         set xmax [lindex [$canv cget -scrollregion] 2]
 
6665         set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
 
6666         if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
 
6672 proc commit_descriptor {p} {
 
6674     if {![info exists commitinfo($p)]} {
 
6678     if {[llength $commitinfo($p)] > 1} {
 
6679         set l [lindex $commitinfo($p) 0]
 
6684 # append some text to the ctext widget, and make any SHA1 ID
 
6685 # that we know about be a clickable link.
 
6686 proc appendwithlinks {text tags} {
 
6687     global ctext linknum curview
 
6689     set start [$ctext index "end - 1c"]
 
6690     $ctext insert end $text $tags
 
6691     set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
 
6695         set linkid [string range $text $s $e]
 
6697         $ctext tag delete link$linknum
 
6698         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
 
6699         setlink $linkid link$linknum
 
6704 proc setlink {id lk} {
 
6705     global curview ctext pendinglinks
 
6708     if {[string length $id] < 40} {
 
6709         set matches [longid $id]
 
6710         if {[llength $matches] > 0} {
 
6711             if {[llength $matches] > 1} return
 
6713             set id [lindex $matches 0]
 
6716         set known [commitinview $id $curview]
 
6719         $ctext tag conf $lk -foreground blue -underline 1
 
6720         $ctext tag bind $lk <1> [list selbyid $id]
 
6721         $ctext tag bind $lk <Enter> {linkcursor %W 1}
 
6722         $ctext tag bind $lk <Leave> {linkcursor %W -1}
 
6724         lappend pendinglinks($id) $lk
 
6725         interestedin $id {makelink %P}
 
6729 proc appendshortlink {id {pre {}} {post {}}} {
 
6730     global ctext linknum
 
6732     $ctext insert end $pre
 
6733     $ctext tag delete link$linknum
 
6734     $ctext insert end [string range $id 0 7] link$linknum
 
6735     $ctext insert end $post
 
6736     setlink $id link$linknum
 
6740 proc makelink {id} {
 
6743     if {![info exists pendinglinks($id)]} return
 
6744     foreach lk $pendinglinks($id) {
 
6747     unset pendinglinks($id)
 
6750 proc linkcursor {w inc} {
 
6751     global linkentercount curtextcursor
 
6753     if {[incr linkentercount $inc] > 0} {
 
6754         $w configure -cursor hand2
 
6756         $w configure -cursor $curtextcursor
 
6757         if {$linkentercount < 0} {
 
6758             set linkentercount 0
 
6763 proc viewnextline {dir} {
 
6767     set ymax [lindex [$canv cget -scrollregion] 3]
 
6768     set wnow [$canv yview]
 
6769     set wtop [expr {[lindex $wnow 0] * $ymax}]
 
6770     set newtop [expr {$wtop + $dir * $linespc}]
 
6773     } elseif {$newtop > $ymax} {
 
6776     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
 
6779 # add a list of tag or branch names at position pos
 
6780 # returns the number of names inserted
 
6781 proc appendrefs {pos ids var} {
 
6782     global ctext linknum curview $var maxrefs
 
6784     if {[catch {$ctext index $pos}]} {
 
6787     $ctext conf -state normal
 
6788     $ctext delete $pos "$pos lineend"
 
6791         foreach tag [set $var\($id\)] {
 
6792             lappend tags [list $tag $id]
 
6795     if {[llength $tags] > $maxrefs} {
 
6796         $ctext insert $pos "[mc "many"] ([llength $tags])"
 
6798         set tags [lsort -index 0 -decreasing $tags]
 
6801             set id [lindex $ti 1]
 
6804             $ctext tag delete $lk
 
6805             $ctext insert $pos $sep
 
6806             $ctext insert $pos [lindex $ti 0] $lk
 
6811     $ctext conf -state disabled
 
6812     return [llength $tags]
 
6815 # called when we have finished computing the nearby tags
 
6816 proc dispneartags {delay} {
 
6817     global selectedline currentid showneartags tagphase
 
6819     if {$selectedline eq {} || !$showneartags} return
 
6820     after cancel dispnexttag
 
6822         after 200 dispnexttag
 
6825         after idle dispnexttag
 
6830 proc dispnexttag {} {
 
6831     global selectedline currentid showneartags tagphase ctext
 
6833     if {$selectedline eq {} || !$showneartags} return
 
6834     switch -- $tagphase {
 
6836             set dtags [desctags $currentid]
 
6838                 appendrefs precedes $dtags idtags
 
6842             set atags [anctags $currentid]
 
6844                 appendrefs follows $atags idtags
 
6848             set dheads [descheads $currentid]
 
6849             if {$dheads ne {}} {
 
6850                 if {[appendrefs branch $dheads idheads] > 1
 
6851                     && [$ctext get "branch -3c"] eq "h"} {
 
6852                     # turn "Branch" into "Branches"
 
6853                     $ctext conf -state normal
 
6854                     $ctext insert "branch -2c" "es"
 
6855                     $ctext conf -state disabled
 
6860     if {[incr tagphase] <= 2} {
 
6861         after idle dispnexttag
 
6865 proc make_secsel {id} {
 
6866     global linehtag linentag linedtag canv canv2 canv3
 
6868     if {![info exists linehtag($id)]} return
 
6870     set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
 
6871                -tags secsel -fill [$canv cget -selectbackground]]
 
6873     $canv2 delete secsel
 
6874     set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
 
6875                -tags secsel -fill [$canv2 cget -selectbackground]]
 
6877     $canv3 delete secsel
 
6878     set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
 
6879                -tags secsel -fill [$canv3 cget -selectbackground]]
 
6883 proc make_idmark {id} {
 
6884     global linehtag canv fgcolor
 
6886     if {![info exists linehtag($id)]} return
 
6888     set t [eval $canv create rect [$canv bbox $linehtag($id)] \
 
6889                -tags markid -outline $fgcolor]
 
6893 proc selectline {l isnew {desired_loc {}}} {
 
6894     global canv ctext commitinfo selectedline
 
6895     global canvy0 linespc parents children curview
 
6896     global currentid sha1entry
 
6897     global commentend idtags linknum
 
6898     global mergemax numcommits pending_select
 
6899     global cmitmode showneartags allcommits
 
6900     global targetrow targetid lastscrollrows
 
6901     global autoselect autosellen jump_to_here
 
6903     catch {unset pending_select}
 
6908     if {$l < 0 || $l >= $numcommits} return
 
6909     set id [commitonrow $l]
 
6914     if {$lastscrollrows < $numcommits} {
 
6918     set y [expr {$canvy0 + $l * $linespc}]
 
6919     set ymax [lindex [$canv cget -scrollregion] 3]
 
6920     set ytop [expr {$y - $linespc - 1}]
 
6921     set ybot [expr {$y + $linespc + 1}]
 
6922     set wnow [$canv yview]
 
6923     set wtop [expr {[lindex $wnow 0] * $ymax}]
 
6924     set wbot [expr {[lindex $wnow 1] * $ymax}]
 
6925     set wh [expr {$wbot - $wtop}]
 
6927     if {$ytop < $wtop} {
 
6928         if {$ybot < $wtop} {
 
6929             set newtop [expr {$y - $wh / 2.0}]
 
6932             if {$newtop > $wtop - $linespc} {
 
6933                 set newtop [expr {$wtop - $linespc}]
 
6936     } elseif {$ybot > $wbot} {
 
6937         if {$ytop > $wbot} {
 
6938             set newtop [expr {$y - $wh / 2.0}]
 
6940             set newtop [expr {$ybot - $wh}]
 
6941             if {$newtop < $wtop + $linespc} {
 
6942                 set newtop [expr {$wtop + $linespc}]
 
6946     if {$newtop != $wtop} {
 
6950         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
 
6957         addtohistory [list selbyid $id 0] savecmitpos
 
6960     $sha1entry delete 0 end
 
6961     $sha1entry insert 0 $id
 
6963         $sha1entry selection range 0 $autosellen
 
6967     $ctext conf -state normal
 
6970     if {![info exists commitinfo($id)]} {
 
6973     set info $commitinfo($id)
 
6974     set date [formatdate [lindex $info 2]]
 
6975     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
 
6976     set date [formatdate [lindex $info 4]]
 
6977     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
 
6978     if {[info exists idtags($id)]} {
 
6979         $ctext insert end [mc "Tags:"]
 
6980         foreach tag $idtags($id) {
 
6981             $ctext insert end " $tag"
 
6983         $ctext insert end "\n"
 
6987     set olds $parents($curview,$id)
 
6988     if {[llength $olds] > 1} {
 
6991             if {$np >= $mergemax} {
 
6996             $ctext insert end "[mc "Parent"]: " $tag
 
6997             appendwithlinks [commit_descriptor $p] {}
 
7002             append headers "[mc "Parent"]: [commit_descriptor $p]"
 
7006     foreach c $children($curview,$id) {
 
7007         append headers "[mc "Child"]:  [commit_descriptor $c]"
 
7010     # make anything that looks like a SHA1 ID be a clickable link
 
7011     appendwithlinks $headers {}
 
7012     if {$showneartags} {
 
7013         if {![info exists allcommits]} {
 
7016         $ctext insert end "[mc "Branch"]: "
 
7017         $ctext mark set branch "end -1c"
 
7018         $ctext mark gravity branch left
 
7019         $ctext insert end "\n[mc "Follows"]: "
 
7020         $ctext mark set follows "end -1c"
 
7021         $ctext mark gravity follows left
 
7022         $ctext insert end "\n[mc "Precedes"]: "
 
7023         $ctext mark set precedes "end -1c"
 
7024         $ctext mark gravity precedes left
 
7025         $ctext insert end "\n"
 
7028     $ctext insert end "\n"
 
7029     set comment [lindex $info 5]
 
7030     if {[string first "\r" $comment] >= 0} {
 
7031         set comment [string map {"\r" "\n    "} $comment]
 
7033     appendwithlinks $comment {comment}
 
7035     $ctext tag remove found 1.0 end
 
7036     $ctext conf -state disabled
 
7037     set commentend [$ctext index "end - 1c"]
 
7039     set jump_to_here $desired_loc
 
7040     init_flist [mc "Comments"]
 
7041     if {$cmitmode eq "tree"} {
 
7043     } elseif {[llength $olds] <= 1} {
 
7050 proc selfirstline {} {
 
7055 proc sellastline {} {
 
7058     set l [expr {$numcommits - 1}]
 
7062 proc selnextline {dir} {
 
7065     if {$selectedline eq {}} return
 
7066     set l [expr {$selectedline + $dir}]
 
7071 proc selnextpage {dir} {
 
7072     global canv linespc selectedline numcommits
 
7074     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
 
7078     allcanvs yview scroll [expr {$dir * $lpp}] units
 
7080     if {$selectedline eq {}} return
 
7081     set l [expr {$selectedline + $dir * $lpp}]
 
7084     } elseif {$l >= $numcommits} {
 
7085         set l [expr $numcommits - 1]
 
7091 proc unselectline {} {
 
7092     global selectedline currentid
 
7095     catch {unset currentid}
 
7096     allcanvs delete secsel
 
7100 proc reselectline {} {
 
7103     if {$selectedline ne {}} {
 
7104         selectline $selectedline 0
 
7108 proc addtohistory {cmd {saveproc {}}} {
 
7109     global history historyindex curview
 
7113     set elt [list $curview $cmd $saveproc {}]
 
7114     if {$historyindex > 0
 
7115         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
 
7119     if {$historyindex < [llength $history]} {
 
7120         set history [lreplace $history $historyindex end $elt]
 
7122         lappend history $elt
 
7125     if {$historyindex > 1} {
 
7126         .tf.bar.leftbut conf -state normal
 
7128         .tf.bar.leftbut conf -state disabled
 
7130     .tf.bar.rightbut conf -state disabled
 
7133 # save the scrolling position of the diff display pane
 
7134 proc save_position {} {
 
7135     global historyindex history
 
7137     if {$historyindex < 1} return
 
7138     set hi [expr {$historyindex - 1}]
 
7139     set fn [lindex $history $hi 2]
 
7141         lset history $hi 3 [eval $fn]
 
7145 proc unset_posvars {} {
 
7148     if {[info exists last_posvars]} {
 
7149         foreach {var val} $last_posvars {
 
7158     global curview last_posvars
 
7160     set view [lindex $elt 0]
 
7161     set cmd [lindex $elt 1]
 
7162     set pv [lindex $elt 3]
 
7163     if {$curview != $view} {
 
7167     foreach {var val} $pv {
 
7171     set last_posvars $pv
 
7176     global history historyindex
 
7179     if {$historyindex > 1} {
 
7181         incr historyindex -1
 
7182         godo [lindex $history [expr {$historyindex - 1}]]
 
7183         .tf.bar.rightbut conf -state normal
 
7185     if {$historyindex <= 1} {
 
7186         .tf.bar.leftbut conf -state disabled
 
7191     global history historyindex
 
7194     if {$historyindex < [llength $history]} {
 
7196         set cmd [lindex $history $historyindex]
 
7199         .tf.bar.leftbut conf -state normal
 
7201     if {$historyindex >= [llength $history]} {
 
7202         .tf.bar.rightbut conf -state disabled
 
7207     global treefilelist treeidlist diffids diffmergeid treepending
 
7208     global nullid nullid2
 
7211     catch {unset diffmergeid}
 
7212     if {![info exists treefilelist($id)]} {
 
7213         if {![info exists treepending]} {
 
7214             if {$id eq $nullid} {
 
7215                 set cmd [list | git ls-files]
 
7216             } elseif {$id eq $nullid2} {
 
7217                 set cmd [list | git ls-files --stage -t]
 
7219                 set cmd [list | git ls-tree -r $id]
 
7221             if {[catch {set gtf [open $cmd r]}]} {
 
7225             set treefilelist($id) {}
 
7226             set treeidlist($id) {}
 
7227             fconfigure $gtf -blocking 0 -encoding binary
 
7228             filerun $gtf [list gettreeline $gtf $id]
 
7235 proc gettreeline {gtf id} {
 
7236     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
 
7239     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
 
7240         if {$diffids eq $nullid} {
 
7243             set i [string first "\t" $line]
 
7244             if {$i < 0} continue
 
7245             set fname [string range $line [expr {$i+1}] end]
 
7246             set line [string range $line 0 [expr {$i-1}]]
 
7247             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
 
7248             set sha1 [lindex $line 2]
 
7249             lappend treeidlist($id) $sha1
 
7251         if {[string index $fname 0] eq "\""} {
 
7252             set fname [lindex $fname 0]
 
7254         set fname [encoding convertfrom $fname]
 
7255         lappend treefilelist($id) $fname
 
7258         return [expr {$nl >= 1000? 2: 1}]
 
7262     if {$cmitmode ne "tree"} {
 
7263         if {![info exists diffmergeid]} {
 
7264             gettreediffs $diffids
 
7266     } elseif {$id ne $diffids} {
 
7275     global treefilelist treeidlist diffids nullid nullid2
 
7276     global ctext_file_names ctext_file_lines
 
7277     global ctext commentend
 
7279     set i [lsearch -exact $treefilelist($diffids) $f]
 
7281         puts "oops, $f not in list for id $diffids"
 
7284     if {$diffids eq $nullid} {
 
7285         if {[catch {set bf [open $f r]} err]} {
 
7286             puts "oops, can't read $f: $err"
 
7290         set blob [lindex $treeidlist($diffids) $i]
 
7291         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
 
7292             puts "oops, error reading blob $blob: $err"
 
7296     fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
 
7297     filerun $bf [list getblobline $bf $diffids]
 
7298     $ctext config -state normal
 
7299     clear_ctext $commentend
 
7300     lappend ctext_file_names $f
 
7301     lappend ctext_file_lines [lindex [split $commentend "."] 0]
 
7302     $ctext insert end "\n"
 
7303     $ctext insert end "$f\n" filesep
 
7304     $ctext config -state disabled
 
7305     $ctext yview $commentend
 
7309 proc getblobline {bf id} {
 
7310     global diffids cmitmode ctext
 
7312     if {$id ne $diffids || $cmitmode ne "tree"} {
 
7316     $ctext config -state normal
 
7318     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
 
7319         $ctext insert end "$line\n"
 
7322         global jump_to_here ctext_file_names commentend
 
7324         # delete last newline
 
7325         $ctext delete "end - 2c" "end - 1c"
 
7327         if {$jump_to_here ne {} &&
 
7328             [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
 
7329             set lnum [expr {[lindex $jump_to_here 1] +
 
7330                             [lindex [split $commentend .] 0]}]
 
7331             mark_ctext_line $lnum
 
7333         $ctext config -state disabled
 
7336     $ctext config -state disabled
 
7337     return [expr {$nl >= 1000? 2: 1}]
 
7340 proc mark_ctext_line {lnum} {
 
7341     global ctext markbgcolor
 
7343     $ctext tag delete omark
 
7344     $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
 
7345     $ctext tag conf omark -background $markbgcolor
 
7349 proc mergediff {id} {
 
7351     global diffids treediffs
 
7352     global parents curview
 
7356     set treediffs($id) {}
 
7357     set np [llength $parents($curview,$id)]
 
7362 proc startdiff {ids} {
 
7363     global treediffs diffids treepending diffmergeid nullid nullid2
 
7367     catch {unset diffmergeid}
 
7368     if {![info exists treediffs($ids)] ||
 
7369         [lsearch -exact $ids $nullid] >= 0 ||
 
7370         [lsearch -exact $ids $nullid2] >= 0} {
 
7371         if {![info exists treepending]} {
 
7379 proc path_filter {filter name} {
 
7381         set l [string length $p]
 
7382         if {[string index $p end] eq "/"} {
 
7383             if {[string compare -length $l $p $name] == 0} {
 
7387             if {[string compare -length $l $p $name] == 0 &&
 
7388                 ([string length $name] == $l ||
 
7389                  [string index $name $l] eq "/")} {
 
7397 proc addtocflist {ids} {
 
7400     add_flist $treediffs($ids)
 
7404 proc diffcmd {ids flags} {
 
7405     global nullid nullid2
 
7407     set i [lsearch -exact $ids $nullid]
 
7408     set j [lsearch -exact $ids $nullid2]
 
7410         if {[llength $ids] > 1 && $j < 0} {
 
7411             # comparing working directory with some specific revision
 
7412             set cmd [concat | git diff-index $flags]
 
7414                 lappend cmd -R [lindex $ids 1]
 
7416                 lappend cmd [lindex $ids 0]
 
7419             # comparing working directory with index
 
7420             set cmd [concat | git diff-files $flags]
 
7425     } elseif {$j >= 0} {
 
7426         set cmd [concat | git diff-index --cached $flags]
 
7427         if {[llength $ids] > 1} {
 
7428             # comparing index with specific revision
 
7430                 lappend cmd -R [lindex $ids 1]
 
7432                 lappend cmd [lindex $ids 0]
 
7435             # comparing index with HEAD
 
7439         set cmd [concat | git diff-tree -r $flags $ids]
 
7444 proc gettreediffs {ids} {
 
7445     global treediff treepending
 
7447     if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
 
7449     set treepending $ids
 
7451     fconfigure $gdtf -blocking 0 -encoding binary
 
7452     filerun $gdtf [list gettreediffline $gdtf $ids]
 
7455 proc gettreediffline {gdtf ids} {
 
7456     global treediff treediffs treepending diffids diffmergeid
 
7457     global cmitmode vfilelimit curview limitdiffs perfile_attrs
 
7462     if {$perfile_attrs} {
 
7463         # cache_gitattr is slow, and even slower on win32 where we
 
7464         # have to invoke it for only about 30 paths at a time
 
7466         if {[tk windowingsystem] == "win32"} {
 
7470     while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
 
7471         set i [string first "\t" $line]
 
7473             set file [string range $line [expr {$i+1}] end]
 
7474             if {[string index $file 0] eq "\""} {
 
7475                 set file [lindex $file 0]
 
7477             set file [encoding convertfrom $file]
 
7478             if {$file ne [lindex $treediff end]} {
 
7479                 lappend treediff $file
 
7480                 lappend sublist $file
 
7484     if {$perfile_attrs} {
 
7485         cache_gitattr encoding $sublist
 
7488         return [expr {$nr >= $max? 2: 1}]
 
7491     if {$limitdiffs && $vfilelimit($curview) ne {}} {
 
7493         foreach f $treediff {
 
7494             if {[path_filter $vfilelimit($curview) $f]} {
 
7498         set treediffs($ids) $flist
 
7500         set treediffs($ids) $treediff
 
7503     if {$cmitmode eq "tree" && [llength $diffids] == 1} {
 
7505     } elseif {$ids != $diffids} {
 
7506         if {![info exists diffmergeid]} {
 
7507             gettreediffs $diffids
 
7515 # empty string or positive integer
 
7516 proc diffcontextvalidate {v} {
 
7517     return [regexp {^(|[1-9][0-9]*)$} $v]
 
7520 proc diffcontextchange {n1 n2 op} {
 
7521     global diffcontextstring diffcontext
 
7523     if {[string is integer -strict $diffcontextstring]} {
 
7524         if {$diffcontextstring >= 0} {
 
7525             set diffcontext $diffcontextstring
 
7531 proc changeignorespace {} {
 
7535 proc changeworddiff {name ix op} {
 
7539 proc getblobdiffs {ids} {
 
7540     global blobdifffd diffids env
 
7541     global diffinhdr treediffs
 
7545     global limitdiffs vfilelimit curview
 
7546     global diffencoding targetline diffnparents
 
7547     global git_version currdiffsubmod
 
7550     if {[package vcompare $git_version "1.6.1"] >= 0} {
 
7551         set textconv "--textconv"
 
7554     if {[package vcompare $git_version "1.6.6"] >= 0} {
 
7555         set submodule "--submodule"
 
7557     set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
 
7561     if {$worddiff ne [mc "Line diff"]} {
 
7562         append cmd " --word-diff=porcelain"
 
7564     if {$limitdiffs && $vfilelimit($curview) ne {}} {
 
7565         set cmd [concat $cmd -- $vfilelimit($curview)]
 
7567     if {[catch {set bdf [open $cmd r]} err]} {
 
7568         error_popup [mc "Error getting diffs: %s" $err]
 
7574     set diffencoding [get_path_encoding {}]
 
7575     fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
 
7576     set blobdifffd($ids) $bdf
 
7577     set currdiffsubmod ""
 
7578     filerun $bdf [list getblobdiffline $bdf $diffids]
 
7581 proc savecmitpos {} {
 
7582     global ctext cmitmode
 
7584     if {$cmitmode eq "tree"} {
 
7587     return [list target_scrollpos [$ctext index @0,0]]
 
7590 proc savectextpos {} {
 
7593     return [list target_scrollpos [$ctext index @0,0]]
 
7596 proc maybe_scroll_ctext {ateof} {
 
7597     global ctext target_scrollpos
 
7599     if {![info exists target_scrollpos]} return
 
7601         set nlines [expr {[winfo height $ctext]
 
7602                           / [font metrics textfont -linespace]}]
 
7603         if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
 
7605     $ctext yview $target_scrollpos
 
7606     unset target_scrollpos
 
7609 proc setinlist {var i val} {
 
7612     while {[llength [set $var]] < $i} {
 
7615     if {[llength [set $var]] == $i} {
 
7622 proc makediffhdr {fname ids} {
 
7623     global ctext curdiffstart treediffs diffencoding
 
7624     global ctext_file_names jump_to_here targetline diffline
 
7626     set fname [encoding convertfrom $fname]
 
7627     set diffencoding [get_path_encoding $fname]
 
7628     set i [lsearch -exact $treediffs($ids) $fname]
 
7630         setinlist difffilestart $i $curdiffstart
 
7632     lset ctext_file_names end $fname
 
7633     set l [expr {(78 - [string length $fname]) / 2}]
 
7634     set pad [string range "----------------------------------------" 1 $l]
 
7635     $ctext insert $curdiffstart "$pad $fname $pad" filesep
 
7637     if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
 
7638         set targetline [lindex $jump_to_here 1]
 
7643 proc getblobdiffline {bdf ids} {
 
7644     global diffids blobdifffd ctext curdiffstart
 
7645     global diffnexthead diffnextnote difffilestart
 
7646     global ctext_file_names ctext_file_lines
 
7647     global diffinhdr treediffs mergemax diffnparents
 
7648     global diffencoding jump_to_here targetline diffline currdiffsubmod
 
7652     $ctext conf -state normal
 
7653     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
 
7654         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
 
7658         if {![string compare -length 5 "diff " $line]} {
 
7659             if {![regexp {^diff (--cc|--git) } $line m type]} {
 
7660                 set line [encoding convertfrom $line]
 
7661                 $ctext insert end "$line\n" hunksep
 
7664             # start of a new file
 
7666             $ctext insert end "\n"
 
7667             set curdiffstart [$ctext index "end - 1c"]
 
7668             lappend ctext_file_names ""
 
7669             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
 
7670             $ctext insert end "\n" filesep
 
7672             if {$type eq "--cc"} {
 
7673                 # start of a new file in a merge diff
 
7674                 set fname [string range $line 10 end]
 
7675                 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
 
7676                     lappend treediffs($ids) $fname
 
7677                     add_flist [list $fname]
 
7681                 set line [string range $line 11 end]
 
7682                 # If the name hasn't changed the length will be odd,
 
7683                 # the middle char will be a space, and the two bits either
 
7684                 # side will be a/name and b/name, or "a/name" and "b/name".
 
7685                 # If the name has changed we'll get "rename from" and
 
7686                 # "rename to" or "copy from" and "copy to" lines following
 
7687                 # this, and we'll use them to get the filenames.
 
7688                 # This complexity is necessary because spaces in the
 
7689                 # filename(s) don't get escaped.
 
7690                 set l [string length $line]
 
7691                 set i [expr {$l / 2}]
 
7692                 if {!(($l & 1) && [string index $line $i] eq " " &&
 
7693                       [string range $line 2 [expr {$i - 1}]] eq \
 
7694                           [string range $line [expr {$i + 3}] end])} {
 
7697                 # unescape if quoted and chop off the a/ from the front
 
7698                 if {[string index $line 0] eq "\""} {
 
7699                     set fname [string range [lindex $line 0] 2 end]
 
7701                     set fname [string range $line 2 [expr {$i - 1}]]
 
7704             makediffhdr $fname $ids
 
7706         } elseif {![string compare -length 16 "* Unmerged path " $line]} {
 
7707             set fname [encoding convertfrom [string range $line 16 end]]
 
7708             $ctext insert end "\n"
 
7709             set curdiffstart [$ctext index "end - 1c"]
 
7710             lappend ctext_file_names $fname
 
7711             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
 
7712             $ctext insert end "$line\n" filesep
 
7713             set i [lsearch -exact $treediffs($ids) $fname]
 
7715                 setinlist difffilestart $i $curdiffstart
 
7718         } elseif {![string compare -length 2 "@@" $line]} {
 
7719             regexp {^@@+} $line ats
 
7720             set line [encoding convertfrom $diffencoding $line]
 
7721             $ctext insert end "$line\n" hunksep
 
7722             if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
 
7725             set diffnparents [expr {[string length $ats] - 1}]
 
7728         } elseif {![string compare -length 10 "Submodule " $line]} {
 
7729             # start of a new submodule
 
7730             if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
 
7731                 set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
 
7733                 set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
 
7735             if {$currdiffsubmod != $fname} {
 
7736                 $ctext insert end "\n";     # Add newline after commit message
 
7738             set curdiffstart [$ctext index "end - 1c"]
 
7739             lappend ctext_file_names ""
 
7740             if {$currdiffsubmod != $fname} {
 
7741                 lappend ctext_file_lines $fname
 
7742                 makediffhdr $fname $ids
 
7743                 set currdiffsubmod $fname
 
7744                 $ctext insert end "\n$line\n" filesep
 
7746                 $ctext insert end "$line\n" filesep
 
7748         } elseif {![string compare -length 3 "  >" $line]} {
 
7749             set $currdiffsubmod ""
 
7750             set line [encoding convertfrom $diffencoding $line]
 
7751             $ctext insert end "$line\n" dresult
 
7752         } elseif {![string compare -length 3 "  <" $line]} {
 
7753             set $currdiffsubmod ""
 
7754             set line [encoding convertfrom $diffencoding $line]
 
7755             $ctext insert end "$line\n" d0
 
7756         } elseif {$diffinhdr} {
 
7757             if {![string compare -length 12 "rename from " $line]} {
 
7758                 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
 
7759                 if {[string index $fname 0] eq "\""} {
 
7760                     set fname [lindex $fname 0]
 
7762                 set fname [encoding convertfrom $fname]
 
7763                 set i [lsearch -exact $treediffs($ids) $fname]
 
7765                     setinlist difffilestart $i $curdiffstart
 
7767             } elseif {![string compare -length 10 $line "rename to "] ||
 
7768                       ![string compare -length 8 $line "copy to "]} {
 
7769                 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
 
7770                 if {[string index $fname 0] eq "\""} {
 
7771                     set fname [lindex $fname 0]
 
7773                 makediffhdr $fname $ids
 
7774             } elseif {[string compare -length 3 $line "---"] == 0} {
 
7777             } elseif {[string compare -length 3 $line "+++"] == 0} {
 
7781             $ctext insert end "$line\n" filesep
 
7784             set line [string map {\x1A ^Z} \
 
7785                           [encoding convertfrom $diffencoding $line]]
 
7786             # parse the prefix - one ' ', '-' or '+' for each parent
 
7787             set prefix [string range $line 0 [expr {$diffnparents - 1}]]
 
7788             set tag [expr {$diffnparents > 1? "m": "d"}]
 
7789             set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
 
7790             set words_pre_markup ""
 
7791             set words_post_markup ""
 
7792             if {[string trim $prefix " -+"] eq {}} {
 
7793                 # prefix only has " ", "-" and "+" in it: normal diff line
 
7794                 set num [string first "-" $prefix]
 
7796                     set line [string range $line 1 end]
 
7799                     # removed line, first parent with line is $num
 
7800                     if {$num >= $mergemax} {
 
7803                     if {$dowords && $worddiff eq [mc "Markup words"]} {
 
7804                         $ctext insert end "\[-$line-\]" $tag$num
 
7806                         $ctext insert end "$line" $tag$num
 
7809                         $ctext insert end "\n" $tag$num
 
7813                     if {[string first "+" $prefix] >= 0} {
 
7815                         lappend tags ${tag}result
 
7816                         if {$diffnparents > 1} {
 
7817                             set num [string first " " $prefix]
 
7819                                 if {$num >= $mergemax} {
 
7825                         set words_pre_markup "{+"
 
7826                         set words_post_markup "+}"
 
7828                     if {$targetline ne {}} {
 
7829                         if {$diffline == $targetline} {
 
7830                             set seehere [$ctext index "end - 1 chars"]
 
7836                     if {$dowords && $worddiff eq [mc "Markup words"]} {
 
7837                         $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
 
7839                         $ctext insert end "$line" $tags
 
7842                         $ctext insert end "\n" $tags
 
7845             } elseif {$dowords && $prefix eq "~"} {
 
7846                 $ctext insert end "\n" {}
 
7848                 # "\ No newline at end of file",
 
7849                 # or something else we don't recognize
 
7850                 $ctext insert end "$line\n" hunksep
 
7854     if {[info exists seehere]} {
 
7855         mark_ctext_line [lindex [split $seehere .] 0]
 
7857     maybe_scroll_ctext [eof $bdf]
 
7858     $ctext conf -state disabled
 
7863     return [expr {$nr >= 1000? 2: 1}]
 
7866 proc changediffdisp {} {
 
7867     global ctext diffelide
 
7869     $ctext tag conf d0 -elide [lindex $diffelide 0]
 
7870     $ctext tag conf dresult -elide [lindex $diffelide 1]
 
7873 proc highlightfile {loc cline} {
 
7874     global ctext cflist cflist_top
 
7877     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
 
7878     $cflist tag add highlight $cline.0 "$cline.0 lineend"
 
7879     $cflist see $cline.0
 
7880     set cflist_top $cline
 
7884     global difffilestart ctext cmitmode
 
7886     if {$cmitmode eq "tree"} return
 
7889     set here [$ctext index @0,0]
 
7890     foreach loc $difffilestart {
 
7891         if {[$ctext compare $loc >= $here]} {
 
7892             highlightfile $prev $prevline
 
7898     highlightfile $prev $prevline
 
7902     global difffilestart ctext cmitmode
 
7904     if {$cmitmode eq "tree"} return
 
7905     set here [$ctext index @0,0]
 
7907     foreach loc $difffilestart {
 
7909         if {[$ctext compare $loc > $here]} {
 
7910             highlightfile $loc $line
 
7916 proc clear_ctext {{first 1.0}} {
 
7917     global ctext smarktop smarkbot
 
7918     global ctext_file_names ctext_file_lines
 
7921     set l [lindex [split $first .] 0]
 
7922     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
 
7925     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
 
7928     $ctext delete $first end
 
7929     if {$first eq "1.0"} {
 
7930         catch {unset pendinglinks}
 
7932     set ctext_file_names {}
 
7933     set ctext_file_lines {}
 
7936 proc settabs {{firstab {}}} {
 
7937     global firsttabstop tabstop ctext have_tk85
 
7939     if {$firstab ne {} && $have_tk85} {
 
7940         set firsttabstop $firstab
 
7942     set w [font measure textfont "0"]
 
7943     if {$firsttabstop != 0} {
 
7944         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
 
7945                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
 
7946     } elseif {$have_tk85 || $tabstop != 8} {
 
7947         $ctext conf -tabs [expr {$tabstop * $w}]
 
7949         $ctext conf -tabs {}
 
7953 proc incrsearch {name ix op} {
 
7954     global ctext searchstring searchdirn
 
7956     $ctext tag remove found 1.0 end
 
7957     if {[catch {$ctext index anchor}]} {
 
7958         # no anchor set, use start of selection, or of visible area
 
7959         set sel [$ctext tag ranges sel]
 
7961             $ctext mark set anchor [lindex $sel 0]
 
7962         } elseif {$searchdirn eq "-forwards"} {
 
7963             $ctext mark set anchor @0,0
 
7965             $ctext mark set anchor @0,[winfo height $ctext]
 
7968     if {$searchstring ne {}} {
 
7969         set here [$ctext search $searchdirn -- $searchstring anchor]
 
7978     global sstring ctext searchstring searchdirn
 
7981     $sstring icursor end
 
7982     set searchdirn -forwards
 
7983     if {$searchstring ne {}} {
 
7984         set sel [$ctext tag ranges sel]
 
7986             set start "[lindex $sel 0] + 1c"
 
7987         } elseif {[catch {set start [$ctext index anchor]}]} {
 
7990         set match [$ctext search -count mlen -- $searchstring $start]
 
7991         $ctext tag remove sel 1.0 end
 
7997         set mend "$match + $mlen c"
 
7998         $ctext tag add sel $match $mend
 
7999         $ctext mark unset anchor
 
8003 proc dosearchback {} {
 
8004     global sstring ctext searchstring searchdirn
 
8007     $sstring icursor end
 
8008     set searchdirn -backwards
 
8009     if {$searchstring ne {}} {
 
8010         set sel [$ctext tag ranges sel]
 
8012             set start [lindex $sel 0]
 
8013         } elseif {[catch {set start [$ctext index anchor]}]} {
 
8014             set start @0,[winfo height $ctext]
 
8016         set match [$ctext search -backwards -count ml -- $searchstring $start]
 
8017         $ctext tag remove sel 1.0 end
 
8023         set mend "$match + $ml c"
 
8024         $ctext tag add sel $match $mend
 
8025         $ctext mark unset anchor
 
8029 proc searchmark {first last} {
 
8030     global ctext searchstring
 
8034         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
 
8035         if {$match eq {}} break
 
8036         set mend "$match + $mlen c"
 
8037         $ctext tag add found $match $mend
 
8041 proc searchmarkvisible {doall} {
 
8042     global ctext smarktop smarkbot
 
8044     set topline [lindex [split [$ctext index @0,0] .] 0]
 
8045     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
 
8046     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
 
8047         # no overlap with previous
 
8048         searchmark $topline $botline
 
8049         set smarktop $topline
 
8050         set smarkbot $botline
 
8052         if {$topline < $smarktop} {
 
8053             searchmark $topline [expr {$smarktop-1}]
 
8054             set smarktop $topline
 
8056         if {$botline > $smarkbot} {
 
8057             searchmark [expr {$smarkbot+1}] $botline
 
8058             set smarkbot $botline
 
8063 proc scrolltext {f0 f1} {
 
8066     .bleft.bottom.sb set $f0 $f1
 
8067     if {$searchstring ne {}} {
 
8073     global linespc charspc canvx0 canvy0
 
8074     global xspc1 xspc2 lthickness
 
8076     set linespc [font metrics mainfont -linespace]
 
8077     set charspc [font measure mainfont "m"]
 
8078     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
 
8079     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
 
8080     set lthickness [expr {int($linespc / 9) + 1}]
 
8081     set xspc1(0) $linespc
 
8089     set ymax [lindex [$canv cget -scrollregion] 3]
 
8090     if {$ymax eq {} || $ymax == 0} return
 
8091     set span [$canv yview]
 
8094     allcanvs yview moveto [lindex $span 0]
 
8096     if {$selectedline ne {}} {
 
8097         selectline $selectedline 0
 
8098         allcanvs yview moveto [lindex $span 0]
 
8102 proc parsefont {f n} {
 
8105     set fontattr($f,family) [lindex $n 0]
 
8107     if {$s eq {} || $s == 0} {
 
8110         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
 
8112     set fontattr($f,size) $s
 
8113     set fontattr($f,weight) normal
 
8114     set fontattr($f,slant) roman
 
8115     foreach style [lrange $n 2 end] {
 
8118             "bold"   {set fontattr($f,weight) $style}
 
8120             "italic" {set fontattr($f,slant) $style}
 
8125 proc fontflags {f {isbold 0}} {
 
8128     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
 
8129                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
 
8130                 -slant $fontattr($f,slant)]
 
8136     set n [list $fontattr($f,family) $fontattr($f,size)]
 
8137     if {$fontattr($f,weight) eq "bold"} {
 
8140     if {$fontattr($f,slant) eq "italic"} {
 
8146 proc incrfont {inc} {
 
8147     global mainfont textfont ctext canv cflist showrefstop
 
8148     global stopped entries fontattr
 
8151     set s $fontattr(mainfont,size)
 
8156     set fontattr(mainfont,size) $s
 
8157     font config mainfont -size $s
 
8158     font config mainfontbold -size $s
 
8159     set mainfont [fontname mainfont]
 
8160     set s $fontattr(textfont,size)
 
8165     set fontattr(textfont,size) $s
 
8166     font config textfont -size $s
 
8167     font config textfontbold -size $s
 
8168     set textfont [fontname textfont]
 
8175     global sha1entry sha1string
 
8176     if {[string length $sha1string] == 40} {
 
8177         $sha1entry delete 0 end
 
8181 proc sha1change {n1 n2 op} {
 
8182     global sha1string currentid sha1but
 
8183     if {$sha1string == {}
 
8184         || ([info exists currentid] && $sha1string == $currentid)} {
 
8189     if {[$sha1but cget -state] == $state} return
 
8190     if {$state == "normal"} {
 
8191         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
 
8193         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
 
8197 proc gotocommit {} {
 
8198     global sha1string tagids headids curview varcid
 
8200     if {$sha1string == {}
 
8201         || ([info exists currentid] && $sha1string == $currentid)} return
 
8202     if {[info exists tagids($sha1string)]} {
 
8203         set id $tagids($sha1string)
 
8204     } elseif {[info exists headids($sha1string)]} {
 
8205         set id $headids($sha1string)
 
8207         set id [string tolower $sha1string]
 
8208         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
 
8209             set matches [longid $id]
 
8210             if {$matches ne {}} {
 
8211                 if {[llength $matches] > 1} {
 
8212                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
 
8215                 set id [lindex $matches 0]
 
8218             if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
 
8219                 error_popup [mc "Revision %s is not known" $sha1string]
 
8224     if {[commitinview $id $curview]} {
 
8225         selectline [rowofcommit $id] 1
 
8228     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
 
8229         set msg [mc "SHA1 id %s is not known" $sha1string]
 
8231         set msg [mc "Revision %s is not in the current view" $sha1string]
 
8236 proc lineenter {x y id} {
 
8237     global hoverx hovery hoverid hovertimer
 
8238     global commitinfo canv
 
8240     if {![info exists commitinfo($id)] && ![getcommit $id]} return
 
8244     if {[info exists hovertimer]} {
 
8245         after cancel $hovertimer
 
8247     set hovertimer [after 500 linehover]
 
8251 proc linemotion {x y id} {
 
8252     global hoverx hovery hoverid hovertimer
 
8254     if {[info exists hoverid] && $id == $hoverid} {
 
8257         if {[info exists hovertimer]} {
 
8258             after cancel $hovertimer
 
8260         set hovertimer [after 500 linehover]
 
8264 proc lineleave {id} {
 
8265     global hoverid hovertimer canv
 
8267     if {[info exists hoverid] && $id == $hoverid} {
 
8269         if {[info exists hovertimer]} {
 
8270             after cancel $hovertimer
 
8278     global hoverx hovery hoverid hovertimer
 
8279     global canv linespc lthickness
 
8282     set text [lindex $commitinfo($hoverid) 0]
 
8283     set ymax [lindex [$canv cget -scrollregion] 3]
 
8284     if {$ymax == {}} return
 
8285     set yfrac [lindex [$canv yview] 0]
 
8286     set x [expr {$hoverx + 2 * $linespc}]
 
8287     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
 
8288     set x0 [expr {$x - 2 * $lthickness}]
 
8289     set y0 [expr {$y - 2 * $lthickness}]
 
8290     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
 
8291     set y1 [expr {$y + $linespc + 2 * $lthickness}]
 
8292     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
 
8293                -fill \#ffff80 -outline black -width 1 -tags hover]
 
8295     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
 
8300 proc clickisonarrow {id y} {
 
8303     set ranges [rowranges $id]
 
8304     set thresh [expr {2 * $lthickness + 6}]
 
8305     set n [expr {[llength $ranges] - 1}]
 
8306     for {set i 1} {$i < $n} {incr i} {
 
8307         set row [lindex $ranges $i]
 
8308         if {abs([yc $row] - $y) < $thresh} {
 
8315 proc arrowjump {id n y} {
 
8318     # 1 <-> 2, 3 <-> 4, etc...
 
8319     set n [expr {(($n - 1) ^ 1) + 1}]
 
8320     set row [lindex [rowranges $id] $n]
 
8322     set ymax [lindex [$canv cget -scrollregion] 3]
 
8323     if {$ymax eq {} || $ymax <= 0} return
 
8324     set view [$canv yview]
 
8325     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
 
8326     set yfrac [expr {$yt / $ymax - $yspan / 2}]
 
8330     allcanvs yview moveto $yfrac
 
8333 proc lineclick {x y id isnew} {
 
8334     global ctext commitinfo children canv thickerline curview
 
8336     if {![info exists commitinfo($id)] && ![getcommit $id]} return
 
8341     # draw this line thicker than normal
 
8345         set ymax [lindex [$canv cget -scrollregion] 3]
 
8346         if {$ymax eq {}} return
 
8347         set yfrac [lindex [$canv yview] 0]
 
8348         set y [expr {$y + $yfrac * $ymax}]
 
8350     set dirn [clickisonarrow $id $y]
 
8352         arrowjump $id $dirn $y
 
8357         addtohistory [list lineclick $x $y $id 0] savectextpos
 
8359     # fill the details pane with info about this line
 
8360     $ctext conf -state normal
 
8363     $ctext insert end "[mc "Parent"]:\t"
 
8364     $ctext insert end $id link0
 
8366     set info $commitinfo($id)
 
8367     $ctext insert end "\n\t[lindex $info 0]\n"
 
8368     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
 
8369     set date [formatdate [lindex $info 2]]
 
8370     $ctext insert end "\t[mc "Date"]:\t$date\n"
 
8371     set kids $children($curview,$id)
 
8373         $ctext insert end "\n[mc "Children"]:"
 
8375         foreach child $kids {
 
8377             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
 
8378             set info $commitinfo($child)
 
8379             $ctext insert end "\n\t"
 
8380             $ctext insert end $child link$i
 
8381             setlink $child link$i
 
8382             $ctext insert end "\n\t[lindex $info 0]"
 
8383             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
 
8384             set date [formatdate [lindex $info 2]]
 
8385             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
 
8388     maybe_scroll_ctext 1
 
8389     $ctext conf -state disabled
 
8393 proc normalline {} {
 
8395     if {[info exists thickerline]} {
 
8402 proc selbyid {id {isnew 1}} {
 
8404     if {[commitinview $id $curview]} {
 
8405         selectline [rowofcommit $id] $isnew
 
8411     if {![info exists startmstime]} {
 
8412         set startmstime [clock clicks -milliseconds]
 
8414     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
 
8417 proc rowmenu {x y id} {
 
8418     global rowctxmenu selectedline rowmenuid curview
 
8419     global nullid nullid2 fakerowmenu mainhead markedid
 
8423     if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
 
8428     if {$id ne $nullid && $id ne $nullid2} {
 
8429         set menu $rowctxmenu
 
8430         if {$mainhead ne {}} {
 
8431             $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
 
8433             $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
 
8435         if {[info exists markedid] && $markedid ne $id} {
 
8436             $menu entryconfigure 9 -state normal
 
8437             $menu entryconfigure 10 -state normal
 
8438             $menu entryconfigure 11 -state normal
 
8440             $menu entryconfigure 9 -state disabled
 
8441             $menu entryconfigure 10 -state disabled
 
8442             $menu entryconfigure 11 -state disabled
 
8445         set menu $fakerowmenu
 
8447     $menu entryconfigure [mca "Diff this -> selected"] -state $state
 
8448     $menu entryconfigure [mca "Diff selected -> this"] -state $state
 
8449     $menu entryconfigure [mca "Make patch"] -state $state
 
8450     tk_popup $menu $x $y
 
8454     global rowmenuid markedid canv
 
8456     set markedid $rowmenuid
 
8457     make_idmark $markedid
 
8463     if {[info exists markedid]} {
 
8468 proc replace_by_kids {l r} {
 
8469     global curview children
 
8471     set id [commitonrow $r]
 
8472     set l [lreplace $l 0 0]
 
8473     foreach kid $children($curview,$id) {
 
8474         lappend l [rowofcommit $kid]
 
8476     return [lsort -integer -decreasing -unique $l]
 
8479 proc find_common_desc {} {
 
8480     global markedid rowmenuid curview children
 
8482     if {![info exists markedid]} return
 
8483     if {![commitinview $markedid $curview] ||
 
8484         ![commitinview $rowmenuid $curview]} return
 
8485     #set t1 [clock clicks -milliseconds]
 
8486     set l1 [list [rowofcommit $markedid]]
 
8487     set l2 [list [rowofcommit $rowmenuid]]
 
8489         set r1 [lindex $l1 0]
 
8490         set r2 [lindex $l2 0]
 
8491         if {$r1 eq {} || $r2 eq {}} break
 
8497             set l1 [replace_by_kids $l1 $r1]
 
8499             set l2 [replace_by_kids $l2 $r2]
 
8502     #set t2 [clock clicks -milliseconds]
 
8503     #puts "took [expr {$t2-$t1}]ms"
 
8506 proc compare_commits {} {
 
8507     global markedid rowmenuid curview children
 
8509     if {![info exists markedid]} return
 
8510     if {![commitinview $markedid $curview]} return
 
8511     addtohistory [list do_cmp_commits $markedid $rowmenuid]
 
8512     do_cmp_commits $markedid $rowmenuid
 
8515 proc getpatchid {id} {
 
8518     if {![info exists patchids($id)]} {
 
8519         set cmd [diffcmd [list $id] {-p --root}]
 
8520         # trim off the initial "|"
 
8521         set cmd [lrange $cmd 1 end]
 
8523             set x [eval exec $cmd | git patch-id]
 
8524             set patchids($id) [lindex $x 0]
 
8526             set patchids($id) "error"
 
8529     return $patchids($id)
 
8532 proc do_cmp_commits {a b} {
 
8533     global ctext curview parents children patchids commitinfo
 
8535     $ctext conf -state normal
 
8538     for {set i 0} {$i < 100} {incr i} {
 
8541         if {[llength $parents($curview,$a)] > 1} {
 
8542             appendshortlink $a [mc "Skipping merge commit "] "\n"
 
8545             set patcha [getpatchid $a]
 
8547         if {[llength $parents($curview,$b)] > 1} {
 
8548             appendshortlink $b [mc "Skipping merge commit "] "\n"
 
8551             set patchb [getpatchid $b]
 
8553         if {!$skipa && !$skipb} {
 
8554             set heada [lindex $commitinfo($a) 0]
 
8555             set headb [lindex $commitinfo($b) 0]
 
8556             if {$patcha eq "error"} {
 
8557                 appendshortlink $a [mc "Error getting patch ID for "] \
 
8558                     [mc " - stopping\n"]
 
8561             if {$patchb eq "error"} {
 
8562                 appendshortlink $b [mc "Error getting patch ID for "] \
 
8563                     [mc " - stopping\n"]
 
8566             if {$patcha eq $patchb} {
 
8567                 if {$heada eq $headb} {
 
8568                     appendshortlink $a [mc "Commit "]
 
8569                     appendshortlink $b " == " "  $heada\n"
 
8571                     appendshortlink $a [mc "Commit "] "  $heada\n"
 
8572                     appendshortlink $b [mc " is the same patch as\n       "] \
 
8578                 $ctext insert end "\n"
 
8579                 appendshortlink $a [mc "Commit "] "  $heada\n"
 
8580                 appendshortlink $b [mc " differs from\n       "] \
 
8582                 $ctext insert end [mc "Diff of commits:\n\n"]
 
8583                 $ctext conf -state disabled
 
8590             set kids [real_children $curview,$a]
 
8591             if {[llength $kids] != 1} {
 
8592                 $ctext insert end "\n"
 
8593                 appendshortlink $a [mc "Commit "] \
 
8594                     [mc " has %s children - stopping\n" [llength $kids]]
 
8597             set a [lindex $kids 0]
 
8600             set kids [real_children $curview,$b]
 
8601             if {[llength $kids] != 1} {
 
8602                 appendshortlink $b [mc "Commit "] \
 
8603                     [mc " has %s children - stopping\n" [llength $kids]]
 
8606             set b [lindex $kids 0]
 
8609     $ctext conf -state disabled
 
8612 proc diffcommits {a b} {
 
8613     global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
 
8615     set tmpdir [gitknewtmpdir]
 
8616     set fna [file join $tmpdir "commit-[string range $a 0 7]"]
 
8617     set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
 
8619         exec git diff-tree -p --pretty $a >$fna
 
8620         exec git diff-tree -p --pretty $b >$fnb
 
8622         error_popup [mc "Error writing commit to file: %s" $err]
 
8626         set fd [open "| diff -U$diffcontext $fna $fnb" r]
 
8628         error_popup [mc "Error diffing commits: %s" $err]
 
8631     set diffids [list commits $a $b]
 
8632     set blobdifffd($diffids) $fd
 
8634     set currdiffsubmod ""
 
8635     filerun $fd [list getblobdiffline $fd $diffids]
 
8638 proc diffvssel {dirn} {
 
8639     global rowmenuid selectedline
 
8641     if {$selectedline eq {}} return
 
8643         set oldid [commitonrow $selectedline]
 
8644         set newid $rowmenuid
 
8646         set oldid $rowmenuid
 
8647         set newid [commitonrow $selectedline]
 
8649     addtohistory [list doseldiff $oldid $newid] savectextpos
 
8650     doseldiff $oldid $newid
 
8653 proc doseldiff {oldid newid} {
 
8657     $ctext conf -state normal
 
8659     init_flist [mc "Top"]
 
8660     $ctext insert end "[mc "From"] "
 
8661     $ctext insert end $oldid link0
 
8662     setlink $oldid link0
 
8663     $ctext insert end "\n     "
 
8664     $ctext insert end [lindex $commitinfo($oldid) 0]
 
8665     $ctext insert end "\n\n[mc "To"]   "
 
8666     $ctext insert end $newid link1
 
8667     setlink $newid link1
 
8668     $ctext insert end "\n     "
 
8669     $ctext insert end [lindex $commitinfo($newid) 0]
 
8670     $ctext insert end "\n"
 
8671     $ctext conf -state disabled
 
8672     $ctext tag remove found 1.0 end
 
8673     startdiff [list $oldid $newid]
 
8677     global rowmenuid currentid commitinfo patchtop patchnum NS
 
8679     if {![info exists currentid]} return
 
8680     set oldid $currentid
 
8681     set oldhead [lindex $commitinfo($oldid) 0]
 
8682     set newid $rowmenuid
 
8683     set newhead [lindex $commitinfo($newid) 0]
 
8686     catch {destroy $top}
 
8688     make_transient $top .
 
8689     ${NS}::label $top.title -text [mc "Generate patch"]
 
8690     grid $top.title - -pady 10
 
8691     ${NS}::label $top.from -text [mc "From:"]
 
8692     ${NS}::entry $top.fromsha1 -width 40
 
8693     $top.fromsha1 insert 0 $oldid
 
8694     $top.fromsha1 conf -state readonly
 
8695     grid $top.from $top.fromsha1 -sticky w
 
8696     ${NS}::entry $top.fromhead -width 60
 
8697     $top.fromhead insert 0 $oldhead
 
8698     $top.fromhead conf -state readonly
 
8699     grid x $top.fromhead -sticky w
 
8700     ${NS}::label $top.to -text [mc "To:"]
 
8701     ${NS}::entry $top.tosha1 -width 40
 
8702     $top.tosha1 insert 0 $newid
 
8703     $top.tosha1 conf -state readonly
 
8704     grid $top.to $top.tosha1 -sticky w
 
8705     ${NS}::entry $top.tohead -width 60
 
8706     $top.tohead insert 0 $newhead
 
8707     $top.tohead conf -state readonly
 
8708     grid x $top.tohead -sticky w
 
8709     ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
 
8710     grid $top.rev x -pady 10 -padx 5
 
8711     ${NS}::label $top.flab -text [mc "Output file:"]
 
8712     ${NS}::entry $top.fname -width 60
 
8713     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
 
8715     grid $top.flab $top.fname -sticky w
 
8716     ${NS}::frame $top.buts
 
8717     ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
 
8718     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
 
8719     bind $top <Key-Return> mkpatchgo
 
8720     bind $top <Key-Escape> mkpatchcan
 
8721     grid $top.buts.gen $top.buts.can
 
8722     grid columnconfigure $top.buts 0 -weight 1 -uniform a
 
8723     grid columnconfigure $top.buts 1 -weight 1 -uniform a
 
8724     grid $top.buts - -pady 10 -sticky ew
 
8728 proc mkpatchrev {} {
 
8731     set oldid [$patchtop.fromsha1 get]
 
8732     set oldhead [$patchtop.fromhead get]
 
8733     set newid [$patchtop.tosha1 get]
 
8734     set newhead [$patchtop.tohead get]
 
8735     foreach e [list fromsha1 fromhead tosha1 tohead] \
 
8736             v [list $newid $newhead $oldid $oldhead] {
 
8737         $patchtop.$e conf -state normal
 
8738         $patchtop.$e delete 0 end
 
8739         $patchtop.$e insert 0 $v
 
8740         $patchtop.$e conf -state readonly
 
8745     global patchtop nullid nullid2
 
8747     set oldid [$patchtop.fromsha1 get]
 
8748     set newid [$patchtop.tosha1 get]
 
8749     set fname [$patchtop.fname get]
 
8750     set cmd [diffcmd [list $oldid $newid] -p]
 
8751     # trim off the initial "|"
 
8752     set cmd [lrange $cmd 1 end]
 
8753     lappend cmd >$fname &
 
8754     if {[catch {eval exec $cmd} err]} {
 
8755         error_popup "[mc "Error creating patch:"] $err" $patchtop
 
8757     catch {destroy $patchtop}
 
8761 proc mkpatchcan {} {
 
8764     catch {destroy $patchtop}
 
8769     global rowmenuid mktagtop commitinfo NS
 
8773     catch {destroy $top}
 
8775     make_transient $top .
 
8776     ${NS}::label $top.title -text [mc "Create tag"]
 
8777     grid $top.title - -pady 10
 
8778     ${NS}::label $top.id -text [mc "ID:"]
 
8779     ${NS}::entry $top.sha1 -width 40
 
8780     $top.sha1 insert 0 $rowmenuid
 
8781     $top.sha1 conf -state readonly
 
8782     grid $top.id $top.sha1 -sticky w
 
8783     ${NS}::entry $top.head -width 60
 
8784     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
 
8785     $top.head conf -state readonly
 
8786     grid x $top.head -sticky w
 
8787     ${NS}::label $top.tlab -text [mc "Tag name:"]
 
8788     ${NS}::entry $top.tag -width 60
 
8789     grid $top.tlab $top.tag -sticky w
 
8790     ${NS}::label $top.op -text [mc "Tag message is optional"]
 
8791     grid $top.op -columnspan 2 -sticky we
 
8792     ${NS}::label $top.mlab -text [mc "Tag message:"]
 
8793     ${NS}::entry $top.msg -width 60
 
8794     grid $top.mlab $top.msg -sticky w
 
8795     ${NS}::frame $top.buts
 
8796     ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
 
8797     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
 
8798     bind $top <Key-Return> mktaggo
 
8799     bind $top <Key-Escape> mktagcan
 
8800     grid $top.buts.gen $top.buts.can
 
8801     grid columnconfigure $top.buts 0 -weight 1 -uniform a
 
8802     grid columnconfigure $top.buts 1 -weight 1 -uniform a
 
8803     grid $top.buts - -pady 10 -sticky ew
 
8808     global mktagtop env tagids idtags
 
8810     set id [$mktagtop.sha1 get]
 
8811     set tag [$mktagtop.tag get]
 
8812     set msg [$mktagtop.msg get]
 
8814         error_popup [mc "No tag name specified"] $mktagtop
 
8817     if {[info exists tagids($tag)]} {
 
8818         error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
 
8823             exec git tag -a -m $msg $tag $id
 
8825             exec git tag $tag $id
 
8828         error_popup "[mc "Error creating tag:"] $err" $mktagtop
 
8832     set tagids($tag) $id
 
8833     lappend idtags($id) $tag
 
8841 proc redrawtags {id} {
 
8842     global canv linehtag idpos currentid curview cmitlisted markedid
 
8843     global canvxmax iddrawn circleitem mainheadid circlecolors
 
8845     if {![commitinview $id $curview]} return
 
8846     if {![info exists iddrawn($id)]} return
 
8847     set row [rowofcommit $id]
 
8848     if {$id eq $mainheadid} {
 
8851         set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
 
8853     $canv itemconf $circleitem($row) -fill $ofill
 
8854     $canv delete tag.$id
 
8855     set xt [eval drawtags $id $idpos($id)]
 
8856     $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
 
8857     set text [$canv itemcget $linehtag($id) -text]
 
8858     set font [$canv itemcget $linehtag($id) -font]
 
8859     set xr [expr {$xt + [font measure $font $text]}]
 
8860     if {$xr > $canvxmax} {
 
8864     if {[info exists currentid] && $currentid == $id} {
 
8867     if {[info exists markedid] && $markedid eq $id} {
 
8875     catch {destroy $mktagtop}
 
8880     if {![domktag]} return
 
8884 proc writecommit {} {
 
8885     global rowmenuid wrcomtop commitinfo wrcomcmd NS
 
8887     set top .writecommit
 
8889     catch {destroy $top}
 
8891     make_transient $top .
 
8892     ${NS}::label $top.title -text [mc "Write commit to file"]
 
8893     grid $top.title - -pady 10
 
8894     ${NS}::label $top.id -text [mc "ID:"]
 
8895     ${NS}::entry $top.sha1 -width 40
 
8896     $top.sha1 insert 0 $rowmenuid
 
8897     $top.sha1 conf -state readonly
 
8898     grid $top.id $top.sha1 -sticky w
 
8899     ${NS}::entry $top.head -width 60
 
8900     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
 
8901     $top.head conf -state readonly
 
8902     grid x $top.head -sticky w
 
8903     ${NS}::label $top.clab -text [mc "Command:"]
 
8904     ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
 
8905     grid $top.clab $top.cmd -sticky w -pady 10
 
8906     ${NS}::label $top.flab -text [mc "Output file:"]
 
8907     ${NS}::entry $top.fname -width 60
 
8908     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
 
8909     grid $top.flab $top.fname -sticky w
 
8910     ${NS}::frame $top.buts
 
8911     ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
 
8912     ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
 
8913     bind $top <Key-Return> wrcomgo
 
8914     bind $top <Key-Escape> wrcomcan
 
8915     grid $top.buts.gen $top.buts.can
 
8916     grid columnconfigure $top.buts 0 -weight 1 -uniform a
 
8917     grid columnconfigure $top.buts 1 -weight 1 -uniform a
 
8918     grid $top.buts - -pady 10 -sticky ew
 
8925     set id [$wrcomtop.sha1 get]
 
8926     set cmd "echo $id | [$wrcomtop.cmd get]"
 
8927     set fname [$wrcomtop.fname get]
 
8928     if {[catch {exec sh -c $cmd >$fname &} err]} {
 
8929         error_popup "[mc "Error writing commit:"] $err" $wrcomtop
 
8931     catch {destroy $wrcomtop}
 
8938     catch {destroy $wrcomtop}
 
8943     global rowmenuid mkbrtop NS
 
8946     catch {destroy $top}
 
8948     make_transient $top .
 
8949     ${NS}::label $top.title -text [mc "Create new branch"]
 
8950     grid $top.title - -pady 10
 
8951     ${NS}::label $top.id -text [mc "ID:"]
 
8952     ${NS}::entry $top.sha1 -width 40
 
8953     $top.sha1 insert 0 $rowmenuid
 
8954     $top.sha1 conf -state readonly
 
8955     grid $top.id $top.sha1 -sticky w
 
8956     ${NS}::label $top.nlab -text [mc "Name:"]
 
8957     ${NS}::entry $top.name -width 40
 
8958     grid $top.nlab $top.name -sticky w
 
8959     ${NS}::frame $top.buts
 
8960     ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
 
8961     ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
 
8962     bind $top <Key-Return> [list mkbrgo $top]
 
8963     bind $top <Key-Escape> "catch {destroy $top}"
 
8964     grid $top.buts.go $top.buts.can
 
8965     grid columnconfigure $top.buts 0 -weight 1 -uniform a
 
8966     grid columnconfigure $top.buts 1 -weight 1 -uniform a
 
8967     grid $top.buts - -pady 10 -sticky ew
 
8972     global headids idheads
 
8974     set name [$top.name get]
 
8975     set id [$top.sha1 get]
 
8979         error_popup [mc "Please specify a name for the new branch"] $top
 
8982     if {[info exists headids($name)]} {
 
8983         if {![confirm_popup [mc \
 
8984                 "Branch '%s' already exists. Overwrite?" $name] $top]} {
 
8987         set old_id $headids($name)
 
8990     catch {destroy $top}
 
8991     lappend cmdargs $name $id
 
8995         eval exec git branch $cmdargs
 
9001         if {$old_id ne {}} {
 
9007             set headids($name) $id
 
9008             lappend idheads($id) $name
 
9017 proc exec_citool {tool_args {baseid {}}} {
 
9018     global commitinfo env
 
9020     set save_env [array get env GIT_AUTHOR_*]
 
9022     if {$baseid ne {}} {
 
9023         if {![info exists commitinfo($baseid)]} {
 
9026         set author [lindex $commitinfo($baseid) 1]
 
9027         set date [lindex $commitinfo($baseid) 2]
 
9028         if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
 
9029                     $author author name email]
 
9031             set env(GIT_AUTHOR_NAME) $name
 
9032             set env(GIT_AUTHOR_EMAIL) $email
 
9033             set env(GIT_AUTHOR_DATE) $date
 
9037     eval exec git citool $tool_args &
 
9039     array unset env GIT_AUTHOR_*
 
9040     array set env $save_env
 
9043 proc cherrypick {} {
 
9044     global rowmenuid curview
 
9045     global mainhead mainheadid
 
9047     set oldhead [exec git rev-parse HEAD]
 
9048     set dheads [descheads $rowmenuid]
 
9049     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
 
9050         set ok [confirm_popup [mc "Commit %s is already\
 
9051                 included in branch %s -- really re-apply it?" \
 
9052                                    [string range $rowmenuid 0 7] $mainhead]]
 
9055     nowbusy cherrypick [mc "Cherry-picking"]
 
9057     # Unfortunately git-cherry-pick writes stuff to stderr even when
 
9058     # no error occurs, and exec takes that as an indication of error...
 
9059     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
 
9062                  {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
 
9064             error_popup [mc "Cherry-pick failed because of local changes\
 
9065                         to file '%s'.\nPlease commit, reset or stash\
 
9066                         your changes and try again." $fname]
 
9067         } elseif {[regexp -line \
 
9068                        {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
 
9070             if {[confirm_popup [mc "Cherry-pick failed because of merge\
 
9071                         conflict.\nDo you wish to run git citool to\
 
9073                 # Force citool to read MERGE_MSG
 
9074                 file delete [file join [gitdir] "GITGUI_MSG"]
 
9075                 exec_citool {} $rowmenuid
 
9083     set newhead [exec git rev-parse HEAD]
 
9084     if {$newhead eq $oldhead} {
 
9086         error_popup [mc "No changes committed"]
 
9089     addnewchild $newhead $oldhead
 
9090     if {[commitinview $oldhead $curview]} {
 
9091         # XXX this isn't right if we have a path limit...
 
9092         insertrow $newhead $oldhead $curview
 
9093         if {$mainhead ne {}} {
 
9094             movehead $newhead $mainhead
 
9095             movedhead $newhead $mainhead
 
9097         set mainheadid $newhead
 
9106     global mainhead rowmenuid confirm_ok resettype NS
 
9109     set w ".confirmreset"
 
9112     wm title $w [mc "Confirm reset"]
 
9113     ${NS}::label $w.m -text \
 
9114         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
 
9115     pack $w.m -side top -fill x -padx 20 -pady 20
 
9116     ${NS}::labelframe $w.f -text [mc "Reset type:"]
 
9118     ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
 
9119         -text [mc "Soft: Leave working tree and index untouched"]
 
9120     grid $w.f.soft -sticky w
 
9121     ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
 
9122         -text [mc "Mixed: Leave working tree untouched, reset index"]
 
9123     grid $w.f.mixed -sticky w
 
9124     ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
 
9125         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
 
9126     grid $w.f.hard -sticky w
 
9127     pack $w.f -side top -fill x -padx 4
 
9128     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
 
9129     pack $w.ok -side left -fill x -padx 20 -pady 20
 
9130     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
 
9131     bind $w <Key-Escape> [list destroy $w]
 
9132     pack $w.cancel -side right -fill x -padx 20 -pady 20
 
9133     bind $w <Visibility> "grab $w; focus $w"
 
9135     if {!$confirm_ok} return
 
9136     if {[catch {set fd [open \
 
9137             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
 
9141         filerun $fd [list readresetstat $fd]
 
9142         nowbusy reset [mc "Resetting"]
 
9147 proc readresetstat {fd} {
 
9148     global mainhead mainheadid showlocalchanges rprogcoord
 
9150     if {[gets $fd line] >= 0} {
 
9151         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
 
9152             set rprogcoord [expr {1.0 * $m / $n}]
 
9160     if {[catch {close $fd} err]} {
 
9163     set oldhead $mainheadid
 
9164     set newhead [exec git rev-parse HEAD]
 
9165     if {$newhead ne $oldhead} {
 
9166         movehead $newhead $mainhead
 
9167         movedhead $newhead $mainhead
 
9168         set mainheadid $newhead
 
9172     if {$showlocalchanges} {
 
9178 # context menu for a head
 
9179 proc headmenu {x y id head} {
 
9180     global headmenuid headmenuhead headctxmenu mainhead
 
9184     set headmenuhead $head
 
9186     if {[string match "remotes/*" $head]} {
 
9189     if {$head eq $mainhead} {
 
9192     $headctxmenu entryconfigure 0 -state $state
 
9193     $headctxmenu entryconfigure 1 -state $state
 
9194     tk_popup $headctxmenu $x $y
 
9198     global headmenuid headmenuhead headids
 
9199     global showlocalchanges
 
9201     # check the tree is clean first??
 
9202     nowbusy checkout [mc "Checking out"]
 
9206         set fd [open [list | git checkout $headmenuhead 2>@1] r]
 
9210         if {$showlocalchanges} {
 
9214         filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
 
9218 proc readcheckoutstat {fd newhead newheadid} {
 
9219     global mainhead mainheadid headids showlocalchanges progresscoords
 
9220     global viewmainheadid curview
 
9222     if {[gets $fd line] >= 0} {
 
9223         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
 
9224             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
 
9229     set progresscoords {0 0}
 
9232     if {[catch {close $fd} err]} {
 
9235     set oldmainid $mainheadid
 
9236     set mainhead $newhead
 
9237     set mainheadid $newheadid
 
9238     set viewmainheadid($curview) $newheadid
 
9239     redrawtags $oldmainid
 
9240     redrawtags $newheadid
 
9242     if {$showlocalchanges} {
 
9248     global headmenuid headmenuhead mainhead
 
9251     set head $headmenuhead
 
9253     # this check shouldn't be needed any more...
 
9254     if {$head eq $mainhead} {
 
9255         error_popup [mc "Cannot delete the currently checked-out branch"]
 
9258     set dheads [descheads $id]
 
9259     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
 
9260         # the stuff on this branch isn't on any other branch
 
9261         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
 
9262                         branch.\nReally delete branch %s?" $head $head]]} return
 
9266     if {[catch {exec git branch -D $head} err]} {
 
9271     removehead $id $head
 
9272     removedhead $id $head
 
9279 # Display a list of tags and heads
 
9281     global showrefstop bgcolor fgcolor selectbgcolor NS
 
9282     global bglist fglist reflistfilter reflist maincursor
 
9285     set showrefstop $top
 
9286     if {[winfo exists $top]} {
 
9292     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
 
9293     make_transient $top .
 
9294     text $top.list -background $bgcolor -foreground $fgcolor \
 
9295         -selectbackground $selectbgcolor -font mainfont \
 
9296         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
 
9297         -width 30 -height 20 -cursor $maincursor \
 
9298         -spacing1 1 -spacing3 1 -state disabled
 
9299     $top.list tag configure highlight -background $selectbgcolor
 
9300     lappend bglist $top.list
 
9301     lappend fglist $top.list
 
9302     ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
 
9303     ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
 
9304     grid $top.list $top.ysb -sticky nsew
 
9305     grid $top.xsb x -sticky ew
 
9307     ${NS}::label $top.f.l -text "[mc "Filter"]: "
 
9308     ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
 
9309     set reflistfilter "*"
 
9310     trace add variable reflistfilter write reflistfilter_change
 
9311     pack $top.f.e -side right -fill x -expand 1
 
9312     pack $top.f.l -side left
 
9313     grid $top.f - -sticky ew -pady 2
 
9314     ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
 
9315     bind $top <Key-Escape> [list destroy $top]
 
9317     grid columnconfigure $top 0 -weight 1
 
9318     grid rowconfigure $top 0 -weight 1
 
9319     bind $top.list <1> {break}
 
9320     bind $top.list <B1-Motion> {break}
 
9321     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
 
9326 proc sel_reflist {w x y} {
 
9327     global showrefstop reflist headids tagids otherrefids
 
9329     if {![winfo exists $showrefstop]} return
 
9330     set l [lindex [split [$w index "@$x,$y"] "."] 0]
 
9331     set ref [lindex $reflist [expr {$l-1}]]
 
9332     set n [lindex $ref 0]
 
9333     switch -- [lindex $ref 1] {
 
9334         "H" {selbyid $headids($n)}
 
9335         "T" {selbyid $tagids($n)}
 
9336         "o" {selbyid $otherrefids($n)}
 
9338     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
 
9341 proc unsel_reflist {} {
 
9344     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
 
9345     $showrefstop.list tag remove highlight 0.0 end
 
9348 proc reflistfilter_change {n1 n2 op} {
 
9349     global reflistfilter
 
9351     after cancel refill_reflist
 
9352     after 200 refill_reflist
 
9355 proc refill_reflist {} {
 
9356     global reflist reflistfilter showrefstop headids tagids otherrefids
 
9359     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
 
9361     foreach n [array names headids] {
 
9362         if {[string match $reflistfilter $n]} {
 
9363             if {[commitinview $headids($n) $curview]} {
 
9364                 lappend refs [list $n H]
 
9366                 interestedin $headids($n) {run refill_reflist}
 
9370     foreach n [array names tagids] {
 
9371         if {[string match $reflistfilter $n]} {
 
9372             if {[commitinview $tagids($n) $curview]} {
 
9373                 lappend refs [list $n T]
 
9375                 interestedin $tagids($n) {run refill_reflist}
 
9379     foreach n [array names otherrefids] {
 
9380         if {[string match $reflistfilter $n]} {
 
9381             if {[commitinview $otherrefids($n) $curview]} {
 
9382                 lappend refs [list $n o]
 
9384                 interestedin $otherrefids($n) {run refill_reflist}
 
9388     set refs [lsort -index 0 $refs]
 
9389     if {$refs eq $reflist} return
 
9391     # Update the contents of $showrefstop.list according to the
 
9392     # differences between $reflist (old) and $refs (new)
 
9393     $showrefstop.list conf -state normal
 
9394     $showrefstop.list insert end "\n"
 
9397     while {$i < [llength $reflist] || $j < [llength $refs]} {
 
9398         if {$i < [llength $reflist]} {
 
9399             if {$j < [llength $refs]} {
 
9400                 set cmp [string compare [lindex $reflist $i 0] \
 
9401                              [lindex $refs $j 0]]
 
9403                     set cmp [string compare [lindex $reflist $i 1] \
 
9404                                  [lindex $refs $j 1]]
 
9414                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
 
9422                 set l [expr {$j + 1}]
 
9423                 $showrefstop.list image create $l.0 -align baseline \
 
9424                     -image reficon-[lindex $refs $j 1] -padx 2
 
9425                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
 
9431     # delete last newline
 
9432     $showrefstop.list delete end-2c end-1c
 
9433     $showrefstop.list conf -state disabled
 
9436 # Stuff for finding nearby tags
 
9437 proc getallcommits {} {
 
9438     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
 
9439     global idheads idtags idotherrefs allparents tagobjid
 
9441     if {![info exists allcommits]} {
 
9447         set allccache [file join [gitdir] "gitk.cache"]
 
9449             set f [open $allccache r]
 
9458     set cmd [list | git rev-list --parents]
 
9459     set allcupdate [expr {$seeds ne {}}]
 
9463         set refs [concat [array names idheads] [array names idtags] \
 
9464                       [array names idotherrefs]]
 
9467         foreach name [array names tagobjid] {
 
9468             lappend tagobjs $tagobjid($name)
 
9470         foreach id [lsort -unique $refs] {
 
9471             if {![info exists allparents($id)] &&
 
9472                 [lsearch -exact $tagobjs $id] < 0} {
 
9483         set fd [open [concat $cmd $ids] r]
 
9484         fconfigure $fd -blocking 0
 
9487         filerun $fd [list getallclines $fd]
 
9493 # Since most commits have 1 parent and 1 child, we group strings of
 
9494 # such commits into "arcs" joining branch/merge points (BMPs), which
 
9495 # are commits that either don't have 1 parent or don't have 1 child.
 
9497 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
 
9498 # arcout(id) - outgoing arcs for BMP
 
9499 # arcids(a) - list of IDs on arc including end but not start
 
9500 # arcstart(a) - BMP ID at start of arc
 
9501 # arcend(a) - BMP ID at end of arc
 
9502 # growing(a) - arc a is still growing
 
9503 # arctags(a) - IDs out of arcids (excluding end) that have tags
 
9504 # archeads(a) - IDs out of arcids (excluding end) that have heads
 
9505 # The start of an arc is at the descendent end, so "incoming" means
 
9506 # coming from descendents, and "outgoing" means going towards ancestors.
 
9508 proc getallclines {fd} {
 
9509     global allparents allchildren idtags idheads nextarc
 
9510     global arcnos arcids arctags arcout arcend arcstart archeads growing
 
9511     global seeds allcommits cachedarcs allcupdate
 
9514     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
 
9515         set id [lindex $line 0]
 
9516         if {[info exists allparents($id)]} {
 
9521         set olds [lrange $line 1 end]
 
9522         set allparents($id) $olds
 
9523         if {![info exists allchildren($id)]} {
 
9524             set allchildren($id) {}
 
9529             if {[llength $olds] == 1 && [llength $a] == 1} {
 
9530                 lappend arcids($a) $id
 
9531                 if {[info exists idtags($id)]} {
 
9532                     lappend arctags($a) $id
 
9534                 if {[info exists idheads($id)]} {
 
9535                     lappend archeads($a) $id
 
9537                 if {[info exists allparents($olds)]} {
 
9538                     # seen parent already
 
9539                     if {![info exists arcout($olds)]} {
 
9542                     lappend arcids($a) $olds
 
9543                     set arcend($a) $olds
 
9546                 lappend allchildren($olds) $id
 
9547                 lappend arcnos($olds) $a
 
9551         foreach a $arcnos($id) {
 
9552             lappend arcids($a) $id
 
9559             lappend allchildren($p) $id
 
9560             set a [incr nextarc]
 
9561             set arcstart($a) $id
 
9568             if {[info exists allparents($p)]} {
 
9569                 # seen it already, may need to make a new branch
 
9570                 if {![info exists arcout($p)]} {
 
9573                 lappend arcids($a) $p
 
9577             lappend arcnos($p) $a
 
9582         global cached_dheads cached_dtags cached_atags
 
9583         catch {unset cached_dheads}
 
9584         catch {unset cached_dtags}
 
9585         catch {unset cached_atags}
 
9588         return [expr {$nid >= 1000? 2: 1}]
 
9592         fconfigure $fd -blocking 1
 
9595         # got an error reading the list of commits
 
9596         # if we were updating, try rereading the whole thing again
 
9602         error_popup "[mc "Error reading commit topology information;\
 
9603                 branch and preceding/following tag information\
 
9604                 will be incomplete."]\n($err)"
 
9607     if {[incr allcommits -1] == 0} {
 
9617 proc recalcarc {a} {
 
9618     global arctags archeads arcids idtags idheads
 
9622     foreach id [lrange $arcids($a) 0 end-1] {
 
9623         if {[info exists idtags($id)]} {
 
9626         if {[info exists idheads($id)]} {
 
9631     set archeads($a) $ah
 
9635     global arcnos arcids nextarc arctags archeads idtags idheads
 
9636     global arcstart arcend arcout allparents growing
 
9639     if {[llength $a] != 1} {
 
9640         puts "oops splitarc called but [llength $a] arcs already"
 
9644     set i [lsearch -exact $arcids($a) $p]
 
9646         puts "oops splitarc $p not in arc $a"
 
9649     set na [incr nextarc]
 
9650     if {[info exists arcend($a)]} {
 
9651         set arcend($na) $arcend($a)
 
9653         set l [lindex $allparents([lindex $arcids($a) end]) 0]
 
9654         set j [lsearch -exact $arcnos($l) $a]
 
9655         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
 
9657     set tail [lrange $arcids($a) [expr {$i+1}] end]
 
9658     set arcids($a) [lrange $arcids($a) 0 $i]
 
9660     set arcstart($na) $p
 
9662     set arcids($na) $tail
 
9663     if {[info exists growing($a)]} {
 
9669         if {[llength $arcnos($id)] == 1} {
 
9672             set j [lsearch -exact $arcnos($id) $a]
 
9673             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
 
9677     # reconstruct tags and heads lists
 
9678     if {$arctags($a) ne {} || $archeads($a) ne {}} {
 
9683         set archeads($na) {}
 
9687 # Update things for a new commit added that is a child of one
 
9688 # existing commit.  Used when cherry-picking.
 
9689 proc addnewchild {id p} {
 
9690     global allparents allchildren idtags nextarc
 
9691     global arcnos arcids arctags arcout arcend arcstart archeads growing
 
9692     global seeds allcommits
 
9694     if {![info exists allcommits] || ![info exists arcnos($p)]} return
 
9695     set allparents($id) [list $p]
 
9696     set allchildren($id) {}
 
9699     lappend allchildren($p) $id
 
9700     set a [incr nextarc]
 
9701     set arcstart($a) $id
 
9704     set arcids($a) [list $p]
 
9706     if {![info exists arcout($p)]} {
 
9709     lappend arcnos($p) $a
 
9710     set arcout($id) [list $a]
 
9713 # This implements a cache for the topology information.
 
9714 # The cache saves, for each arc, the start and end of the arc,
 
9715 # the ids on the arc, and the outgoing arcs from the end.
 
9716 proc readcache {f} {
 
9717     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
 
9718     global idtags idheads allparents cachedarcs possible_seeds seeds growing
 
9723     if {$lim - $a > 500} {
 
9724         set lim [expr {$a + 500}]
 
9728             # finish reading the cache and setting up arctags, etc.
 
9730             if {$line ne "1"} {error "bad final version"}
 
9732             foreach id [array names idtags] {
 
9733                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
 
9734                     [llength $allparents($id)] == 1} {
 
9735                     set a [lindex $arcnos($id) 0]
 
9736                     if {$arctags($a) eq {}} {
 
9741             foreach id [array names idheads] {
 
9742                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
 
9743                     [llength $allparents($id)] == 1} {
 
9744                     set a [lindex $arcnos($id) 0]
 
9745                     if {$archeads($a) eq {}} {
 
9750             foreach id [lsort -unique $possible_seeds] {
 
9751                 if {$arcnos($id) eq {}} {
 
9757             while {[incr a] <= $lim} {
 
9759                 if {[llength $line] != 3} {error "bad line"}
 
9760                 set s [lindex $line 0]
 
9762                 lappend arcout($s) $a
 
9763                 if {![info exists arcnos($s)]} {
 
9764                     lappend possible_seeds $s
 
9767                 set e [lindex $line 1]
 
9772                     if {![info exists arcout($e)]} {
 
9776                 set arcids($a) [lindex $line 2]
 
9777                 foreach id $arcids($a) {
 
9778                     lappend allparents($s) $id
 
9780                     lappend arcnos($id) $a
 
9782                 if {![info exists allparents($s)]} {
 
9783                     set allparents($s) {}
 
9788             set nextarc [expr {$a - 1}]
 
9801     global nextarc cachedarcs possible_seeds
 
9805         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
 
9806         # make sure it's an integer
 
9807         set cachedarcs [expr {int([lindex $line 1])}]
 
9808         if {$cachedarcs < 0} {error "bad number of arcs"}
 
9810         set possible_seeds {}
 
9818 proc dropcache {err} {
 
9819     global allcwait nextarc cachedarcs seeds
 
9821     #puts "dropping cache ($err)"
 
9822     foreach v {arcnos arcout arcids arcstart arcend growing \
 
9823                    arctags archeads allparents allchildren} {
 
9834 proc writecache {f} {
 
9835     global cachearc cachedarcs allccache
 
9836     global arcstart arcend arcnos arcids arcout
 
9840     if {$lim - $a > 1000} {
 
9841         set lim [expr {$a + 1000}]
 
9844         while {[incr a] <= $lim} {
 
9845             if {[info exists arcend($a)]} {
 
9846                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
 
9848                 puts $f [list $arcstart($a) {} $arcids($a)]
 
9853         catch {file delete $allccache}
 
9854         #puts "writing cache failed ($err)"
 
9857     set cachearc [expr {$a - 1}]
 
9858     if {$a > $cachedarcs} {
 
9867     global nextarc cachedarcs cachearc allccache
 
9869     if {$nextarc == $cachedarcs} return
 
9871     set cachedarcs $nextarc
 
9873         set f [open $allccache w]
 
9874         puts $f [list 1 $cachedarcs]
 
9879 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
 
9880 # or 0 if neither is true.
 
9881 proc anc_or_desc {a b} {
 
9882     global arcout arcstart arcend arcnos cached_isanc
 
9884     if {$arcnos($a) eq $arcnos($b)} {
 
9885         # Both are on the same arc(s); either both are the same BMP,
 
9886         # or if one is not a BMP, the other is also not a BMP or is
 
9887         # the BMP at end of the arc (and it only has 1 incoming arc).
 
9888         # Or both can be BMPs with no incoming arcs.
 
9889         if {$a eq $b || $arcnos($a) eq {}} {
 
9892         # assert {[llength $arcnos($a)] == 1}
 
9893         set arc [lindex $arcnos($a) 0]
 
9894         set i [lsearch -exact $arcids($arc) $a]
 
9895         set j [lsearch -exact $arcids($arc) $b]
 
9896         if {$i < 0 || $i > $j} {
 
9903     if {![info exists arcout($a)]} {
 
9904         set arc [lindex $arcnos($a) 0]
 
9905         if {[info exists arcend($arc)]} {
 
9906             set aend $arcend($arc)
 
9910         set a $arcstart($arc)
 
9914     if {![info exists arcout($b)]} {
 
9915         set arc [lindex $arcnos($b) 0]
 
9916         if {[info exists arcend($arc)]} {
 
9917             set bend $arcend($arc)
 
9921         set b $arcstart($arc)
 
9931     if {[info exists cached_isanc($a,$bend)]} {
 
9932         if {$cached_isanc($a,$bend)} {
 
9936     if {[info exists cached_isanc($b,$aend)]} {
 
9937         if {$cached_isanc($b,$aend)} {
 
9940         if {[info exists cached_isanc($a,$bend)]} {
 
9945     set todo [list $a $b]
 
9948     for {set i 0} {$i < [llength $todo]} {incr i} {
 
9949         set x [lindex $todo $i]
 
9950         if {$anc($x) eq {}} {
 
9953         foreach arc $arcnos($x) {
 
9954             set xd $arcstart($arc)
 
9956                 set cached_isanc($a,$bend) 1
 
9957                 set cached_isanc($b,$aend) 0
 
9959             } elseif {$xd eq $aend} {
 
9960                 set cached_isanc($b,$aend) 1
 
9961                 set cached_isanc($a,$bend) 0
 
9964             if {![info exists anc($xd)]} {
 
9965                 set anc($xd) $anc($x)
 
9967             } elseif {$anc($xd) ne $anc($x)} {
 
9972     set cached_isanc($a,$bend) 0
 
9973     set cached_isanc($b,$aend) 0
 
9977 # This identifies whether $desc has an ancestor that is
 
9978 # a growing tip of the graph and which is not an ancestor of $anc
 
9979 # and returns 0 if so and 1 if not.
 
9980 # If we subsequently discover a tag on such a growing tip, and that
 
9981 # turns out to be a descendent of $anc (which it could, since we
 
9982 # don't necessarily see children before parents), then $desc
 
9983 # isn't a good choice to display as a descendent tag of
 
9984 # $anc (since it is the descendent of another tag which is
 
9985 # a descendent of $anc).  Similarly, $anc isn't a good choice to
 
9986 # display as a ancestor tag of $desc.
 
9988 proc is_certain {desc anc} {
 
9989     global arcnos arcout arcstart arcend growing problems
 
9992     if {[llength $arcnos($anc)] == 1} {
 
9993         # tags on the same arc are certain
 
9994         if {$arcnos($desc) eq $arcnos($anc)} {
 
9997         if {![info exists arcout($anc)]} {
 
9998             # if $anc is partway along an arc, use the start of the arc instead
 
9999             set a [lindex $arcnos($anc) 0]
 
10000             set anc $arcstart($a)
 
10003     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
 
10006         set a [lindex $arcnos($desc) 0]
 
10012     set anclist [list $x]
 
10016     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
 
10017         set x [lindex $anclist $i]
 
10022         foreach a $arcout($x) {
 
10023             if {[info exists growing($a)]} {
 
10024                 if {![info exists growanc($x)] && $dl($x)} {
 
10030                 if {[info exists dl($y)]} {
 
10034                             if {![info exists done($y)]} {
 
10037                             if {[info exists growanc($x)]} {
 
10041                             for {set k 0} {$k < [llength $xl]} {incr k} {
 
10042                                 set z [lindex $xl $k]
 
10043                                 foreach c $arcout($z) {
 
10044                                     if {[info exists arcend($c)]} {
 
10046                                         if {[info exists dl($v)] && $dl($v)} {
 
10048                                             if {![info exists done($v)]} {
 
10051                                             if {[info exists growanc($v)]} {
 
10061                 } elseif {$y eq $anc || !$dl($x)} {
 
10072     foreach x [array names growanc] {
 
10081 proc validate_arctags {a} {
 
10082     global arctags idtags
 
10085     set na $arctags($a)
 
10086     foreach id $arctags($a) {
 
10088         if {![info exists idtags($id)]} {
 
10089             set na [lreplace $na $i $i]
 
10093     set arctags($a) $na
 
10096 proc validate_archeads {a} {
 
10097     global archeads idheads
 
10100     set na $archeads($a)
 
10101     foreach id $archeads($a) {
 
10103         if {![info exists idheads($id)]} {
 
10104             set na [lreplace $na $i $i]
 
10108     set archeads($a) $na
 
10111 # Return the list of IDs that have tags that are descendents of id,
 
10112 # ignoring IDs that are descendents of IDs already reported.
 
10113 proc desctags {id} {
 
10114     global arcnos arcstart arcids arctags idtags allparents
 
10115     global growing cached_dtags
 
10117     if {![info exists allparents($id)]} {
 
10120     set t1 [clock clicks -milliseconds]
 
10122     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
 
10123         # part-way along an arc; check that arc first
 
10124         set a [lindex $arcnos($id) 0]
 
10125         if {$arctags($a) ne {}} {
 
10126             validate_arctags $a
 
10127             set i [lsearch -exact $arcids($a) $id]
 
10129             foreach t $arctags($a) {
 
10130                 set j [lsearch -exact $arcids($a) $t]
 
10131                 if {$j >= $i} break
 
10138         set id $arcstart($a)
 
10139         if {[info exists idtags($id)]} {
 
10143     if {[info exists cached_dtags($id)]} {
 
10144         return $cached_dtags($id)
 
10148     set todo [list $id]
 
10151     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
 
10152         set id [lindex $todo $i]
 
10154         set ta [info exists hastaggedancestor($id)]
 
10158         # ignore tags on starting node
 
10159         if {!$ta && $i > 0} {
 
10160             if {[info exists idtags($id)]} {
 
10161                 set tagloc($id) $id
 
10163             } elseif {[info exists cached_dtags($id)]} {
 
10164                 set tagloc($id) $cached_dtags($id)
 
10168         foreach a $arcnos($id) {
 
10169             set d $arcstart($a)
 
10170             if {!$ta && $arctags($a) ne {}} {
 
10171                 validate_arctags $a
 
10172                 if {$arctags($a) ne {}} {
 
10173                     lappend tagloc($id) [lindex $arctags($a) end]
 
10176             if {$ta || $arctags($a) ne {}} {
 
10177                 set tomark [list $d]
 
10178                 for {set j 0} {$j < [llength $tomark]} {incr j} {
 
10179                     set dd [lindex $tomark $j]
 
10180                     if {![info exists hastaggedancestor($dd)]} {
 
10181                         if {[info exists done($dd)]} {
 
10182                             foreach b $arcnos($dd) {
 
10183                                 lappend tomark $arcstart($b)
 
10185                             if {[info exists tagloc($dd)]} {
 
10188                         } elseif {[info exists queued($dd)]} {
 
10191                         set hastaggedancestor($dd) 1
 
10195             if {![info exists queued($d)]} {
 
10198                 if {![info exists hastaggedancestor($d)]} {
 
10205     foreach id [array names tagloc] {
 
10206         if {![info exists hastaggedancestor($id)]} {
 
10207             foreach t $tagloc($id) {
 
10208                 if {[lsearch -exact $tags $t] < 0} {
 
10214     set t2 [clock clicks -milliseconds]
 
10217     # remove tags that are descendents of other tags
 
10218     for {set i 0} {$i < [llength $tags]} {incr i} {
 
10219         set a [lindex $tags $i]
 
10220         for {set j 0} {$j < $i} {incr j} {
 
10221             set b [lindex $tags $j]
 
10222             set r [anc_or_desc $a $b]
 
10224                 set tags [lreplace $tags $j $j]
 
10227             } elseif {$r == -1} {
 
10228                 set tags [lreplace $tags $i $i]
 
10235     if {[array names growing] ne {}} {
 
10236         # graph isn't finished, need to check if any tag could get
 
10237         # eclipsed by another tag coming later.  Simply ignore any
 
10238         # tags that could later get eclipsed.
 
10241             if {[is_certain $t $origid]} {
 
10245         if {$tags eq $ctags} {
 
10246             set cached_dtags($origid) $tags
 
10251         set cached_dtags($origid) $tags
 
10253     set t3 [clock clicks -milliseconds]
 
10254     if {0 && $t3 - $t1 >= 100} {
 
10255         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
 
10256             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
 
10261 proc anctags {id} {
 
10262     global arcnos arcids arcout arcend arctags idtags allparents
 
10263     global growing cached_atags
 
10265     if {![info exists allparents($id)]} {
 
10268     set t1 [clock clicks -milliseconds]
 
10270     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
 
10271         # part-way along an arc; check that arc first
 
10272         set a [lindex $arcnos($id) 0]
 
10273         if {$arctags($a) ne {}} {
 
10274             validate_arctags $a
 
10275             set i [lsearch -exact $arcids($a) $id]
 
10276             foreach t $arctags($a) {
 
10277                 set j [lsearch -exact $arcids($a) $t]
 
10283         if {![info exists arcend($a)]} {
 
10287         if {[info exists idtags($id)]} {
 
10291     if {[info exists cached_atags($id)]} {
 
10292         return $cached_atags($id)
 
10296     set todo [list $id]
 
10300     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
 
10301         set id [lindex $todo $i]
 
10303         set td [info exists hastaggeddescendent($id)]
 
10307         # ignore tags on starting node
 
10308         if {!$td && $i > 0} {
 
10309             if {[info exists idtags($id)]} {
 
10310                 set tagloc($id) $id
 
10312             } elseif {[info exists cached_atags($id)]} {
 
10313                 set tagloc($id) $cached_atags($id)
 
10317         foreach a $arcout($id) {
 
10318             if {!$td && $arctags($a) ne {}} {
 
10319                 validate_arctags $a
 
10320                 if {$arctags($a) ne {}} {
 
10321                     lappend tagloc($id) [lindex $arctags($a) 0]
 
10324             if {![info exists arcend($a)]} continue
 
10326             if {$td || $arctags($a) ne {}} {
 
10327                 set tomark [list $d]
 
10328                 for {set j 0} {$j < [llength $tomark]} {incr j} {
 
10329                     set dd [lindex $tomark $j]
 
10330                     if {![info exists hastaggeddescendent($dd)]} {
 
10331                         if {[info exists done($dd)]} {
 
10332                             foreach b $arcout($dd) {
 
10333                                 if {[info exists arcend($b)]} {
 
10334                                     lappend tomark $arcend($b)
 
10337                             if {[info exists tagloc($dd)]} {
 
10340                         } elseif {[info exists queued($dd)]} {
 
10343                         set hastaggeddescendent($dd) 1
 
10347             if {![info exists queued($d)]} {
 
10350                 if {![info exists hastaggeddescendent($d)]} {
 
10356     set t2 [clock clicks -milliseconds]
 
10359     foreach id [array names tagloc] {
 
10360         if {![info exists hastaggeddescendent($id)]} {
 
10361             foreach t $tagloc($id) {
 
10362                 if {[lsearch -exact $tags $t] < 0} {
 
10369     # remove tags that are ancestors of other tags
 
10370     for {set i 0} {$i < [llength $tags]} {incr i} {
 
10371         set a [lindex $tags $i]
 
10372         for {set j 0} {$j < $i} {incr j} {
 
10373             set b [lindex $tags $j]
 
10374             set r [anc_or_desc $a $b]
 
10376                 set tags [lreplace $tags $j $j]
 
10379             } elseif {$r == 1} {
 
10380                 set tags [lreplace $tags $i $i]
 
10387     if {[array names growing] ne {}} {
 
10388         # graph isn't finished, need to check if any tag could get
 
10389         # eclipsed by another tag coming later.  Simply ignore any
 
10390         # tags that could later get eclipsed.
 
10393             if {[is_certain $origid $t]} {
 
10397         if {$tags eq $ctags} {
 
10398             set cached_atags($origid) $tags
 
10403         set cached_atags($origid) $tags
 
10405     set t3 [clock clicks -milliseconds]
 
10406     if {0 && $t3 - $t1 >= 100} {
 
10407         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
 
10408             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
 
10413 # Return the list of IDs that have heads that are descendents of id,
 
10414 # including id itself if it has a head.
 
10415 proc descheads {id} {
 
10416     global arcnos arcstart arcids archeads idheads cached_dheads
 
10419     if {![info exists allparents($id)]} {
 
10423     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
 
10424         # part-way along an arc; check it first
 
10425         set a [lindex $arcnos($id) 0]
 
10426         if {$archeads($a) ne {}} {
 
10427             validate_archeads $a
 
10428             set i [lsearch -exact $arcids($a) $id]
 
10429             foreach t $archeads($a) {
 
10430                 set j [lsearch -exact $arcids($a) $t]
 
10435         set id $arcstart($a)
 
10438     set todo [list $id]
 
10441     for {set i 0} {$i < [llength $todo]} {incr i} {
 
10442         set id [lindex $todo $i]
 
10443         if {[info exists cached_dheads($id)]} {
 
10444             set ret [concat $ret $cached_dheads($id)]
 
10446             if {[info exists idheads($id)]} {
 
10449             foreach a $arcnos($id) {
 
10450                 if {$archeads($a) ne {}} {
 
10451                     validate_archeads $a
 
10452                     if {$archeads($a) ne {}} {
 
10453                         set ret [concat $ret $archeads($a)]
 
10456                 set d $arcstart($a)
 
10457                 if {![info exists seen($d)]} {
 
10464     set ret [lsort -unique $ret]
 
10465     set cached_dheads($origid) $ret
 
10466     return [concat $ret $aret]
 
10469 proc addedtag {id} {
 
10470     global arcnos arcout cached_dtags cached_atags
 
10472     if {![info exists arcnos($id)]} return
 
10473     if {![info exists arcout($id)]} {
 
10474         recalcarc [lindex $arcnos($id) 0]
 
10476     catch {unset cached_dtags}
 
10477     catch {unset cached_atags}
 
10480 proc addedhead {hid head} {
 
10481     global arcnos arcout cached_dheads
 
10483     if {![info exists arcnos($hid)]} return
 
10484     if {![info exists arcout($hid)]} {
 
10485         recalcarc [lindex $arcnos($hid) 0]
 
10487     catch {unset cached_dheads}
 
10490 proc removedhead {hid head} {
 
10491     global cached_dheads
 
10493     catch {unset cached_dheads}
 
10496 proc movedhead {hid head} {
 
10497     global arcnos arcout cached_dheads
 
10499     if {![info exists arcnos($hid)]} return
 
10500     if {![info exists arcout($hid)]} {
 
10501         recalcarc [lindex $arcnos($hid) 0]
 
10503     catch {unset cached_dheads}
 
10506 proc changedrefs {} {
 
10507     global cached_dheads cached_dtags cached_atags
 
10508     global arctags archeads arcnos arcout idheads idtags
 
10510     foreach id [concat [array names idheads] [array names idtags]] {
 
10511         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
 
10512             set a [lindex $arcnos($id) 0]
 
10513             if {![info exists donearc($a)]} {
 
10519     catch {unset cached_dtags}
 
10520     catch {unset cached_atags}
 
10521     catch {unset cached_dheads}
 
10524 proc rereadrefs {} {
 
10525     global idtags idheads idotherrefs mainheadid
 
10527     set refids [concat [array names idtags] \
 
10528                     [array names idheads] [array names idotherrefs]]
 
10529     foreach id $refids {
 
10530         if {![info exists ref($id)]} {
 
10531             set ref($id) [listrefs $id]
 
10534     set oldmainhead $mainheadid
 
10537     set refids [lsort -unique [concat $refids [array names idtags] \
 
10538                         [array names idheads] [array names idotherrefs]]]
 
10539     foreach id $refids {
 
10540         set v [listrefs $id]
 
10541         if {![info exists ref($id)] || $ref($id) != $v} {
 
10545     if {$oldmainhead ne $mainheadid} {
 
10546         redrawtags $oldmainhead
 
10547         redrawtags $mainheadid
 
10552 proc listrefs {id} {
 
10553     global idtags idheads idotherrefs
 
10556     if {[info exists idtags($id)]} {
 
10560     if {[info exists idheads($id)]} {
 
10561         set y $idheads($id)
 
10564     if {[info exists idotherrefs($id)]} {
 
10565         set z $idotherrefs($id)
 
10567     return [list $x $y $z]
 
10570 proc showtag {tag isnew} {
 
10571     global ctext tagcontents tagids linknum tagobjid
 
10574         addtohistory [list showtag $tag 0] savectextpos
 
10576     $ctext conf -state normal
 
10580     if {![info exists tagcontents($tag)]} {
 
10582            set tagcontents($tag) [exec git cat-file tag $tag]
 
10585     if {[info exists tagcontents($tag)]} {
 
10586         set text $tagcontents($tag)
 
10588         set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
 
10590     appendwithlinks $text {}
 
10591     maybe_scroll_ctext 1
 
10592     $ctext conf -state disabled
 
10604     if {[info exists gitktmpdir]} {
 
10605         catch {file delete -force $gitktmpdir}
 
10609 proc mkfontdisp {font top which} {
 
10610     global fontattr fontpref $font NS use_ttk
 
10612     set fontpref($font) [set $font]
 
10613     ${NS}::button $top.${font}but -text $which \
 
10614         -command [list choosefont $font $which]
 
10615     ${NS}::label $top.$font -relief flat -font $font \
 
10616         -text $fontattr($font,family) -justify left
 
10617     grid x $top.${font}but $top.$font -sticky w
 
10620 proc choosefont {font which} {
 
10621     global fontparam fontlist fonttop fontattr
 
10624     set fontparam(which) $which
 
10625     set fontparam(font) $font
 
10626     set fontparam(family) [font actual $font -family]
 
10627     set fontparam(size) $fontattr($font,size)
 
10628     set fontparam(weight) $fontattr($font,weight)
 
10629     set fontparam(slant) $fontattr($font,slant)
 
10632     if {![winfo exists $top]} {
 
10634         eval font config sample [font actual $font]
 
10636         make_transient $top $prefstop
 
10637         wm title $top [mc "Gitk font chooser"]
 
10638         ${NS}::label $top.l -textvariable fontparam(which)
 
10639         pack $top.l -side top
 
10640         set fontlist [lsort [font families]]
 
10641         ${NS}::frame $top.f
 
10642         listbox $top.f.fam -listvariable fontlist \
 
10643             -yscrollcommand [list $top.f.sb set]
 
10644         bind $top.f.fam <<ListboxSelect>> selfontfam
 
10645         ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
 
10646         pack $top.f.sb -side right -fill y
 
10647         pack $top.f.fam -side left -fill both -expand 1
 
10648         pack $top.f -side top -fill both -expand 1
 
10649         ${NS}::frame $top.g
 
10650         spinbox $top.g.size -from 4 -to 40 -width 4 \
 
10651             -textvariable fontparam(size) \
 
10652             -validatecommand {string is integer -strict %s}
 
10653         checkbutton $top.g.bold -padx 5 \
 
10654             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
 
10655             -variable fontparam(weight) -onvalue bold -offvalue normal
 
10656         checkbutton $top.g.ital -padx 5 \
 
10657             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
 
10658             -variable fontparam(slant) -onvalue italic -offvalue roman
 
10659         pack $top.g.size $top.g.bold $top.g.ital -side left
 
10660         pack $top.g -side top
 
10661         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
 
10663         $top.c create text 100 25 -anchor center -text $which -font sample \
 
10664             -fill black -tags text
 
10665         bind $top.c <Configure> [list centertext $top.c]
 
10666         pack $top.c -side top -fill x
 
10667         ${NS}::frame $top.buts
 
10668         ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
 
10669         ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
 
10670         bind $top <Key-Return> fontok
 
10671         bind $top <Key-Escape> fontcan
 
10672         grid $top.buts.ok $top.buts.can
 
10673         grid columnconfigure $top.buts 0 -weight 1 -uniform a
 
10674         grid columnconfigure $top.buts 1 -weight 1 -uniform a
 
10675         pack $top.buts -side bottom -fill x
 
10676         trace add variable fontparam write chg_fontparam
 
10679         $top.c itemconf text -text $which
 
10681     set i [lsearch -exact $fontlist $fontparam(family)]
 
10683         $top.f.fam selection set $i
 
10688 proc centertext {w} {
 
10689     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
 
10693     global fontparam fontpref prefstop
 
10695     set f $fontparam(font)
 
10696     set fontpref($f) [list $fontparam(family) $fontparam(size)]
 
10697     if {$fontparam(weight) eq "bold"} {
 
10698         lappend fontpref($f) "bold"
 
10700     if {$fontparam(slant) eq "italic"} {
 
10701         lappend fontpref($f) "italic"
 
10704     $w conf -text $fontparam(family) -font $fontpref($f)
 
10710     global fonttop fontparam
 
10712     if {[info exists fonttop]} {
 
10713         catch {destroy $fonttop}
 
10714         catch {font delete sample}
 
10720 if {[package vsatisfies [package provide Tk] 8.6]} {
 
10721     # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
 
10722     # function to make use of it.
 
10723     proc choosefont {font which} {
 
10724         tk fontchooser configure -title $which -font $font \
 
10725             -command [list on_choosefont $font $which]
 
10726         tk fontchooser show
 
10728     proc on_choosefont {font which newfont} {
 
10730         puts stderr "$font $newfont"
 
10731         array set f [font actual $newfont]
 
10732         set fontparam(which) $which
 
10733         set fontparam(font) $font
 
10734         set fontparam(family) $f(-family)
 
10735         set fontparam(size) $f(-size)
 
10736         set fontparam(weight) $f(-weight)
 
10737         set fontparam(slant) $f(-slant)
 
10742 proc selfontfam {} {
 
10743     global fonttop fontparam
 
10745     set i [$fonttop.f.fam curselection]
 
10747         set fontparam(family) [$fonttop.f.fam get $i]
 
10751 proc chg_fontparam {v sub op} {
 
10754     font config sample -$sub $fontparam($sub)
 
10758     global maxwidth maxgraphpct use_ttk NS
 
10759     global oldprefs prefstop showneartags showlocalchanges
 
10760     global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
 
10761     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
 
10762     global hideremotes want_ttk have_ttk
 
10766     if {[winfo exists $top]} {
 
10770     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
 
10771                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
 
10772         set oldprefs($v) [set $v]
 
10775     wm title $top [mc "Gitk preferences"]
 
10776     make_transient $top .
 
10777     ${NS}::label $top.ldisp -text [mc "Commit list display options"]
 
10778     grid $top.ldisp - -sticky w -pady 10
 
10779     ${NS}::label $top.spacer -text " "
 
10780     ${NS}::label $top.maxwidthl -text [mc "Maximum graph width (lines)"]
 
10781     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
 
10782     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
 
10783     ${NS}::label $top.maxpctl -text [mc "Maximum graph width (% of pane)"]
 
10784     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
 
10785     grid x $top.maxpctl $top.maxpct -sticky w
 
10786     ${NS}::checkbutton $top.showlocal -text [mc "Show local changes"] \
 
10787         -variable showlocalchanges
 
10788     grid x $top.showlocal -sticky w
 
10789     ${NS}::checkbutton $top.autoselect -text [mc "Auto-select SHA1 (length)"] \
 
10790         -variable autoselect
 
10791     spinbox $top.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
 
10792     grid x $top.autoselect $top.autosellen -sticky w
 
10793     ${NS}::checkbutton $top.hideremotes -text [mc "Hide remote refs"] \
 
10794         -variable hideremotes
 
10795     grid x $top.hideremotes -sticky w
 
10797     ${NS}::label $top.ddisp -text [mc "Diff display options"]
 
10798     grid $top.ddisp - -sticky w -pady 10
 
10799     ${NS}::label $top.tabstopl -text [mc "Tab spacing"]
 
10800     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
 
10801     grid x $top.tabstopl $top.tabstop -sticky w
 
10802     ${NS}::checkbutton $top.ntag -text [mc "Display nearby tags"] \
 
10803         -variable showneartags
 
10804     grid x $top.ntag -sticky w
 
10805     ${NS}::checkbutton $top.ldiff -text [mc "Limit diffs to listed paths"] \
 
10806         -variable limitdiffs
 
10807     grid x $top.ldiff -sticky w
 
10808     ${NS}::checkbutton $top.lattr -text [mc "Support per-file encodings"] \
 
10809         -variable perfile_attrs
 
10810     grid x $top.lattr -sticky w
 
10812     ${NS}::entry $top.extdifft -textvariable extdifftool
 
10813     ${NS}::frame $top.extdifff
 
10814     ${NS}::label $top.extdifff.l -text [mc "External diff tool" ]
 
10815     ${NS}::button $top.extdifff.b -text [mc "Choose..."] -command choose_extdiff
 
10816     pack $top.extdifff.l $top.extdifff.b -side left
 
10817     pack configure $top.extdifff.l -padx 10
 
10818     grid x $top.extdifff $top.extdifft -sticky ew
 
10820     ${NS}::label $top.lgen -text [mc "General options"]
 
10821     grid $top.lgen - -sticky w -pady 10
 
10822     ${NS}::checkbutton $top.want_ttk -variable want_ttk \
 
10823         -text [mc "Use themed widgets"]
 
10825         ${NS}::label $top.ttk_note -text [mc "(change requires restart)"]
 
10827         ${NS}::label $top.ttk_note -text [mc "(currently unavailable)"]
 
10829     grid x $top.want_ttk $top.ttk_note -sticky w
 
10831     ${NS}::label $top.cdisp -text [mc "Colors: press to choose"]
 
10832     grid $top.cdisp - -sticky w -pady 10
 
10833     label $top.ui -padx 40 -relief sunk -background $uicolor
 
10834     ${NS}::button $top.uibut -text [mc "Interface"] \
 
10835        -command [list choosecolor uicolor {} $top.ui [mc "interface"] setui]
 
10836     grid x $top.uibut $top.ui -sticky w
 
10837     label $top.bg -padx 40 -relief sunk -background $bgcolor
 
10838     ${NS}::button $top.bgbut -text [mc "Background"] \
 
10839         -command [list choosecolor bgcolor {} $top.bg [mc "background"] setbg]
 
10840     grid x $top.bgbut $top.bg -sticky w
 
10841     label $top.fg -padx 40 -relief sunk -background $fgcolor
 
10842     ${NS}::button $top.fgbut -text [mc "Foreground"] \
 
10843         -command [list choosecolor fgcolor {} $top.fg [mc "foreground"] setfg]
 
10844     grid x $top.fgbut $top.fg -sticky w
 
10845     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
 
10846     ${NS}::button $top.diffoldbut -text [mc "Diff: old lines"] \
 
10847         -command [list choosecolor diffcolors 0 $top.diffold [mc "diff old lines"] \
 
10848                       [list $ctext tag conf d0 -foreground]]
 
10849     grid x $top.diffoldbut $top.diffold -sticky w
 
10850     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
 
10851     ${NS}::button $top.diffnewbut -text [mc "Diff: new lines"] \
 
10852         -command [list choosecolor diffcolors 1 $top.diffnew [mc "diff new lines"] \
 
10853                       [list $ctext tag conf dresult -foreground]]
 
10854     grid x $top.diffnewbut $top.diffnew -sticky w
 
10855     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
 
10856     ${NS}::button $top.hunksepbut -text [mc "Diff: hunk header"] \
 
10857         -command [list choosecolor diffcolors 2 $top.hunksep \
 
10858                       [mc "diff hunk header"] \
 
10859                       [list $ctext tag conf hunksep -foreground]]
 
10860     grid x $top.hunksepbut $top.hunksep -sticky w
 
10861     label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
 
10862     ${NS}::button $top.markbgbut -text [mc "Marked line bg"] \
 
10863         -command [list choosecolor markbgcolor {} $top.markbgsep \
 
10864                       [mc "marked line background"] \
 
10865                       [list $ctext tag conf omark -background]]
 
10866     grid x $top.markbgbut $top.markbgsep -sticky w
 
10867     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
 
10868     ${NS}::button $top.selbgbut -text [mc "Select bg"] \
 
10869         -command [list choosecolor selectbgcolor {} $top.selbgsep [mc "background"] setselbg]
 
10870     grid x $top.selbgbut $top.selbgsep -sticky w
 
10872     ${NS}::label $top.cfont -text [mc "Fonts: press to choose"]
 
10873     grid $top.cfont - -sticky w -pady 10
 
10874     mkfontdisp mainfont $top [mc "Main font"]
 
10875     mkfontdisp textfont $top [mc "Diff display font"]
 
10876     mkfontdisp uifont $top [mc "User interface font"]
 
10878     ${NS}::frame $top.buts
 
10879     ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
 
10880     ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
 
10881     bind $top <Key-Return> prefsok
 
10882     bind $top <Key-Escape> prefscan
 
10883     grid $top.buts.ok $top.buts.can
 
10884     grid columnconfigure $top.buts 0 -weight 1 -uniform a
 
10885     grid columnconfigure $top.buts 1 -weight 1 -uniform a
 
10886     grid $top.buts - - -pady 10 -sticky ew
 
10887     grid columnconfigure $top 2 -weight 1
 
10888     bind $top <Visibility> "focus $top.buts.ok"
 
10891 proc choose_extdiff {} {
 
10894     set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
 
10896         set extdifftool $prog
 
10900 proc choosecolor {v vi w x cmd} {
 
10903     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
 
10904                -title [mc "Gitk: choose color for %s" $x]]
 
10905     if {$c eq {}} return
 
10906     $w conf -background $c
 
10911 proc setselbg {c} {
 
10912     global bglist cflist
 
10913     foreach w $bglist {
 
10914         $w configure -selectbackground $c
 
10916     $cflist tag configure highlight \
 
10917         -background [$cflist cget -selectbackground]
 
10918     allcanvs itemconf secsel -fill $c
 
10921 # This sets the background color and the color scheme for the whole UI.
 
10922 # For some reason, tk_setPalette chooses a nasty dark red for selectColor
 
10923 # if we don't specify one ourselves, which makes the checkbuttons and
 
10924 # radiobuttons look bad.  This chooses white for selectColor if the
 
10925 # background color is light, or black if it is dark.
 
10927     if {[tk windowingsystem] eq "win32"} { return }
 
10928     set bg [winfo rgb . $c]
 
10930     if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
 
10933     tk_setPalette background $c selectColor $selc
 
10939     foreach w $bglist {
 
10940         $w conf -background $c
 
10947     foreach w $fglist {
 
10948         $w conf -foreground $c
 
10950     allcanvs itemconf text -fill $c
 
10951     $canv itemconf circle -outline $c
 
10952     $canv itemconf markid -outline $c
 
10956     global oldprefs prefstop
 
10958     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
 
10959                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
 
10961         set $v $oldprefs($v)
 
10963     catch {destroy $prefstop}
 
10969     global maxwidth maxgraphpct
 
10970     global oldprefs prefstop showneartags showlocalchanges
 
10971     global fontpref mainfont textfont uifont
 
10972     global limitdiffs treediffs perfile_attrs
 
10975     catch {destroy $prefstop}
 
10979     if {$mainfont ne $fontpref(mainfont)} {
 
10980         set mainfont $fontpref(mainfont)
 
10981         parsefont mainfont $mainfont
 
10982         eval font configure mainfont [fontflags mainfont]
 
10983         eval font configure mainfontbold [fontflags mainfont 1]
 
10987     if {$textfont ne $fontpref(textfont)} {
 
10988         set textfont $fontpref(textfont)
 
10989         parsefont textfont $textfont
 
10990         eval font configure textfont [fontflags textfont]
 
10991         eval font configure textfontbold [fontflags textfont 1]
 
10993     if {$uifont ne $fontpref(uifont)} {
 
10994         set uifont $fontpref(uifont)
 
10995         parsefont uifont $uifont
 
10996         eval font configure uifont [fontflags uifont]
 
10999     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
 
11000         if {$showlocalchanges} {
 
11006     if {$limitdiffs != $oldprefs(limitdiffs) ||
 
11007         ($perfile_attrs && !$oldprefs(perfile_attrs))} {
 
11008         # treediffs elements are limited by path;
 
11009         # won't have encodings cached if perfile_attrs was just turned on
 
11010         catch {unset treediffs}
 
11012     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
 
11013         || $maxgraphpct != $oldprefs(maxgraphpct)} {
 
11015     } elseif {$showneartags != $oldprefs(showneartags) ||
 
11016           $limitdiffs != $oldprefs(limitdiffs)} {
 
11019     if {$hideremotes != $oldprefs(hideremotes)} {
 
11024 proc formatdate {d} {
 
11025     global datetimeformat
 
11027         set d [clock format $d -format $datetimeformat]
 
11032 # This list of encoding names and aliases is distilled from
 
11033 # http://www.iana.org/assignments/character-sets.
 
11034 # Not all of them are supported by Tcl.
 
11035 set encoding_aliases {
 
11036     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
 
11037       ISO646-US US-ASCII us IBM367 cp367 csASCII }
 
11038     { ISO-10646-UTF-1 csISO10646UTF1 }
 
11039     { ISO_646.basic:1983 ref csISO646basic1983 }
 
11040     { INVARIANT csINVARIANT }
 
11041     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
 
11042     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
 
11043     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
 
11044     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
 
11045     { NATS-DANO iso-ir-9-1 csNATSDANO }
 
11046     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
 
11047     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
 
11048     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
 
11049     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
 
11050     { ISO-2022-KR csISO2022KR }
 
11052     { ISO-2022-JP csISO2022JP }
 
11053     { ISO-2022-JP-2 csISO2022JP2 }
 
11054     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
 
11055       csISO13JISC6220jp }
 
11056     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
 
11057     { IT iso-ir-15 ISO646-IT csISO15Italian }
 
11058     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
 
11059     { ES iso-ir-17 ISO646-ES csISO17Spanish }
 
11060     { greek7-old iso-ir-18 csISO18Greek7Old }
 
11061     { latin-greek iso-ir-19 csISO19LatinGreek }
 
11062     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
 
11063     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
 
11064     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
 
11065     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
 
11066     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
 
11067     { BS_viewdata iso-ir-47 csISO47BSViewdata }
 
11068     { INIS iso-ir-49 csISO49INIS }
 
11069     { INIS-8 iso-ir-50 csISO50INIS8 }
 
11070     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
 
11071     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
 
11072     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
 
11073     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
 
11074     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
 
11075     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
 
11076       csISO60Norwegian1 }
 
11077     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
 
11078     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
 
11079     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
 
11080     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
 
11081     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
 
11082     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
 
11083     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
 
11084     { greek7 iso-ir-88 csISO88Greek7 }
 
11085     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
 
11086     { iso-ir-90 csISO90 }
 
11087     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
 
11088     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
 
11089       csISO92JISC62991984b }
 
11090     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
 
11091     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
 
11092     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
 
11093       csISO95JIS62291984handadd }
 
11094     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
 
11095     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
 
11096     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
 
11097     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
 
11098       CP819 csISOLatin1 }
 
11099     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
 
11100     { T.61-7bit iso-ir-102 csISO102T617bit }
 
11101     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
 
11102     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
 
11103     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
 
11104     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
 
11105     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
 
11106     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
 
11107     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
 
11108     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
 
11109       arabic csISOLatinArabic }
 
11110     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
 
11111     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
 
11112     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
 
11113       greek greek8 csISOLatinGreek }
 
11114     { T.101-G2 iso-ir-128 csISO128T101G2 }
 
11115     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
 
11117     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
 
11118     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
 
11119     { CSN_369103 iso-ir-139 csISO139CSN369103 }
 
11120     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
 
11121     { ISO_6937-2-add iso-ir-142 csISOTextComm }
 
11122     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
 
11123     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
 
11124       csISOLatinCyrillic }
 
11125     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
 
11126     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
 
11127     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
 
11128     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
 
11129     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
 
11130     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
 
11131     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
 
11132     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
 
11133     { ISO_10367-box iso-ir-155 csISO10367Box }
 
11134     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
 
11135     { latin-lap lap iso-ir-158 csISO158Lap }
 
11136     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
 
11137     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
 
11140     { JIS_X0201 X0201 csHalfWidthKatakana }
 
11141     { KSC5636 ISO646-KR csKSC5636 }
 
11142     { ISO-10646-UCS-2 csUnicode }
 
11143     { ISO-10646-UCS-4 csUCS4 }
 
11144     { DEC-MCS dec csDECMCS }
 
11145     { hp-roman8 roman8 r8 csHPRoman8 }
 
11146     { macintosh mac csMacintosh }
 
11147     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
 
11149     { IBM038 EBCDIC-INT cp038 csIBM038 }
 
11150     { IBM273 CP273 csIBM273 }
 
11151     { IBM274 EBCDIC-BE CP274 csIBM274 }
 
11152     { IBM275 EBCDIC-BR cp275 csIBM275 }
 
11153     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
 
11154     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
 
11155     { IBM280 CP280 ebcdic-cp-it csIBM280 }
 
11156     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
 
11157     { IBM284 CP284 ebcdic-cp-es csIBM284 }
 
11158     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
 
11159     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
 
11160     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
 
11161     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
 
11162     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
 
11163     { IBM424 cp424 ebcdic-cp-he csIBM424 }
 
11164     { IBM437 cp437 437 csPC8CodePage437 }
 
11165     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
 
11166     { IBM775 cp775 csPC775Baltic }
 
11167     { IBM850 cp850 850 csPC850Multilingual }
 
11168     { IBM851 cp851 851 csIBM851 }
 
11169     { IBM852 cp852 852 csPCp852 }
 
11170     { IBM855 cp855 855 csIBM855 }
 
11171     { IBM857 cp857 857 csIBM857 }
 
11172     { IBM860 cp860 860 csIBM860 }
 
11173     { IBM861 cp861 861 cp-is csIBM861 }
 
11174     { IBM862 cp862 862 csPC862LatinHebrew }
 
11175     { IBM863 cp863 863 csIBM863 }
 
11176     { IBM864 cp864 csIBM864 }
 
11177     { IBM865 cp865 865 csIBM865 }
 
11178     { IBM866 cp866 866 csIBM866 }
 
11179     { IBM868 CP868 cp-ar csIBM868 }
 
11180     { IBM869 cp869 869 cp-gr csIBM869 }
 
11181     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
 
11182     { IBM871 CP871 ebcdic-cp-is csIBM871 }
 
11183     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
 
11184     { IBM891 cp891 csIBM891 }
 
11185     { IBM903 cp903 csIBM903 }
 
11186     { IBM904 cp904 904 csIBBM904 }
 
11187     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
 
11188     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
 
11189     { IBM1026 CP1026 csIBM1026 }
 
11190     { EBCDIC-AT-DE csIBMEBCDICATDE }
 
11191     { EBCDIC-AT-DE-A csEBCDICATDEA }
 
11192     { EBCDIC-CA-FR csEBCDICCAFR }
 
11193     { EBCDIC-DK-NO csEBCDICDKNO }
 
11194     { EBCDIC-DK-NO-A csEBCDICDKNOA }
 
11195     { EBCDIC-FI-SE csEBCDICFISE }
 
11196     { EBCDIC-FI-SE-A csEBCDICFISEA }
 
11197     { EBCDIC-FR csEBCDICFR }
 
11198     { EBCDIC-IT csEBCDICIT }
 
11199     { EBCDIC-PT csEBCDICPT }
 
11200     { EBCDIC-ES csEBCDICES }
 
11201     { EBCDIC-ES-A csEBCDICESA }
 
11202     { EBCDIC-ES-S csEBCDICESS }
 
11203     { EBCDIC-UK csEBCDICUK }
 
11204     { EBCDIC-US csEBCDICUS }
 
11205     { UNKNOWN-8BIT csUnknown8BiT }
 
11206     { MNEMONIC csMnemonic }
 
11208     { VISCII csVISCII }
 
11211     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
 
11212     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
 
11213     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
 
11214     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
 
11215     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
 
11216     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
 
11217     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
 
11218     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
 
11219     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
 
11220     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
 
11221     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
 
11222     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
 
11223     { IBM1047 IBM-1047 }
 
11224     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
 
11225     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
 
11226     { UNICODE-1-1 csUnicode11 }
 
11227     { CESU-8 csCESU-8 }
 
11228     { BOCU-1 csBOCU-1 }
 
11229     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
 
11230     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
 
11232     { ISO-8859-15 ISO_8859-15 Latin-9 }
 
11233     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
 
11234     { GBK CP936 MS936 windows-936 }
 
11235     { JIS_Encoding csJISEncoding }
 
11236     { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
 
11237     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
 
11239     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
 
11240     { ISO-10646-UCS-Basic csUnicodeASCII }
 
11241     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
 
11242     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
 
11243     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
 
11244     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
 
11245     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
 
11246     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
 
11247     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
 
11248     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
 
11249     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
 
11250     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
 
11251     { Adobe-Standard-Encoding csAdobeStandardEncoding }
 
11252     { Ventura-US csVenturaUS }
 
11253     { Ventura-International csVenturaInternational }
 
11254     { PC8-Danish-Norwegian csPC8DanishNorwegian }
 
11255     { PC8-Turkish csPC8Turkish }
 
11256     { IBM-Symbols csIBMSymbols }
 
11257     { IBM-Thai csIBMThai }
 
11258     { HP-Legal csHPLegal }
 
11259     { HP-Pi-font csHPPiFont }
 
11260     { HP-Math8 csHPMath8 }
 
11261     { Adobe-Symbol-Encoding csHPPSMath }
 
11262     { HP-DeskTop csHPDesktop }
 
11263     { Ventura-Math csVenturaMath }
 
11264     { Microsoft-Publishing csMicrosoftPublishing }
 
11265     { Windows-31J csWindows31J }
 
11266     { GB2312 csGB2312 }
 
11270 proc tcl_encoding {enc} {
 
11271     global encoding_aliases tcl_encoding_cache
 
11272     if {[info exists tcl_encoding_cache($enc)]} {
 
11273         return $tcl_encoding_cache($enc)
 
11275     set names [encoding names]
 
11276     set lcnames [string tolower $names]
 
11277     set enc [string tolower $enc]
 
11278     set i [lsearch -exact $lcnames $enc]
 
11280         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
 
11281         if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
 
11282             set i [lsearch -exact $lcnames $encx]
 
11286         foreach l $encoding_aliases {
 
11287             set ll [string tolower $l]
 
11288             if {[lsearch -exact $ll $enc] < 0} continue
 
11289             # look through the aliases for one that tcl knows about
 
11291                 set i [lsearch -exact $lcnames $e]
 
11293                     if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
 
11294                         set i [lsearch -exact $lcnames $ex]
 
11304         set tclenc [lindex $names $i]
 
11306     set tcl_encoding_cache($enc) $tclenc
 
11310 proc gitattr {path attr default} {
 
11311     global path_attr_cache
 
11312     if {[info exists path_attr_cache($attr,$path)]} {
 
11313         set r $path_attr_cache($attr,$path)
 
11315         set r "unspecified"
 
11316         if {![catch {set line [exec git check-attr $attr -- $path]}]} {
 
11317             regexp "(.*): $attr: (.*)" $line m f r
 
11319         set path_attr_cache($attr,$path) $r
 
11321     if {$r eq "unspecified"} {
 
11327 proc cache_gitattr {attr pathlist} {
 
11328     global path_attr_cache
 
11330     foreach path $pathlist {
 
11331         if {![info exists path_attr_cache($attr,$path)]} {
 
11332             lappend newlist $path
 
11336     if {[tk windowingsystem] == "win32"} {
 
11337         # windows has a 32k limit on the arguments to a command...
 
11340     while {$newlist ne {}} {
 
11341         set head [lrange $newlist 0 [expr {$lim - 1}]]
 
11342         set newlist [lrange $newlist $lim end]
 
11343         if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
 
11344             foreach row [split $rlist "\n"] {
 
11345                 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
 
11346                     if {[string index $path 0] eq "\""} {
 
11347                         set path [encoding convertfrom [lindex $path 0]]
 
11349                     set path_attr_cache($attr,$path) $value
 
11356 proc get_path_encoding {path} {
 
11357     global gui_encoding perfile_attrs
 
11358     set tcl_enc $gui_encoding
 
11359     if {$path ne {} && $perfile_attrs} {
 
11360         set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
 
11368 # First check that Tcl/Tk is recent enough
 
11369 if {[catch {package require Tk 8.4} err]} {
 
11370     show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
 
11371                      Gitk requires at least Tcl/Tk 8.4." list
 
11376 set wrcomcmd "git diff-tree --stdin -p --pretty"
 
11380     set gitencoding [exec git config --get i18n.commitencoding]
 
11383     set gitencoding [exec git config --get i18n.logoutputencoding]
 
11385 if {$gitencoding == ""} {
 
11386     set gitencoding "utf-8"
 
11388 set tclencoding [tcl_encoding $gitencoding]
 
11389 if {$tclencoding == {}} {
 
11390     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
 
11393 set gui_encoding [encoding system]
 
11395     set enc [exec git config --get gui.encoding]
 
11397         set tclenc [tcl_encoding $enc]
 
11398         if {$tclenc ne {}} {
 
11399             set gui_encoding $tclenc
 
11401             puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
 
11406 if {[tk windowingsystem] eq "aqua"} {
 
11407     set mainfont {{Lucida Grande} 9}
 
11408     set textfont {Monaco 9}
 
11409     set uifont {{Lucida Grande} 9 bold}
 
11411     set mainfont {Helvetica 9}
 
11412     set textfont {Courier 9}
 
11413     set uifont {Helvetica 9 bold}
 
11416 set findmergefiles 0
 
11424 set cmitmode "patch"
 
11425 set wrapcomment "none"
 
11430 set showlocalchanges 1
 
11432 set datetimeformat "%Y-%m-%d %H:%M:%S"
 
11435 set perfile_attrs 0
 
11438 if {[tk windowingsystem] eq "aqua"} {
 
11439     set extdifftool "opendiff"
 
11441     set extdifftool "meld"
 
11444 set colors {green red blue magenta darkgrey brown orange}
 
11445 if {[tk windowingsystem] eq "win32"} {
 
11446     set uicolor SystemButtonFace
 
11447     set bgcolor SystemWindow
 
11448     set fgcolor SystemButtonText
 
11449     set selectbgcolor SystemHighlight
 
11454     set selectbgcolor gray85
 
11456 set diffcolors {red "#00a000" blue}
 
11460 set markbgcolor "#e0e0ff"
 
11462 set circlecolors {white blue gray blue blue}
 
11464 # button for popping up context menus
 
11465 if {[tk windowingsystem] eq "aqua"} {
 
11466     set ctxbut <Button-2>
 
11468     set ctxbut <Button-3>
 
11471 ## For msgcat loading, first locate the installation location.
 
11472 if { [info exists ::env(GITK_MSGSDIR)] } {
 
11473     ## Msgsdir was manually set in the environment.
 
11474     set gitk_msgsdir $::env(GITK_MSGSDIR)
 
11476     ## Let's guess the prefix from argv0.
 
11477     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
 
11478     set gitk_libdir [file join $gitk_prefix share gitk lib]
 
11479     set gitk_msgsdir [file join $gitk_libdir msgs]
 
11483 ## Internationalization (i18n) through msgcat and gettext. See
 
11484 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
 
11485 package require msgcat
 
11486 namespace import ::msgcat::mc
 
11487 ## And eventually load the actual message catalog
 
11488 ::msgcat::mcload $gitk_msgsdir
 
11490 catch {source ~/.gitk}
 
11492 parsefont mainfont $mainfont
 
11493 eval font create mainfont [fontflags mainfont]
 
11494 eval font create mainfontbold [fontflags mainfont 1]
 
11496 parsefont textfont $textfont
 
11497 eval font create textfont [fontflags textfont]
 
11498 eval font create textfontbold [fontflags textfont 1]
 
11500 parsefont uifont $uifont
 
11501 eval font create uifont [fontflags uifont]
 
11507 # check that we can find a .git directory somewhere...
 
11508 if {[catch {set gitdir [gitdir]}]} {
 
11509     show_error {} . [mc "Cannot find a git repository here."]
 
11512 if {![file isdirectory $gitdir]} {
 
11513     show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
 
11518 set selectheadid {}
 
11521 set cmdline_files {}
 
11523 set revtreeargscmd {}
 
11524 foreach arg $argv {
 
11525     switch -glob -- $arg {
 
11528             set cmdline_files [lrange $argv [expr {$i + 1}] end]
 
11531         "--select-commit=*" {
 
11532             set selecthead [string range $arg 16 end]
 
11535             set revtreeargscmd [string range $arg 10 end]
 
11538             lappend revtreeargs $arg
 
11544 if {$selecthead eq "HEAD"} {
 
11548 if {$i >= [llength $argv] && $revtreeargs ne {}} {
 
11549     # no -- on command line, but some arguments (other than --argscmd)
 
11551         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
 
11552         set cmdline_files [split $f "\n"]
 
11553         set n [llength $cmdline_files]
 
11554         set revtreeargs [lrange $revtreeargs 0 end-$n]
 
11555         # Unfortunately git rev-parse doesn't produce an error when
 
11556         # something is both a revision and a filename.  To be consistent
 
11557         # with git log and git rev-list, check revtreeargs for filenames.
 
11558         foreach arg $revtreeargs {
 
11559             if {[file exists $arg]} {
 
11560                 show_error {} . [mc "Ambiguous argument '%s': both revision\
 
11561                                  and filename" $arg]
 
11566         # unfortunately we get both stdout and stderr in $err,
 
11567         # so look for "fatal:".
 
11568         set i [string first "fatal:" $err]
 
11570             set err [string range $err [expr {$i + 6}] end]
 
11572         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
 
11577 set nullid "0000000000000000000000000000000000000000"
 
11578 set nullid2 "0000000000000000000000000000000000000001"
 
11579 set nullfile "/dev/null"
 
11581 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
 
11582 if {![info exists have_ttk]} {
 
11583     set have_ttk [llength [info commands ::ttk::style]]
 
11585 set use_ttk [expr {$have_ttk && $want_ttk}]
 
11586 set NS [expr {$use_ttk ? "ttk" : ""}]
 
11588 regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
 
11591 if {[package vcompare $git_version "1.6.6.2"] >= 0} {
 
11592     set show_notes "--show-notes"
 
11600 set highlight_paths {}
 
11602 set searchdirn -forwards
 
11605 set diffelide {0 0}
 
11606 set markingmatches 0
 
11607 set linkentercount 0
 
11608 set need_redisplay 0
 
11615 set selectedhlview [mc "None"]
 
11616 set highlight_related [mc "None"]
 
11617 set highlight_files {}
 
11618 set viewfiles(0) {}
 
11621 set viewargscmd(0) {}
 
11623 set selectedline {}
 
11631 set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
 
11635     image create photo gitlogo      -width 16 -height 16
 
11637     image create photo gitlogominus -width  4 -height  2
 
11638     gitlogominus put #C00000 -to 0 0 4 2
 
11639     gitlogo copy gitlogominus -to  1 5
 
11640     gitlogo copy gitlogominus -to  6 5
 
11641     gitlogo copy gitlogominus -to 11 5
 
11642     image delete gitlogominus
 
11644     image create photo gitlogoplus  -width  4 -height  4
 
11645     gitlogoplus  put #008000 -to 1 0 3 4
 
11646     gitlogoplus  put #008000 -to 0 1 4 3
 
11647     gitlogo copy gitlogoplus  -to  1 9
 
11648     gitlogo copy gitlogoplus  -to  6 9
 
11649     gitlogo copy gitlogoplus  -to 11 9
 
11650     image delete gitlogoplus
 
11652     image create photo gitlogo32    -width 32 -height 32
 
11653     gitlogo32 copy gitlogo -zoom 2 2
 
11655     wm iconphoto . -default gitlogo gitlogo32
 
11657 # wait for the window to become visible
 
11658 tkwait visibility .
 
11659 wm title . "[file tail $argv0]: [file tail [pwd]]"
 
11663 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
 
11664     # create a view for the files/dirs specified on the command line
 
11668     set viewname(1) [mc "Command line"]
 
11669     set viewfiles(1) $cmdline_files
 
11670     set viewargs(1) $revtreeargs
 
11671     set viewargscmd(1) $revtreeargscmd
 
11675     .bar.view entryconf [mca "Edit view..."] -state normal
 
11676     .bar.view entryconf [mca "Delete view"] -state normal
 
11679 if {[info exists permviews]} {
 
11680     foreach v $permviews {
 
11683         set viewname($n) [lindex $v 0]
 
11684         set viewfiles($n) [lindex $v 1]
 
11685         set viewargs($n) [lindex $v 2]
 
11686         set viewargscmd($n) [lindex $v 3]
 
11692 if {[tk windowingsystem] eq "win32"} {
 
11700 # indent-tabs-mode: t