![[tokkee]](http://tokkee.org/images/avatar.png){kind=avatar}
index bf6eb0132ba06c5c7001970fce3e2426187d48fd..58ad47d18370b17e837174c73bbc5b76fd2da42c 100755 (executable)
--- a/gitk
+++ b/gitk
# Tcl ignores the next line -*- tcl -*- \
exec wish "$0" -- "$@"
-# Copyright (C) 2005-2006 Paul Mackerras. All rights reserved.
+# Copyright © 2005-2008 Paul Mackerras. All rights reserved.
# This program is free software; it may be used, copied, modified
# and distributed under the terms of the GNU General Public Licence,
# either version 2, or (at your option) any later version.
# run before X event handlers, so reading from a fast source can
# make the GUI completely unresponsive.
proc run args {
- global isonrunq runq
+ global isonrunq runq currunq
set script $args
if {[info exists isonrunq($script)]} return
- if {$runq eq {}} {
+ if {$runq eq {} && ![info exists currunq]} {
after idle dorunq
}
lappend runq [list {} $script]
}
proc filereadable {fd script} {
- global runq
+ global runq currunq
fileevent $fd readable {}
- if {$runq eq {}} {
+ if {$runq eq {} && ![info exists currunq]} {
after idle dorunq
}
lappend runq [list $fd $script]
}
proc dorunq {} {
- global isonrunq runq
+ global isonrunq runq currunq
set tstart [clock clicks -milliseconds]
set t0 $tstart
while {[llength $runq] > 0} {
set fd [lindex $runq 0 0]
set script [lindex $runq 0 1]
+ set currunq [lindex $runq 0]
+ set runq [lrange $runq 1 end]
set repeat [eval $script]
+ unset currunq
set t1 [clock clicks -milliseconds]
set t [expr {$t1 - $t0}]
- set runq [lrange $runq 1 end]
if {$repeat ne {} && $repeat} {
if {$fd eq {} || $repeat == 2} {
# script returns 1 if it wants to be readded
}
}
+proc reg_instance {fd} {
+ global commfd leftover loginstance
+
+ set i [incr loginstance]
+ set commfd($i) $fd
+ set leftover($i) {}
+ return $i
+}
+
+proc unmerged_files {files} {
+ global nr_unmerged
+
+ # find the list of unmerged files
+ set mlist {}
+ set nr_unmerged 0
+ if {[catch {
+ set fd [open "| git ls-files -u" r]
+ } err]} {
+ show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
+ exit 1
+ }
+ while {[gets $fd line] >= 0} {
+ set i [string first "\t" $line]
+ if {$i < 0} continue
+ set fname [string range $line [expr {$i+1}] end]
+ if {[lsearch -exact $mlist $fname] >= 0} continue
+ incr nr_unmerged
+ if {$files eq {} || [path_filter $files $fname]} {
+ lappend mlist $fname
+ }
+ }
+ catch {close $fd}
+ return $mlist
+}
+
+proc parseviewargs {n arglist} {
+ global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs
+
+ set vdatemode($n) 0
+ set vmergeonly($n) 0
+ set glflags {}
+ set diffargs {}
+ set nextisval 0
+ set revargs {}
+ set origargs $arglist
+ set allknown 1
+ set filtered 0
+ set i -1
+ foreach arg $arglist {
+ incr i
+ if {$nextisval} {
+ lappend glflags $arg
+ set nextisval 0
+ continue
+ }
+ switch -glob -- $arg {
+ "-d" -
+ "--date-order" {
+ set vdatemode($n) 1
+ # remove from origargs in case we hit an unknown option
+ set origargs [lreplace $origargs $i $i]
+ incr i -1
+ }
+ # These request or affect diff output, which we don't want.
+ # Some could be used to set our defaults for diff display.
+ "-[puabwcrRBMC]" -
+ "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
+ "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
+ "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
+ "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
+ "--ignore-space-change" - "-U*" - "--unified=*" {
+ lappend diffargs $arg
+ }
+ # These cause our parsing of git log's output to fail, or else
+ # they're options we want to set ourselves, so ignore them.
+ "--raw" - "--patch-with-raw" - "--patch-with-stat" -
+ "--name-only" - "--name-status" - "--color" - "--color-words" -
+ "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
+ "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
+ "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
+ "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
+ "--objects" - "--objects-edge" - "--reverse" {
+ }
+ # These are harmless, and some are even useful
+ "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
+ "--check" - "--exit-code" - "--quiet" - "--topo-order" -
+ "--full-history" - "--dense" - "--sparse" -
+ "--follow" - "--left-right" - "--encoding=*" {
+ lappend glflags $arg
+ }
+ # These mean that we get a subset of the commits
+ "--diff-filter=*" - "--no-merges" - "--unpacked" -
+ "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
+ "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
+ "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
+ "--remove-empty" - "--first-parent" - "--cherry-pick" -
+ "-S*" - "--pickaxe-all" - "--pickaxe-regex" - {
+ set filtered 1
+ lappend glflags $arg
+ }
+ # This appears to be the only one that has a value as a
+ # separate word following it
+ "-n" {
+ set filtered 1
+ set nextisval 1
+ lappend glflags $arg
+ }
+ "--not" {
+ set notflag [expr {!$notflag}]
+ lappend revargs $arg
+ }
+ "--all" {
+ lappend revargs $arg
+ }
+ "--merge" {
+ set vmergeonly($n) 1
+ # git rev-parse doesn't understand --merge
+ lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
+ }
+ # Other flag arguments including -<n>
+ "-*" {
+ if {[string is digit -strict [string range $arg 1 end]]} {
+ set filtered 1
+ } else {
+ # a flag argument that we don't recognize;
+ # that means we can't optimize
+ set allknown 0
+ }
+ lappend glflags $arg
+ }
+ # Non-flag arguments specify commits or ranges of commits
+ default {
+ if {[string match "*...*" $arg]} {
+ lappend revargs --gitk-symmetric-diff-marker
+ }
+ lappend revargs $arg
+ }
+ }
+ }
+ set vdflags($n) $diffargs
+ set vflags($n) $glflags
+ set vrevs($n) $revargs
+ set vfiltered($n) $filtered
+ set vorigargs($n) $origargs
+ return $allknown
+}
+
+proc parseviewrevs {view revs} {
+ global vposids vnegids
+
+ if {$revs eq {}} {
+ set revs HEAD
+ }
+ if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
+ # we get stdout followed by stderr in $err
+ # for an unknown rev, git rev-parse echoes it and then errors out
+ set errlines [split $err "\n"]
+ set badrev {}
+ for {set l 0} {$l < [llength $errlines]} {incr l} {
+ set line [lindex $errlines $l]
+ if {!([string length $line] == 40 && [string is xdigit $line])} {
+ if {[string match "fatal:*" $line]} {
+ if {[string match "fatal: ambiguous argument*" $line]
+ && $badrev ne {}} {
+ if {[llength $badrev] == 1} {
+ set err "unknown revision $badrev"
+ } else {
+ set err "unknown revisions: [join $badrev ", "]"
+ }
+ } else {
+ set err [join [lrange $errlines $l end] "\n"]
+ }
+ break
+ }
+ lappend badrev $line
+ }
+ }
+ error_popup "[mc "Error parsing revisions:"] $err"
+ return {}
+ }
+ set ret {}
+ set pos {}
+ set neg {}
+ set sdm 0
+ foreach id [split $ids "\n"] {
+ if {$id eq "--gitk-symmetric-diff-marker"} {
+ set sdm 4
+ } elseif {[string match "^*" $id]} {
+ if {$sdm != 1} {
+ lappend ret $id
+ if {$sdm == 3} {
+ set sdm 0
+ }
+ }
+ lappend neg [string range $id 1 end]
+ } else {
+ if {$sdm != 2} {
+ lappend ret $id
+ } else {
+ lset ret end [lindex $ret end]...$id
+ }
+ lappend pos $id
+ }
+ incr sdm -1
+ }
+ set vposids($view) $pos
+ set vnegids($view) $neg
+ return $ret
+}
+
# Start off a git log process and arrange to read its output
proc start_rev_list {view} {
- global startmsecs
- global commfd leftover tclencoding datemode
- global viewargs viewargscmd viewfiles commitidx viewcomplete
- global showlocalchanges commitinterest mainheadid
- global progressdirn progresscoords proglastnc curview
- global viewactive loginstance viewinstances
- global pending_select mainheadid
+ global startmsecs commitidx viewcomplete curview
+ global tclencoding
+ global viewargs viewargscmd viewfiles vfilelimit
+ global showlocalchanges
+ global viewactive viewinstances vmergeonly
+ global mainheadid
+ global vcanopt vflags vrevs vorigargs
set startmsecs [clock clicks -milliseconds]
set commitidx($view) 0
- set viewcomplete($view) 0
- set viewactive($view) 1
+ # these are set this way for the error exits
+ set viewcomplete($view) 1
+ set viewactive($view) 0
varcinit $view
set args $viewargs($view)
if {[catch {
set str [exec sh -c $viewargscmd($view)]
} err]} {
- error_popup "Error executing --argscmd command: $err"
- exit 1
+ error_popup "[mc "Error executing --argscmd command:"] $err"
+ return 0
}
set args [concat $args [split $str "\n"]]
}
+ set vcanopt($view) [parseviewargs $view $args]
+
+ set files $viewfiles($view)
+ if {$vmergeonly($view)} {
+ set files [unmerged_files $files]
+ if {$files eq {}} {
+ global nr_unmerged
+ if {$nr_unmerged == 0} {
+ error_popup [mc "No files selected: --merge specified but\
+ no files are unmerged."]
+ } else {
+ error_popup [mc "No files selected: --merge specified but\
+ no unmerged files are within file limit."]
+ }
+ return 0
+ }
+ }
+ set vfilelimit($view) $files
+
+ if {$vcanopt($view)} {
+ set revs [parseviewrevs $view $vrevs($view)]
+ if {$revs eq {}} {
+ return 0
+ }
+ set args [concat $vflags($view) $revs]
+ } else {
+ set args $vorigargs($view)
+ }
+
if {[catch {
set fd [open [concat | git log --no-color -z --pretty=raw --parents \
- --boundary $args "--" $viewfiles($view)] r]
+ --boundary $args "--" $files] r]
} err]} {
error_popup "[mc "Error executing git log:"] $err"
- exit 1
+ return 0
}
- set i [incr loginstance]
+ set i [reg_instance $fd]
set viewinstances($view) [list $i]
- set commfd($i) $fd
- set leftover($i) {}
- if {$showlocalchanges} {
- lappend commitinterest($mainheadid) {dodiffindex}
+ if {$showlocalchanges && $mainheadid ne {}} {
+ interestedin $mainheadid dodiffindex
}
fconfigure $fd -blocking 0 -translation lf -eofchar {}
if {$tclencoding != {}} {
}
filerun $fd [list getcommitlines $fd $i $view 0]
nowbusy $view [mc "Reading"]
- if {$view == $curview} {
- set progressdirn 1
- set progresscoords {0 0}
- set proglastnc 0
- set pending_select $mainheadid
+ set viewcomplete($view) 0
+ set viewactive($view) 1
+ return 1
+}
+
+proc stop_instance {inst} {
+ global commfd leftover
+
+ set fd $commfd($inst)
+ catch {
+ set pid [pid $fd]
+
+ if {$::tcl_platform(platform) eq {windows}} {
+ exec kill -f $pid
+ } else {
+ exec kill $pid
+ }
+ }
+ catch {close $fd}
+ nukefile $fd
+ unset commfd($inst)
+ unset leftover($inst)
+}
+
+proc stop_backends {} {
+ global commfd
+
+ foreach inst [array names commfd] {
+ stop_instance $inst
}
}
proc stop_rev_list {view} {
- global commfd viewinstances leftover
+ global viewinstances
foreach inst $viewinstances($view) {
- set fd $commfd($inst)
- catch {
- set pid [pid $fd]
- exec kill $pid
- }
- catch {close $fd}
- nukefile $fd
- unset commfd($inst)
- unset leftover($inst)
+ stop_instance $inst
}
set viewinstances($view) {}
}
-proc getcommits {} {
- global canv curview need_redisplay
+proc reset_pending_select {selid} {
+ global pending_select mainheadid selectheadid
+
+ if {$selid ne {}} {
+ set pending_select $selid
+ } elseif {$selectheadid ne {}} {
+ set pending_select $selectheadid
+ } else {
+ set pending_select $mainheadid
+ }
+}
+
+proc getcommits {selid} {
+ global canv curview need_redisplay viewactive
initlayout
- start_rev_list $curview
- show_status [mc "Reading commits..."]
- set need_redisplay 1
+ if {[start_rev_list $curview]} {
+ reset_pending_select $selid
+ show_status [mc "Reading commits..."]
+ set need_redisplay 1
+ } else {
+ show_status [mc "No commits selected"]
+ }
}
proc updatecommits {} {
- global curview viewargs viewfiles viewinstances
- global viewactive viewcomplete loginstance tclencoding mainheadid
- global startmsecs commfd showneartags showlocalchanges leftover
+ global curview vcanopt vorigargs vfilelimit viewinstances
+ global viewactive viewcomplete tclencoding
+ global startmsecs showneartags showlocalchanges
global mainheadid pending_select
global isworktree
+ global varcid vposids vnegids vflags vrevs
set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
set oldmainid $mainheadid
}
}
set view $curview
+ if {$vcanopt($view)} {
+ set oldpos $vposids($view)
+ set oldneg $vnegids($view)
+ set revs [parseviewrevs $view $vrevs($view)]
+ if {$revs eq {}} {
+ return
+ }
+ # note: getting the delta when negative refs change is hard,
+ # and could require multiple git log invocations, so in that
+ # case we ask git log for all the commits (not just the delta)
+ if {$oldneg eq $vnegids($view)} {
+ set newrevs {}
+ set npos 0
+ # take out positive refs that we asked for before or
+ # that we have already seen
+ foreach rev $revs {
+ if {[string length $rev] == 40} {
+ if {[lsearch -exact $oldpos $rev] < 0
+ && ![info exists varcid($view,$rev)]} {
+ lappend newrevs $rev
+ incr npos
+ }
+ } else {
+ lappend $newrevs $rev
+ }
+ }
+ if {$npos == 0} return
+ set revs $newrevs
+ set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
+ }
+ set args [concat $vflags($view) $revs --not $oldpos]
+ } else {
+ set args $vorigargs($view)
+ }
if {[catch {
set fd [open [concat | git log --no-color -z --pretty=raw --parents \
- --boundary $viewargs($view) --not [seeds $view] \
- "--" $viewfiles($view)] r]
+ --boundary $args "--" $vfilelimit($view)] r]
} err]} {
- error_popup "Error executing git log: $err"
- exit 1
+ error_popup "[mc "Error executing git log:"] $err"
+ return
}
if {$viewactive($view) == 0} {
set startmsecs [clock clicks -milliseconds]
}
- set i [incr loginstance]
+ set i [reg_instance $fd]
lappend viewinstances($view) $i
- set commfd($i) $fd
- set leftover($i) {}
fconfigure $fd -blocking 0 -translation lf -eofchar {}
if {$tclencoding != {}} {
fconfigure $fd -encoding $tclencoding
filerun $fd [list getcommitlines $fd $i $view 1]
incr viewactive($view)
set viewcomplete($view) 0
- set pending_select $mainheadid
+ reset_pending_select {}
nowbusy $view "Reading"
if {$showneartags} {
getallcommits
proc reloadcommits {} {
global curview viewcomplete selectedline currentid thickerline
global showneartags treediffs commitinterest cached_commitrow
- global progresscoords targetid
+ global targetid
+
+ set selid {}
+ if {$selectedline ne {}} {
+ set selid $currentid
+ }
if {!$viewcomplete($curview)} {
stop_rev_list $curview
- set progresscoords {0 0}
- adjustprogress
}
resetvarcs $curview
- catch {unset selectedline}
+ set selectedline {}
catch {unset currentid}
catch {unset thickerline}
catch {unset treediffs}
catch {unset cached_commitrow}
catch {unset targetid}
setcanvscroll
- getcommits
+ getcommits $selid
return 0
}
}
proc newvarc {view id} {
- global varcid varctok parents children datemode
+ global varcid varctok parents children vdatemode
global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
global commitdata commitinfo vseedcount varccommits vlastins
set a [llength $varctok($view)]
set vid $view,$id
- if {[llength $children($vid)] == 0 || $datemode} {
+ if {[llength $children($vid)] == 0 || $vdatemode($view)} {
if {![info exists commitinfo($id)]} {
parsecommit $id $commitdata($id) 1
}
proc renumbervarc {a v} {
global parents children varctok varcstart varccommits
- global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod datemode
+ global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
set t1 [clock clicks -milliseconds]
set todo {}
$children($v,$id)]
}
set oldtok [lindex $varctok($v) $a]
- if {!$datemode} {
+ if {!$vdatemode($v)} {
set tok {}
} else {
set tok $oldtok
modify_arc $v $a $i
if {[info exist currentid] && $id eq $currentid} {
unset currentid
- unset selectedline
+ set selectedline {}
}
if {[info exists targetid] && $targetid eq $id} {
set targetid $p
proc closevarcs {v} {
global varctok varccommits varcid parents children
- global cmitlisted commitidx commitinterest vtokmod
+ global cmitlisted commitidx vtokmod
set missing_parents 0
set scripts {}
}
lappend varccommits($v,$b) $p
incr commitidx($v)
- if {[info exists commitinterest($p)]} {
- foreach script $commitinterest($p) {
- lappend scripts [string map [list "%I" $p] $script]
- }
- unset commitinterest($id)
- }
+ set scripts [check_interest $p $scripts]
}
}
if {$missing_parents > 0} {
}
}
+# Mechanism for registering a command to be executed when we come
+# across a particular commit. To handle the case when only the
+# prefix of the commit is known, the commitinterest array is now
+# indexed by the first 4 characters of the ID. Each element is a
+# list of id, cmd pairs.
+proc interestedin {id cmd} {
+ global commitinterest
+
+ lappend commitinterest([string range $id 0 3]) $id $cmd
+}
+
+proc check_interest {id scripts} {
+ global commitinterest
+
+ set prefix [string range $id 0 3]
+ if {[info exists commitinterest($prefix)]} {
+ set newlist {}
+ foreach {i script} $commitinterest($prefix) {
+ if {[string match "$i*" $id]} {
+ lappend scripts [string map [list "%I" $id "%P" $i] $script]
+ } else {
+ lappend newlist $i $script
+ }
+ }
+ if {$newlist ne {}} {
+ set commitinterest($prefix) $newlist
+ } else {
+ unset commitinterest($prefix)
+ }
+ }
+ return $scripts
+}
+
proc getcommitlines {fd inst view updating} {
- global cmitlisted commitinterest leftover
- global commitidx commitdata datemode
+ global cmitlisted leftover
+ global commitidx commitdata vdatemode
global parents children curview hlview
global idpending ordertok
- global varccommits varcid varctok vtokmod viewfiles
+ global varccommits varcid varctok vtokmod vfilelimit
set stuff [read $fd 500000]
# git log doesn't terminate the last commit with a null...
if {![eof $fd]} {
return 1
}
- global commfd viewcomplete viewactive viewname progresscoords
+ global commfd viewcomplete viewactive viewname
global viewinstances
unset commfd($inst)
set i [lsearch -exact $viewinstances($view) $inst]
# appeared in the list
closevarcs $view
notbusy $view
- set progresscoords {0 0}
- adjustprogress
}
if {$view == $curview} {
run chewcommits
set vid $view,$id
if {!$listed && $updating && ![info exists varcid($vid)] &&
- $viewfiles($view) ne {}} {
+ $vfilelimit($view) ne {}} {
# git log doesn't rewrite parents for unlisted commits
# when doing path limiting, so work around that here
# by working out the rewritten parent with git rev-list
# parent as a substitute parent for $id's children.
if {![catch {
set rwid [exec git rev-list --first-parent --max-count=1 \
- $id -- $viewfiles($view)]
+ $id -- $vfilelimit($view)]
}]} {
if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
# use $rwid in place of $id
} elseif {$a == 0 && [llength $children($vid)] == 1} {
set k [lindex $children($vid) 0]
if {[llength $parents($view,$k)] == 1 &&
- (!$datemode ||
+ (!$vdatemode($view) ||
$varcid($view,$k) == [llength $varctok($view)] - 1)} {
set a $varcid($view,$k)
}
incr i
}
- if {[info exists commitinterest($id)]} {
- foreach script $commitinterest($id) {
- lappend scripts [string map [list "%I" $id] $script]
- }
- unset commitinterest($id)
- }
+ set scripts [check_interest $id $scripts]
set gotsome 1
}
if {$gotsome} {
foreach s $scripts {
eval $s
}
- if {$view == $curview} {
- # update progress bar
- global progressdirn progresscoords proglastnc
- set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
- set proglastnc $commitidx($view)
- set l [lindex $progresscoords 0]
- set r [lindex $progresscoords 1]
- if {$progressdirn} {
- set r [expr {$r + $inc}]
- if {$r >= 1.0} {
- set r 1.0
- set progressdirn 0
- }
- if {$r > 0.2} {
- set l [expr {$r - 0.2}]
- }
- } else {
- set l [expr {$l - $inc}]
- if {$l <= 0.0} {
- set l 0.0
- set progressdirn 1
- }
- set r [expr {$l + 0.2}]
- }
- set progresscoords [list $l $r]
- adjustprogress
- }
}
return 2
}
if {$viewcomplete($curview)} {
global commitidx varctok
global numcommits startmsecs
- global mainheadid nullid
if {[info exists pending_select]} {
- set row [first_real_row]
- selectline $row 1
+ update
+ reset_pending_select {}
+
+ if {[commitinview $pending_select $curview]} {
+ selectline [rowofcommit $pending_select] 1
+ } else {
+ set row [first_real_row]
+ selectline $row 1
+ }
}
if {$commitidx($curview) > 0} {
#set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
return 1
}
+# Expand an abbreviated commit ID to a list of full 40-char IDs that match
+# and are present in the current view.
+# This is fairly slow...
+proc longid {prefix} {
+ global varcid curview
+
+ set ids {}
+ foreach match [array names varcid "$curview,$prefix*"] {
+ lappend ids [lindex [split $match ","] 1]
+ }
+ return $ids
+}
+
proc readrefs {} {
global tagids idtags headids idheads tagobjid
global otherrefids idotherrefs mainhead mainheadid
+ global selecthead selectheadid
foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
catch {unset $v}
set mainhead {}
set mainheadid {}
catch {
+ set mainheadid [exec git rev-parse HEAD]
set thehead [exec git symbolic-ref HEAD]
if {[string match "refs/heads/*" $thehead]} {
set mainhead [string range $thehead 11 end]
- if {[info exists headids($mainhead)]} {
- set mainheadid $headids($mainhead)
- }
+ }
+ }
+ set selectheadid {}
+ if {$selecthead ne {}} {
+ catch {
+ set selectheadid [exec git rev-parse --verify $selecthead]
}
}
}
pack $w.ok -side bottom -fill x
bind $top <Visibility> "grab $top; focus $top"
bind $top <Key-Return> "destroy $top"
+ bind $top <Key-space> "destroy $top"
+ bind $top <Key-Escape> "destroy $top"
tkwait window $top
}
-proc error_popup msg {
+proc error_popup {msg {owner .}} {
set w .error
toplevel $w
- wm transient $w .
+ wm transient $w $owner
show_error $w $w $msg
}
-proc confirm_popup msg {
+proc confirm_popup {msg {owner .}} {
global confirm_ok
set confirm_ok 0
set w .confirm
toplevel $w
- wm transient $w .
+ wm transient $w $owner
message $w.m -text $msg -justify center -aspect 400
pack $w.m -side top -fill x -padx 20 -pady 20
button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
button $w.cancel -text [mc Cancel] -command "destroy $w"
pack $w.cancel -side right -fill x
bind $w <Visibility> "grab $w; focus $w"
+ bind $w <Key-Return> "set confirm_ok 1; destroy $w"
+ bind $w <Key-space> "set confirm_ok 1; destroy $w"
+ bind $w <Key-Escape> "destroy $w"
tkwait window $w
return $confirm_ok
}
option add *Entry.font uifont startupFile
}
+# Make a menu and submenus.
+# m is the window name for the menu, items is the list of menu items to add.
+# Each item is a list {mc label type description options...}
+# mc is ignored; it's so we can put mc there to alert xgettext
+# label is the string that appears in the menu
+# type is cascade, command or radiobutton (should add checkbutton)
+# description depends on type; it's the sublist for cascade, the
+# command to invoke for command, or {variable value} for radiobutton
+proc makemenu {m items} {
+ menu $m
+ foreach i $items {
+ set name [mc [lindex $i 1]]
+ set type [lindex $i 2]
+ set thing [lindex $i 3]
+ set params [list $type]
+ if {$name ne {}} {
+ set u [string first "&" [string map {&& x} $name]]
+ lappend params -label [string map {&& & & {}} $name]
+ if {$u >= 0} {
+ lappend params -underline $u
+ }
+ }
+ switch -- $type {
+ "cascade" {
+ set submenu [string tolower [string map {& ""} [lindex $i 1]]]
+ lappend params -menu $m.$submenu
+ }
+ "command" {
+ lappend params -command $thing
+ }
+ "radiobutton" {
+ lappend params -variable [lindex $thing 0] \
+ -value [lindex $thing 1]
+ }
+ }
+ eval $m add $params [lrange $i 4 end]
+ if {$type eq "cascade"} {
+ makemenu $m.$submenu $thing
+ }
+ }
+}
+
+# translate string and remove ampersands
+proc mca {str} {
+ return [string map {&& & & {}} [mc $str]]
+}
+
proc makewindow {} {
global canv canv2 canv3 linespc charspc ctext cflist cscroll
global tabstop
global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
global headctxmenu progresscanv progressitem progresscoords statusw
global fprogitem fprogcoord lastprogupdate progupdatepending
- global rprogitem rprogcoord
+ global rprogitem rprogcoord rownumsel numcommits
global have_tk85
- menu .bar
- .bar add cascade -label [mc "File"] -menu .bar.file
- menu .bar.file
- .bar.file add command -label [mc "Update"] -command updatecommits
- .bar.file add command -label [mc "Reload"] -command reloadcommits
- .bar.file add command -label [mc "Reread references"] -command rereadrefs
- .bar.file add command -label [mc "List references"] -command showrefs
- .bar.file add command -label [mc "Quit"] -command doquit
- menu .bar.edit
- .bar add cascade -label [mc "Edit"] -menu .bar.edit
- .bar.edit add command -label [mc "Preferences"] -command doprefs
-
- menu .bar.view
- .bar add cascade -label [mc "View"] -menu .bar.view
- .bar.view add command -label [mc "New view..."] -command {newview 0}
- .bar.view add command -label [mc "Edit view..."] -command editview \
- -state disabled
- .bar.view add command -label [mc "Delete view"] -command delview -state disabled
- .bar.view add separator
- .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
- -variable selectedview -value 0
-
- menu .bar.help
- .bar add cascade -label [mc "Help"] -menu .bar.help
- .bar.help add command -label [mc "About gitk"] -command about
- .bar.help add command -label [mc "Key bindings"] -command keys
- .bar.help configure
+ # The "mc" arguments here are purely so that xgettext
+ # sees the following string as needing to be translated
+ makemenu .bar {
+ {mc "File" cascade {
+ {mc "Update" command updatecommits -accelerator F5}
+ {mc "Reload" command reloadcommits}
+ {mc "Reread references" command rereadrefs}
+ {mc "List references" command showrefs}
+ {mc "Quit" command doquit}
+ }}
+ {mc "Edit" cascade {
+ {mc "Preferences" command doprefs}
+ }}
+ {mc "View" cascade {
+ {mc "New view..." command {newview 0}}
+ {mc "Edit view..." command editview -state disabled}
+ {mc "Delete view" command delview -state disabled}
+ {xx "" separator}
+ {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
+ }}
+ {mc "Help" cascade {
+ {mc "About gitk" command about}
+ {mc "Key bindings" command keys}
+ }}
+ }
. configure -menu .bar
# the gui has upper and lower half, parts of a paned window.
-state disabled -width 26
pack .tf.bar.rightbut -side left -fill y
+ label .tf.bar.rowlabel -text [mc "Row"]
+ set rownumsel {}
+ label .tf.bar.rownum -width 7 -font textfont -textvariable rownumsel \
+ -relief sunken -anchor e
+ label .tf.bar.rowlabel2 -text "/"
+ label .tf.bar.numcommits -width 7 -font textfont -textvariable numcommits \
+ -relief sunken -anchor e
+ pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
+ -side left
+ global selectedline
+ trace add variable selectedline write selectedline_change
+
# Status label and progress bar
set statusw .tf.bar.status
label $statusw -width 15 -relief sunken
bindkey k "selnextline 1"
bindkey j "goback"
bindkey l "goforw"
- bindkey b "$ctext yview scroll -1 pages"
+ bindkey b prevfile
bindkey d "$ctext yview scroll 18 units"
bindkey u "$ctext yview scroll -18 units"
bindkey / {dofind 1 1}
bind . <$M1B-minus> {incrfont -1}
bind . <$M1B-KP_Subtract> {incrfont -1}
wm protocol . WM_DELETE_WINDOW doquit
+ bind . <Destroy> {stop_backends}
bind . <Button-1> "click %W"
bind $fstring <Key-Return> {dofind 1 1}
- bind $sha1entry <Key-Return> gotocommit
+ bind $sha1entry <Key-Return> {gotocommit; break}
bind $sha1entry <<PasteSelection>> clearsha1
bind $cflist <1> {sel_flist %W %x %y; break}
bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
- bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
+ global ctxbut
+ bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
+ bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
set maincursor [. cget -cursor]
set textcursor [$ctext cget -cursor]
set curtextcursor $textcursor
set rowctxmenu .rowctxmenu
- menu $rowctxmenu -tearoff 0
- $rowctxmenu add command -label [mc "Diff this -> selected"] \
- -command {diffvssel 0}
- $rowctxmenu add command -label [mc "Diff selected -> this"] \
- -command {diffvssel 1}
- $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
- $rowctxmenu add command -label [mc "Create tag"] -command mktag
- $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
- $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
- $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
- -command cherrypick
- $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
- -command resethead
+ makemenu $rowctxmenu {
+ {mc "Diff this -> selected" command {diffvssel 0}}
+ {mc "Diff selected -> this" command {diffvssel 1}}
+ {mc "Make patch" command mkpatch}
+ {mc "Create tag" command mktag}
+ {mc "Write commit to file" command writecommit}
+ {mc "Create new branch" command mkbranch}
+ {mc "Cherry-pick this commit" command cherrypick}
+ {mc "Reset HEAD branch to here" command resethead}
+ }
+ $rowctxmenu configure -tearoff 0
set fakerowmenu .fakerowmenu
- menu $fakerowmenu -tearoff 0
- $fakerowmenu add command -label [mc "Diff this -> selected"] \
- -command {diffvssel 0}
- $fakerowmenu add command -label [mc "Diff selected -> this"] \
- -command {diffvssel 1}
- $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
-# $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
-# $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
-# $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
+ makemenu $fakerowmenu {
+ {mc "Diff this -> selected" command {diffvssel 0}}
+ {mc "Diff selected -> this" command {diffvssel 1}}
+ {mc "Make patch" command mkpatch}
+ }
+ $fakerowmenu configure -tearoff 0
set headctxmenu .headctxmenu
- menu $headctxmenu -tearoff 0
- $headctxmenu add command -label [mc "Check out this branch"] \
- -command cobranch
- $headctxmenu add command -label [mc "Remove this branch"] \
- -command rmbranch
+ makemenu $headctxmenu {
+ {mc "Check out this branch" command cobranch}
+ {mc "Remove this branch" command rmbranch}
+ }
+ $headctxmenu configure -tearoff 0
global flist_menu
set flist_menu .flistctxmenu
- menu $flist_menu -tearoff 0
- $flist_menu add command -label [mc "Highlight this too"] \
- -command {flist_hl 0}
- $flist_menu add command -label [mc "Highlight this only"] \
- -command {flist_hl 1}
+ makemenu $flist_menu {
+ {mc "Highlight this too" command {flist_hl 0}}
+ {mc "Highlight this only" command {flist_hl 1}}
+ {mc "External diff" command {external_diff}}
+ {mc "Blame parent commit" command {external_blame 1}}
+ }
+ $flist_menu configure -tearoff 0
+
+ global diff_menu
+ set diff_menu .diffctxmenu
+ makemenu $diff_menu {
+ {mc "Show origin of this line" command show_line_source}
+ {mc "Run git gui blame on this line" command {external_blame_diff}}
+ }
+ $diff_menu configure -tearoff 0
}
# Windows sends all mouse wheel events to the current focused window, not
}
}
+# Update row number label when selectedline changes
+proc selectedline_change {n1 n2 op} {
+ global selectedline rownumsel
+
+ if {$selectedline eq {}} {
+ set rownumsel {}
+ } else {
+ set rownumsel [expr {$selectedline + 1}]
+ }
+}
+
# mouse-2 makes all windows scan vertically, but only the one
# the cursor is in scans horizontally
proc canvscan {op w x y} {
global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
global cmitmode wrapcomment datetimeformat limitdiffs
global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
- global autoselect
+ global autoselect extdifftool perfile_attrs markbgcolor
if {$stuffsaved} return
if {![winfo viewable .]} return
puts $f [list set fgcolor $fgcolor]
puts $f [list set colors $colors]
puts $f [list set diffcolors $diffcolors]
+ puts $f [list set markbgcolor $markbgcolor]
puts $f [list set diffcontext $diffcontext]
puts $f [list set selectbgcolor $selectbgcolor]
+ puts $f [list set extdifftool $extdifftool]
+ puts $f [list set perfile_attrs $perfile_attrs]
puts $f "set geometry(main) [wm geometry .]"
puts $f "set geometry(topwidth) [winfo width .tf]"
}
toplevel $w
wm title $w [mc "About gitk"]
+ wm transient $w .
message $w.m -text [mc "
Gitk - a commit viewer for git
-Copyright © 2005-2006 Paul Mackerras
+Copyright © 2005-2008 Paul Mackerras
Use and redistribute under the terms of the GNU General Public License"] \
-justify center -aspect 400 -border 2 -bg white -relief groove
}
toplevel $w
wm title $w [mc "Gitk key bindings"]
+ wm transient $w .
message $w.m -text "
[mc "Gitk key bindings:"]
-justify left -bg white -border 2 -relief groove
pack $w.m -side top -fill both -padx 2 -pady 2
button $w.ok -text [mc "Close"] -command "destroy $w" -default active
+ bind $w <Key-Escape> [list destroy $w]
pack $w.ok -side bottom
bind $w <Visibility> "focus $w.ok"
bind $w <Key-Escape> "destroy $w"
$w insert e:$ix $e [highlight_tag $de]
}
}
- $w mark gravity e:$ix left
+ $w mark gravity e:$ix right
$w conf -state disabled
set treediropen($dir) 1
set top [lindex [split [$w index @0,0] .] 0]
}
proc setfilelist {id} {
- global treefilelist cflist
+ global treefilelist cflist jump_to_here
treeview $cflist $treefilelist($id) 0
+ if {$jump_to_here ne {}} {
+ set f [lindex $jump_to_here 0]
+ if {[lsearch -exact $treefilelist($id) $f] >= 0} {
+ showfile $f
+ }
+ }
}
image create bitmap tri-rt -background black -foreground blue -data {
$cflist conf -state disabled
}
-proc add_flist {fl} {
- global cflist
+proc add_flist {fl} {
+ global cflist
+
+ $cflist conf -state normal
+ foreach f $fl {
+ $cflist insert end "\n"
+ $cflist insert end $f [highlight_tag $f]
+ }
+ $cflist conf -state disabled
+}
+
+proc sel_flist {w x y} {
+ global ctext difffilestart cflist cflist_top cmitmode
+
+ if {$cmitmode eq "tree"} return
+ if {![info exists cflist_top]} return
+ set l [lindex [split [$w index "@$x,$y"] "."] 0]
+ $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
+ $cflist tag add highlight $l.0 "$l.0 lineend"
+ set cflist_top $l
+ if {$l == 1} {
+ $ctext yview 1.0
+ } else {
+ catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
+ }
+}
+
+proc pop_flist_menu {w X Y x y} {
+ global ctext cflist cmitmode flist_menu flist_menu_file
+ global treediffs diffids
+
+ stopfinding
+ set l [lindex [split [$w index "@$x,$y"] "."] 0]
+ if {$l <= 1} return
+ if {$cmitmode eq "tree"} {
+ set e [linetoelt $l]
+ if {[string index $e end] eq "/"} return
+ } else {
+ set e [lindex $treediffs($diffids) [expr {$l-2}]]
+ }
+ set flist_menu_file $e
+ set xdiffstate "normal"
+ if {$cmitmode eq "tree"} {
+ set xdiffstate "disabled"
+ }
+ # Disable "External diff" item in tree mode
+ $flist_menu entryconf 2 -state $xdiffstate
+ tk_popup $flist_menu $X $Y
+}
+
+proc find_ctext_fileinfo {line} {
+ global ctext_file_names ctext_file_lines
+
+ set ok [bsearch $ctext_file_lines $line]
+ set tline [lindex $ctext_file_lines $ok]
+
+ if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
+ return {}
+ } else {
+ return [list [lindex $ctext_file_names $ok] $tline]
+ }
+}
+
+proc pop_diff_menu {w X Y x y} {
+ global ctext diff_menu flist_menu_file
+ global diff_menu_txtpos diff_menu_line
+ global diff_menu_filebase
+
+ set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
+ set diff_menu_line [lindex $diff_menu_txtpos 0]
+ # don't pop up the menu on hunk-separator or file-separator lines
+ if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
+ return
+ }
+ stopfinding
+ set f [find_ctext_fileinfo $diff_menu_line]
+ if {$f eq {}} return
+ set flist_menu_file [lindex $f 0]
+ set diff_menu_filebase [lindex $f 1]
+ tk_popup $diff_menu $X $Y
+}
+
+proc flist_hl {only} {
+ global flist_menu_file findstring gdttype
+
+ set x [shellquote $flist_menu_file]
+ if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
+ set findstring $x
+ } else {
+ append findstring " " $x
+ }
+ set gdttype [mc "touching paths:"]
+}
+
+proc save_file_from_commit {filename output what} {
+ global nullfile
+
+ if {[catch {exec git show $filename -- > $output} err]} {
+ if {[string match "fatal: bad revision *" $err]} {
+ return $nullfile
+ }
+ error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
+ return {}
+ }
+ return $output
+}
+
+proc external_diff_get_one_file {diffid filename diffdir} {
+ global nullid nullid2 nullfile
+ global gitdir
+
+ if {$diffid == $nullid} {
+ set difffile [file join [file dirname $gitdir] $filename]
+ if {[file exists $difffile]} {
+ return $difffile
+ }
+ return $nullfile
+ }
+ if {$diffid == $nullid2} {
+ set difffile [file join $diffdir "\[index\] [file tail $filename]"]
+ return [save_file_from_commit :$filename $difffile index]
+ }
+ set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
+ return [save_file_from_commit $diffid:$filename $difffile \
+ "revision $diffid"]
+}
+
+proc external_diff {} {
+ global gitktmpdir nullid nullid2
+ global flist_menu_file
+ global diffids
+ global diffnum
+ global gitdir extdifftool
+
+ if {[llength $diffids] == 1} {
+ # no reference commit given
+ set diffidto [lindex $diffids 0]
+ if {$diffidto eq $nullid} {
+ # diffing working copy with index
+ set diffidfrom $nullid2
+ } elseif {$diffidto eq $nullid2} {
+ # diffing index with HEAD
+ set diffidfrom "HEAD"
+ } else {
+ # use first parent commit
+ global parentlist selectedline
+ set diffidfrom [lindex $parentlist $selectedline 0]
+ }
+ } else {
+ set diffidfrom [lindex $diffids 0]
+ set diffidto [lindex $diffids 1]
+ }
+
+ # make sure that several diffs wont collide
+ if {![info exists gitktmpdir]} {
+ set gitktmpdir [file join [file dirname $gitdir] \
+ [format ".gitk-tmp.%s" [pid]]]
+ if {[catch {file mkdir $gitktmpdir} err]} {
+ error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
+ unset gitktmpdir
+ return
+ }
+ set diffnum 0
+ }
+ incr diffnum
+ set diffdir [file join $gitktmpdir $diffnum]
+ if {[catch {file mkdir $diffdir} err]} {
+ error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
+ return
+ }
+
+ # gather files to diff
+ set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
+ set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
+
+ if {$difffromfile ne {} && $difftofile ne {}} {
+ set cmd [concat | [shellsplit $extdifftool] \
+ [list $difffromfile $difftofile]]
+ if {[catch {set fl [open $cmd r]} err]} {
+ file delete -force $diffdir
+ error_popup "$extdifftool: [mc "command failed:"] $err"
+ } else {
+ fconfigure $fl -blocking 0
+ filerun $fl [list delete_at_eof $fl $diffdir]
+ }
+ }
+}
+
+proc find_hunk_blamespec {base line} {
+ global ctext
+
+ # Find and parse the hunk header
+ set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
+ if {$s_lix eq {}} return
+
+ set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
+ if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
+ s_line old_specs osz osz1 new_line nsz]} {
+ return
+ }
+
+ # base lines for the parents
+ set base_lines [list $new_line]
+ foreach old_spec [lrange [split $old_specs " "] 1 end] {
+ if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
+ old_spec old_line osz]} {
+ return
+ }
+ lappend base_lines $old_line
+ }
+
+ # Now scan the lines to determine offset within the hunk
+ set max_parent [expr {[llength $base_lines]-2}]
+ set dline 0
+ set s_lno [lindex [split $s_lix "."] 0]
+
+ # Determine if the line is removed
+ set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
+ if {[string match {[-+ ]*} $chunk]} {
+ set removed_idx [string first "-" $chunk]
+ # Choose a parent index
+ if {$removed_idx >= 0} {
+ set parent $removed_idx
+ } else {
+ set unchanged_idx [string first " " $chunk]
+ if {$unchanged_idx >= 0} {
+ set parent $unchanged_idx
+ } else {
+ # blame the current commit
+ set parent -1
+ }
+ }
+ # then count other lines that belong to it
+ for {set i $line} {[incr i -1] > $s_lno} {} {
+ set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
+ # Determine if the line is removed
+ set removed_idx [string first "-" $chunk]
+ if {$parent >= 0} {
+ set code [string index $chunk $parent]
+ if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
+ incr dline
+ }
+ } else {
+ if {$removed_idx < 0} {
+ incr dline
+ }
+ }
+ }
+ incr parent
+ } else {
+ set parent 0
+ }
+
+ incr dline [lindex $base_lines $parent]
+ return [list $parent $dline]
+}
+
+proc external_blame_diff {} {
+ global currentid diffmergeid cmitmode
+ global diff_menu_txtpos diff_menu_line
+ global diff_menu_filebase flist_menu_file
+
+ if {$cmitmode eq "tree"} {
+ set parent_idx 0
+ set line [expr {$diff_menu_line - $diff_menu_filebase}]
+ } else {
+ set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
+ if {$hinfo ne {}} {
+ set parent_idx [lindex $hinfo 0]
+ set line [lindex $hinfo 1]
+ } else {
+ set parent_idx 0
+ set line 0
+ }
+ }
+
+ external_blame $parent_idx $line
+}
+
+proc external_blame {parent_idx {line {}}} {
+ global flist_menu_file
+ global nullid nullid2
+ global parentlist selectedline currentid
- $cflist conf -state normal
- foreach f $fl {
- $cflist insert end "\n"
- $cflist insert end $f [highlight_tag $f]
+ if {$parent_idx > 0} {
+ set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
+ } else {
+ set base_commit $currentid
}
- $cflist conf -state disabled
-}
-proc sel_flist {w x y} {
- global ctext difffilestart cflist cflist_top cmitmode
+ if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
+ error_popup [mc "No such commit"]
+ return
+ }
- if {$cmitmode eq "tree"} return
- if {![info exists cflist_top]} return
- set l [lindex [split [$w index "@$x,$y"] "."] 0]
- $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
- $cflist tag add highlight $l.0 "$l.0 lineend"
- set cflist_top $l
- if {$l == 1} {
- $ctext yview 1.0
- } else {
- catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
+ set cmdline [list git gui blame]
+ if {$line ne {} && $line > 1} {
+ lappend cmdline "--line=$line"
+ }
+ lappend cmdline $base_commit $flist_menu_file
+ if {[catch {eval exec $cmdline &} err]} {
+ error_popup "[mc "git gui blame: command failed:"] $err"
}
}
-proc pop_flist_menu {w X Y x y} {
- global ctext cflist cmitmode flist_menu flist_menu_file
- global treediffs diffids
+proc show_line_source {} {
+ global cmitmode currentid parents curview blamestuff blameinst
+ global diff_menu_line diff_menu_filebase flist_menu_file
- stopfinding
- set l [lindex [split [$w index "@$x,$y"] "."] 0]
- if {$l <= 1} return
if {$cmitmode eq "tree"} {
- set e [linetoelt $l]
- if {[string index $e end] eq "/"} return
+ set id $currentid
+ set line [expr {$diff_menu_line - $diff_menu_filebase}]
} else {
- set e [lindex $treediffs($diffids) [expr {$l-2}]]
+ set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
+ if {$h eq {}} return
+ set pi [lindex $h 0]
+ if {$pi == 0} {
+ mark_ctext_line $diff_menu_line
+ return
+ }
+ set id [lindex $parents($curview,$currentid) [expr {$pi - 1}]]
+ set line [lindex $h 1]
}
- set flist_menu_file $e
- tk_popup $flist_menu $X $Y
+ if {[catch {
+ set f [open [list | git blame -p -L$line,+1 $id -- $flist_menu_file] r]
+ } err]} {
+ error_popup [mc "Couldn't start git blame: %s" $err]
+ return
+ }
+ fconfigure $f -blocking 0
+ set i [reg_instance $f]
+ set blamestuff($i) {}
+ set blameinst $i
+ filerun $f [list read_line_source $f $i]
}
-proc flist_hl {only} {
- global flist_menu_file findstring gdttype
+proc stopblaming {} {
+ global blameinst
- set x [shellquote $flist_menu_file]
- if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
- set findstring $x
+ if {[info exists blameinst]} {
+ stop_instance $blameinst
+ unset blameinst
+ }
+}
+
+proc read_line_source {fd inst} {
+ global blamestuff curview commfd blameinst
+
+ while {[gets $fd line] >= 0} {
+ lappend blamestuff($inst) $line
+ }
+ if {![eof $fd]} {
+ return 1
+ }
+ unset commfd($inst)
+ unset blameinst
+ fconfigure $fd -blocking 1
+ if {[catch {close $fd} err]} {
+ error_popup [mc "Error running git blame: %s" $err]
+ return 0
+ }
+
+ set fname {}
+ set line [split [lindex $blamestuff($inst) 0] " "]
+ set id [lindex $line 0]
+ set lnum [lindex $line 1]
+ if {[string length $id] == 40 && [string is xdigit $id] &&
+ [string is digit -strict $lnum]} {
+ # look for "filename" line
+ foreach l $blamestuff($inst) {
+ if {[string match "filename *" $l]} {
+ set fname [string range $l 9 end]
+ break
+ }
+ }
+ }
+ if {$fname ne {}} {
+ # all looks good, select it
+ if {[commitinview $id $curview]} {
+ selectline [rowofcommit $id] 1 [list $fname $lnum]
+ } else {
+ error_popup [mc "That line comes from commit %s, \
+ which is not in this view" [shortids $id]]
+ }
} else {
- append findstring " " $x
+ puts "oops couldn't parse git blame output"
}
- set gdttype [mc "touching paths:"]
+ return 0
+}
+
+# delete $dir when we see eof on $f (presumably because the child has exited)
+proc delete_at_eof {f dir} {
+ while {[gets $f line] >= 0} {}
+ if {[eof $f]} {
+ if {[catch {close $f} err]} {
+ error_popup "[mc "External diff viewer failed:"] $err"
+ }
+ file delete -force $dir
+ return 0
+ }
+ return 1
}
# Functions for adding and removing shell-type quoting
toplevel $top
wm title $top $title
+ wm transient $top .
label $top.nl -text [mc "Name"]
entry $top.name -width 20 -textvariable newviewname($n)
grid $top.nl $top.name -sticky w -pady 5
frame $top.buts
button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
+ bind $top <Escape> [list destroy $top]
grid $top.buts.ok $top.buts.can
grid columnconfigure $top.buts 0 -weight 1 -uniform a
grid columnconfigure $top.buts 1 -weight 1 -uniform a
if {[catch {
set newargs [shellsplit $newviewargs($n)]
} err]} {
- error_popup "[mc "Error in commit selection arguments:"] $err"
- wm raise $top
- focus $top
+ error_popup "[mc "Error in commit selection arguments:"] $err" $top
return
}
set files {}
}
proc showview {n} {
- global curview viewfiles cached_commitrow ordertok
+ global curview cached_commitrow ordertok
global displayorder parentlist rowidlist rowisopt rowfinal
global colormap rowtextx nextcolor canvxmax
global numcommits viewcomplete
set ytop [expr {[lindex $span 0] * $ymax}]
set ybot [expr {[lindex $span 1] * $ymax}]
set yscreen [expr {($ybot - $ytop) / 2}]
- if {[info exists selectedline]} {
+ if {$selectedline ne {}} {
set selid $currentid
set y [yc $selectedline]
if {$ytop < $y && $y < $ybot} {
set curview $n
set selectedview $n
- .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
- .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
+ .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
+ .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
run refill_reflist
if {![info exists viewcomplete($n)]} {
- if {$selid ne {}} {
- set pending_select $selid
- }
- getcommits
+ getcommits $selid
return
}
drawvisible
if {$row ne {}} {
selectline $row 0
- } elseif {$mainheadid ne {} && [commitinview $mainheadid $curview]} {
- selectline [rowofcommit $mainheadid] 1
} elseif {!$viewcomplete($n)} {
- if {$selid ne {}} {
- set pending_select $selid
- } else {
- set pending_select $mainheadid
- }
+ reset_pending_select $selid
} else {
- set row [first_real_row]
- if {$row < $numcommits} {
- selectline $row 0
+ reset_pending_select {}
+
+ if {[commitinview $pending_select $curview]} {
+ selectline [rowofcommit $pending_select] 1
+ } else {
+ set row [first_real_row]
+ if {$row < $numcommits} {
+ selectline $row 0
+ }
}
}
if {!$viewcomplete($n)} {
lappend boldrows $row
$canv itemconf $linehtag($row) -font $font
- if {[info exists selectedline] && $row == $selectedline} {
+ if {$row == $selectedline} {
$canv delete secsel
set t [eval $canv create rect [$canv bbox $linehtag($row)] \
-outline {{}} -tags secsel \
lappend boldnamerows $row
$canv2 itemconf $linentag($row) -font $font
- if {[info exists selectedline] && $row == $selectedline} {
+ if {$row == $selectedline} {
$canv2 delete secsel
set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
-outline {{}} -tags secsel \
global descendent highlight_related iddrawn rhighlights
global selectedline ancestor
- if {![info exists selectedline]} return
+ if {$selectedline eq {}} return
set isbold 0
if {$highlight_related eq [mc "Descendant"] ||
$highlight_related eq [mc "Not descendant"]} {
proc layoutmore {} {
global commitidx viewcomplete curview
- global numcommits pending_select selectedline curview
- global lastscrollset lastscrollrows commitinterest
+ global numcommits pending_select curview
+ global lastscrollset lastscrollrows
if {$lastscrollrows < 100 || $viewcomplete($curview) ||
[clock clicks -milliseconds] - $lastscrollset > 500} {
}
if {[info exists pending_select] &&
[commitinview $pending_select $curview]} {
+ update
selectline [rowofcommit $pending_select] 1
}
drawvisible
proc doshowlocalchanges {} {
global curview mainheadid
+ if {$mainheadid eq {}} return
if {[commitinview $mainheadid $curview]} {
dodiffindex
} else {
- lappend commitinterest($mainheadid) {dodiffindex}
+ interestedin $mainheadid dodiffindex
}
}
incr lserial
set fd [open "|git diff-index --cached HEAD" r]
fconfigure $fd -blocking 0
- filerun $fd [list readdiffindex $fd $lserial]
+ set i [reg_instance $fd]
+ filerun $fd [list readdiffindex $fd $lserial $i]
}
-proc readdiffindex {fd serial} {
+proc readdiffindex {fd serial inst} {
global mainheadid nullid nullid2 curview commitinfo commitdata lserial
set isdiff 1
set isdiff 0
}
# we only need to see one line and we don't really care what it says...
- close $fd
+ stop_instance $inst
if {$serial != $lserial} {
return 0
# now see if there are any local changes not checked in to the index
set fd [open "|git diff-files" r]
fconfigure $fd -blocking 0
- filerun $fd [list readdifffiles $fd $serial]
+ set i [reg_instance $fd]
+ filerun $fd [list readdifffiles $fd $serial $i]
if {$isdiff && ![commitinview $nullid2 $curview]} {
# add the line for the changes in the index to the graph
return 0
}
-proc readdifffiles {fd serial} {
+proc readdifffiles {fd serial inst} {
global mainheadid nullid nullid2 curview
global commitinfo commitdata lserial
set isdiff 0
}
# we only need to see one line and we don't really care what it says...
- close $fd
+ stop_instance $inst
if {$serial != $lserial} {
return 0
global cmitlisted commitinfo rowidlist parentlist
global rowtextx idpos idtags idheads idotherrefs
global linehtag linentag linedtag selectedline
- global canvxmax boldrows boldnamerows fgcolor nullid nullid2
+ global canvxmax boldrows boldnamerows fgcolor
+ global mainheadid nullid nullid2 circleitem circlecolors ctxbut
# listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
set listed $cmitlisted($curview,$id)
set ofill red
} elseif {$id eq $nullid2} {
set ofill green
+ } elseif {$id eq $mainheadid} {
+ set ofill yellow
} else {
- set ofill [expr {$listed != 0 ? $listed == 2 ? "gray" : "blue" : "white"}]
+ set ofill [lindex $circlecolors $listed]
}
set x [xc $row $col]
set y [yc $row]
[expr {$x - $orad}] [expr {$y + $orad - 1}] \
-fill $ofill -outline $fgcolor -width 1 -tags circle]
}
+ set circleitem($row) $t
$canv raise $t
$canv bind $t <1> {selcanvline {} %x %y}
set rmx [llength [lindex $rowidlist $row]]
}
set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
-text $headline -font $font -tags text]
- $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
+ $canv bind $linehtag($row) $ctxbut "rowmenu %X %Y $id"
set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
-text $name -font $nfont -tags text]
set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
-text $date -font mainfont -tags text]
- if {[info exists selectedline] && $selectedline == $row} {
+ if {$selectedline == $row} {
make_secsel $row
}
set xr [expr {$xt + [font measure $font $headline]}]
if {$endrow >= $vrowmod($curview)} {
update_arcrows $curview
}
- if {[info exists selectedline] &&
+ if {$selectedline ne {} &&
$row <= $selectedline && $selectedline <= $endrow} {
set targetrow $selectedline
} elseif {[info exists targetid]} {
proc clear_display {} {
global iddrawn linesegs need_redisplay nrows_drawn
global vhighlights fhighlights nhighlights rhighlights
+ global linehtag linentag linedtag boldrows boldnamerows
allcanvs delete all
catch {unset iddrawn}
catch {unset linesegs}
+ catch {unset linehtag}
+ catch {unset linentag}
+ catch {unset linedtag}
+ set boldrows {}
+ set boldnamerows {}
catch {unset vhighlights}
catch {unset fhighlights}
catch {unset nhighlights}
proc drawtags {id x xt y1} {
global idtags idheads idotherrefs mainhead
global linespc lthickness
- global canv rowtextx curview fgcolor bgcolor
+ global canv rowtextx curview fgcolor bgcolor ctxbut
set marks {}
set ntags 0
if {$ntags >= 0} {
$canv bind $t <1> [list showtag $tag 1]
} elseif {$nheads >= 0} {
- $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
+ $canv bind $t $ctxbut [list headmenu %X %Y $id $tag]
}
}
return $xt
}
focus .
if {$findstring eq {} || $numcommits == 0} return
- if {![info exists selectedline]} {
+ if {$selectedline eq {}} {
set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
} else {
set findstartline $selectedline
set fprogcoord 0
adjustprogress
}
+ stopblaming
}
proc findmore {} {
[expr {$x0+$xlen+2}] $y1 \
-outline {} -tags [list match$l matches] -fill yellow]
$canv lower $t
- if {[info exists selectedline] && $row == $selectedline} {
+ if {$row == $selectedline} {
$canv raise $t secsel
}
}
# append some text to the ctext widget, and make any SHA1 ID
# that we know about be a clickable link.
proc appendwithlinks {text tags} {
- global ctext linknum curview pendinglinks
+ global ctext linknum curview
set start [$ctext index "end - 1c"]
$ctext insert end $text $tags
- set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
+ set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
foreach l $links {
set s [lindex $l 0]
set e [lindex $l 1]
}
proc setlink {id lk} {
- global curview ctext pendinglinks commitinterest
+ global curview ctext pendinglinks
- if {[commitinview $id $curview]} {
+ set known 0
+ if {[string length $id] < 40} {
+ set matches [longid $id]
+ if {[llength $matches] > 0} {
+ if {[llength $matches] > 1} return
+ set known 1
+ set id [lindex $matches 0]
+ }
+ } else {
+ set known [commitinview $id $curview]
+ }
+ if {$known} {
$ctext tag conf $lk -foreground blue -underline 1
- $ctext tag bind $lk <1> [list selectline [rowofcommit $id] 1]
+ $ctext tag bind $lk <1> [list selbyid $id]
$ctext tag bind $lk <Enter> {linkcursor %W 1}
$ctext tag bind $lk <Leave> {linkcursor %W -1}
} else {
lappend pendinglinks($id) $lk
- lappend commitinterest($id) {makelink %I}
+ interestedin $id {makelink %P}
}
}
proc dispneartags {delay} {
global selectedline currentid showneartags tagphase
- if {![info exists selectedline] || !$showneartags} return
+ if {$selectedline eq {} || !$showneartags} return
after cancel dispnexttag
if {$delay} {
after 200 dispnexttag
proc dispnexttag {} {
global selectedline currentid showneartags tagphase ctext
- if {![info exists selectedline] || !$showneartags} return
+ if {$selectedline eq {} || !$showneartags} return
switch -- $tagphase {
0 {
set dtags [desctags $currentid]
$canv3 lower $t
}
-proc selectline {l isnew} {
+proc selectline {l isnew {desired_loc {}}} {
global canv ctext commitinfo selectedline
global canvy0 linespc parents children curview
global currentid sha1entry
global mergemax numcommits pending_select
global cmitmode showneartags allcommits
global targetrow targetid lastscrollrows
- global autoselect
+ global autoselect jump_to_here
catch {unset pending_select}
$canv delete hover
$ctext conf -state disabled
set commentend [$ctext index "end - 1c"]
+ set jump_to_here $desired_loc
init_flist [mc "Comments"]
if {$cmitmode eq "tree"} {
gettree $id
proc selnextline {dir} {
global selectedline
focus .
- if {![info exists selectedline]} return
+ if {$selectedline eq {}} return
set l [expr {$selectedline + $dir}]
unmarkmatches
selectline $l 1
}
allcanvs yview scroll [expr {$dir * $lpp}] units
drawvisible
- if {![info exists selectedline]} return
+ if {$selectedline eq {}} return
set l [expr {$selectedline + $dir * $lpp}]
if {$l < 0} {
set l 0
proc unselectline {} {
global selectedline currentid
- catch {unset selectedline}
+ set selectedline {}
catch {unset currentid}
allcanvs delete secsel
rhighlight_none
proc reselectline {} {
global selectedline
- if {[info exists selectedline]} {
+ if {$selectedline ne {}} {
selectline $selectedline 0
}
}
set treepending $id
set treefilelist($id) {}
set treeidlist($id) {}
- fconfigure $gtf -blocking 0
+ fconfigure $gtf -blocking 0 -encoding binary
filerun $gtf [list gettreeline $gtf $id]
}
} else {
if {$diffids eq $nullid} {
set fname $line
} else {
- if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
set i [string first "\t" $line]
if {$i < 0} continue
- set sha1 [lindex $line 2]
set fname [string range $line [expr {$i+1}] end]
- if {[string index $fname 0] eq "\""} {
- set fname [lindex $fname 0]
- }
+ set line [string range $line 0 [expr {$i-1}]]
+ if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
+ set sha1 [lindex $line 2]
lappend treeidlist($id) $sha1
}
+ if {[string index $fname 0] eq "\""} {
+ set fname [lindex $fname 0]
+ }
+ set fname [encoding convertfrom $fname]
lappend treefilelist($id) $fname
}
if {![eof $gtf]} {
proc showfile {f} {
global treefilelist treeidlist diffids nullid nullid2
+ global ctext_file_names ctext_file_lines
global ctext commentend
set i [lsearch -exact $treefilelist($diffids) $f]
return
}
}
- fconfigure $bf -blocking 0
+ fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
filerun $bf [list getblobline $bf $diffids]
$ctext config -state normal
clear_ctext $commentend
+ lappend ctext_file_names $f
+ lappend ctext_file_lines [lindex [split $commentend "."] 0]
$ctext insert end "\n"
$ctext insert end "$f\n" filesep
$ctext config -state disabled
$ctext insert end "$line\n"
}
if {[eof $bf]} {
+ global jump_to_here ctext_file_names commentend
+
# delete last newline
$ctext delete "end - 2c" "end - 1c"
close $bf
+ if {$jump_to_here ne {} &&
+ [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
+ set lnum [expr {[lindex $jump_to_here 1] +
+ [lindex [split $commentend .] 0]}]
+ mark_ctext_line $lnum
+ }
return 0
}
$ctext config -state disabled
return [expr {$nl >= 1000? 2: 1}]
}
+proc mark_ctext_line {lnum} {
+ global ctext markbgcolor
+
+ $ctext tag delete omark
+ $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
+ $ctext tag conf omark -background $markbgcolor
+ $ctext see $lnum.0
+}
+
proc mergediff {id} {
global diffmergeid mdifffd
- global diffids
+ global diffids treediffs
global parents
global diffcontext
- global limitdiffs viewfiles curview
+ global diffencoding
+ global limitdiffs vfilelimit curview
+ global targetline
set diffmergeid $id
set diffids $id
+ set treediffs($id) {}
+ set targetline {}
# this doesn't seem to actually affect anything...
set cmd [concat | git diff-tree --no-commit-id --cc -U$diffcontext $id]
- if {$limitdiffs && $viewfiles($curview) ne {}} {
- set cmd [concat $cmd -- $viewfiles($curview)]
+ if {$limitdiffs && $vfilelimit($curview) ne {}} {
+ set cmd [concat $cmd -- $vfilelimit($curview)]
}
if {[catch {set mdf [open $cmd r]} err]} {
error_popup "[mc "Error getting merge diffs:"] $err"
return
}
- fconfigure $mdf -blocking 0
+ fconfigure $mdf -blocking 0 -encoding binary
set mdifffd($id) $mdf
set np [llength $parents($curview,$id)]
+ set diffencoding [get_path_encoding {}]
settabs $np
filerun $mdf [list getmergediffline $mdf $id $np]
}
proc getmergediffline {mdf id np} {
global diffmergeid ctext cflist mergemax
- global difffilestart mdifffd
+ global difffilestart mdifffd treediffs
+ global ctext_file_names ctext_file_lines
+ global diffencoding jump_to_here targetline diffline
$ctext conf -state normal
set nr 0
}
if {[regexp {^diff --cc (.*)} $line match fname]} {
# start of a new file
+ set fname [encoding convertfrom $fname]
$ctext insert end "\n"
set here [$ctext index "end - 1c"]
lappend difffilestart $here
+ lappend treediffs($id) $fname
add_flist [list $fname]
+ lappend ctext_file_names $fname
+ lappend ctext_file_lines [lindex [split $here "."] 0]
+ set diffencoding [get_path_encoding $fname]
set l [expr {(78 - [string length $fname]) / 2}]
set pad [string range "----------------------------------------" 1 $l]
$ctext insert end "$pad $fname $pad\n" filesep
+ set targetline {}
+ if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
+ set targetline [lindex $jump_to_here 1]
+ }
+ set diffline 0
} elseif {[regexp {^@@} $line]} {
+ set line [encoding convertfrom $diffencoding $line]
$ctext insert end "$line\n" hunksep
+ if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
+ set diffline $nl
+ }
} elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
# do nothing
} else {
+ set line [encoding convertfrom $diffencoding $line]
# parse the prefix - one ' ', '-' or '+' for each parent
set spaces {}
set minuses {}
lappend tags m$num
}
$ctext insert end "$line\n" $tags
+ if {$targetline ne {} && $minuses eq {}} {
+ if {$diffline == $targetline} {
+ set here [$ctext index "end - 1 line"]
+ mark_ctext_line [lindex [split $here .] 0]
+ set targetline {}
+ } else {
+ incr diffline
+ }
+ }
}
}
$ctext conf -state disabled
proc gettreediffs {ids} {
global treediff treepending
+ if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
+
set treepending $ids
set treediff {}
- if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
- fconfigure $gdtf -blocking 0
+ fconfigure $gdtf -blocking 0 -encoding binary
filerun $gdtf [list gettreediffline $gdtf $ids]
}
proc gettreediffline {gdtf ids} {
global treediff treediffs treepending diffids diffmergeid
- global cmitmode viewfiles curview limitdiffs
+ global cmitmode vfilelimit curview limitdiffs perfile_attrs
set nr 0
- while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
+ set sublist {}
+ set max 1000
+ if {$perfile_attrs} {
+ # cache_gitattr is slow, and even slower on win32 where we
+ # have to invoke it for only about 30 paths at a time
+ set max 500
+ if {[tk windowingsystem] == "win32"} {
+ set max 120
+ }
+ }
+ while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
set i [string first "\t" $line]
if {$i >= 0} {
set file [string range $line [expr {$i+1}] end]
if {[string index $file 0] eq "\""} {
set file [lindex $file 0]
}
+ set file [encoding convertfrom $file]
lappend treediff $file
+ lappend sublist $file
}
}
+ if {$perfile_attrs} {
+ cache_gitattr encoding $sublist
+ }
if {![eof $gdtf]} {
- return [expr {$nr >= 1000? 2: 1}]
+ return [expr {$nr >= $max? 2: 1}]
}
close $gdtf
- if {$limitdiffs && $viewfiles($curview) ne {}} {
+ if {$limitdiffs && $vfilelimit($curview) ne {}} {
set flist {}
foreach f $treediff {
- if {[path_filter $viewfiles($curview) $f]} {
+ if {[path_filter $vfilelimit($curview) $f]} {
lappend flist $f
}
}
global diffinhdr treediffs
global diffcontext
global ignorespace
- global limitdiffs viewfiles curview
+ global limitdiffs vfilelimit curview
+ global diffencoding targetline
set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
if {$ignorespace} {
append cmd " -w"
}
- if {$limitdiffs && $viewfiles($curview) ne {}} {
- set cmd [concat $cmd -- $viewfiles($curview)]
+ if {$limitdiffs && $vfilelimit($curview) ne {}} {
+ set cmd [concat $cmd -- $vfilelimit($curview)]
}
if {[catch {set bdf [open $cmd r]} err]} {
puts "error getting diffs: $err"
return
}
+ set targetline {}
set diffinhdr 0
- fconfigure $bdf -blocking 0
+ set diffencoding [get_path_encoding {}]
+ fconfigure $bdf -blocking 0 -encoding binary
set blobdifffd($ids) $bdf
filerun $bdf [list getblobdiffline $bdf $diffids]
}
proc makediffhdr {fname ids} {
global ctext curdiffstart treediffs
+ global ctext_file_names jump_to_here targetline diffline
set i [lsearch -exact $treediffs($ids) $fname]
if {$i >= 0} {
setinlist difffilestart $i $curdiffstart
}
+ set ctext_file_names [lreplace $ctext_file_names end end $fname]
set l [expr {(78 - [string length $fname]) / 2}]
set pad [string range "----------------------------------------" 1 $l]
$ctext insert $curdiffstart "$pad $fname $pad" filesep
+ set targetline {}
+ if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
+ set targetline [lindex $jump_to_here 1]
+ }
+ set diffline 0
}
proc getblobdiffline {bdf ids} {
global diffids blobdifffd ctext curdiffstart
global diffnexthead diffnextnote difffilestart
+ global ctext_file_names ctext_file_lines
global diffinhdr treediffs
+ global diffencoding jump_to_here targetline diffline
set nr 0
$ctext conf -state normal
# start of a new file
$ctext insert end "\n"
set curdiffstart [$ctext index "end - 1c"]
+ lappend ctext_file_names ""
+ lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
$ctext insert end "\n" filesep
# If the name hasn't changed the length will be odd,
# the middle char will be a space, and the two bits either
} else {
set fname [string range $line 2 [expr {$i - 1}]]
}
+ set fname [encoding convertfrom $fname]
+ set diffencoding [get_path_encoding $fname]
makediffhdr $fname $ids
} elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
$line match f1l f1c f2l f2c rest]} {
+ set line [encoding convertfrom $diffencoding $line]
$ctext insert end "$line\n" hunksep
set diffinhdr 0
+ set diffline $f2l
} elseif {$diffinhdr} {
if {![string compare -length 12 "rename from " $line]} {
if {[string index $fname 0] eq "\""} {
set fname [lindex $fname 0]
}
+ set fname [encoding convertfrom $fname]
set i [lsearch -exact $treediffs($ids) $fname]
if {$i >= 0} {
setinlist difffilestart $i $curdiffstart
if {[string index $fname 0] eq "\""} {
set fname [lindex $fname 0]
}
+ set fname [encoding convertfrom $fname]
+ set diffencoding [get_path_encoding $fname]
makediffhdr $fname $ids
} elseif {[string compare -length 3 $line "---"] == 0} {
# do nothing
$ctext insert end "$line\n" filesep
} else {
+ set line [encoding convertfrom $diffencoding $line]
set x [string range $line 0 0]
+ set here [$ctext index "end - 1 chars"]
if {$x == "-" || $x == "+"} {
set tag [expr {$x == "+"}]
$ctext insert end "$line\n" d$tag
# or something else we don't recognize
$ctext insert end "$line\n" hunksep
}
+ if {$targetline ne {} && ($x eq " " || $x eq "+")} {
+ if {$diffline == $targetline} {
+ mark_ctext_line [lindex [split $here .] 0]
+ set targetline {}
+ } else {
+ incr diffline
+ }
+ }
}
}
$ctext conf -state disabled
$ctext tag conf d1 -elide [lindex $diffelide 1]
}
+proc highlightfile {loc cline} {
+ global ctext cflist cflist_top
+
+ $ctext yview $loc
+ $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
+ $cflist tag add highlight $cline.0 "$cline.0 lineend"
+ $cflist see $cline.0
+ set cflist_top $cline
+}
+
proc prevfile {} {
- global difffilestart ctext
- set prev [lindex $difffilestart 0]
+ global difffilestart ctext cmitmode
+
+ if {$cmitmode eq "tree"} return
+ set prev 0.0
+ set prevline 1
set here [$ctext index @0,0]
foreach loc $difffilestart {
if {[$ctext compare $loc >= $here]} {
- $ctext yview $prev
+ highlightfile $prev $prevline
return
}
set prev $loc
+ incr prevline
}
- $ctext yview $prev
+ highlightfile $prev $prevline
}
proc nextfile {} {
- global difffilestart ctext
+ global difffilestart ctext cmitmode
+
+ if {$cmitmode eq "tree"} return
set here [$ctext index @0,0]
+ set line 1
foreach loc $difffilestart {
+ incr line
if {[$ctext compare $loc > $here]} {
- $ctext yview $loc
+ highlightfile $loc $line
return
}
}
proc clear_ctext {{first 1.0}} {
global ctext smarktop smarkbot
+ global ctext_file_names ctext_file_lines
global pendinglinks
set l [lindex [split $first .] 0]
if {$first eq "1.0"} {
catch {unset pendinglinks}
}
+ set ctext_file_names {}
+ set ctext_file_lines {}
}
proc settabs {{firstab {}}} {
setcanvscroll
allcanvs yview moveto [lindex $span 0]
drawvisible
- if {[info exists selectedline]} {
+ if {$selectedline ne {}} {
selectline $selectedline 0
allcanvs yview moveto [lindex $span 0]
}
} else {
set id [string tolower $sha1string]
if {[regexp {^[0-9a-f]{4,39}$} $id]} {
- set matches [array names varcid "$curview,$id*"]
+ set matches [longid $id]
if {$matches ne {}} {
if {[llength $matches] > 1} {
error_popup [mc "Short SHA1 id %s is ambiguous" $id]
return
}
- set id [lindex [split [lindex $matches 0] ","] 1]
+ set id [lindex $matches 0]
}
}
}
stopfinding
set rowmenuid $id
- if {![info exists selectedline]
- || [rowofcommit $id] eq $selectedline} {
+ if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
set state disabled
} else {
set state normal
}
if {$id ne $nullid && $id ne $nullid2} {
set menu $rowctxmenu
- $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
+ if {$mainhead ne {}} {
+ $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
+ } else {
+ $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
+ }
} else {
set menu $fakerowmenu
}
- $menu entryconfigure [mc "Diff this -> selected"] -state $state
- $menu entryconfigure [mc "Diff selected -> this"] -state $state
- $menu entryconfigure [mc "Make patch"] -state $state
+ $menu entryconfigure [mca "Diff this -> selected"] -state $state
+ $menu entryconfigure [mca "Diff selected -> this"] -state $state
+ $menu entryconfigure [mca "Make patch"] -state $state
tk_popup $menu $x $y
}
proc diffvssel {dirn} {
global rowmenuid selectedline
- if {![info exists selectedline]} return
+ if {$selectedline eq {}} return
if {$dirn} {
set oldid [commitonrow $selectedline]
set newid $rowmenuid
set patchtop $top
catch {destroy $top}
toplevel $top
+ wm transient $top .
label $top.title -text [mc "Generate patch"]
grid $top.title - -pady 10
label $top.from -text [mc "From:"]
frame $top.buts
button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
+ bind $top <Key-Return> mkpatchgo
+ bind $top <Key-Escape> mkpatchcan
grid $top.buts.gen $top.buts.can
grid columnconfigure $top.buts 0 -weight 1 -uniform a
grid columnconfigure $top.buts 1 -weight 1 -uniform a
set cmd [lrange $cmd 1 end]
lappend cmd >$fname &
if {[catch {eval exec $cmd} err]} {
- error_popup "[mc "Error creating patch:"] $err"
+ error_popup "[mc "Error creating patch:"] $err" $patchtop
}
catch {destroy $patchtop}
unset patchtop
set mktagtop $top
catch {destroy $top}
toplevel $top
+ wm transient $top .
label $top.title -text [mc "Create tag"]
grid $top.title - -pady 10
label $top.id -text [mc "ID:"]
frame $top.buts
button $top.buts.gen -text [mc "Create"] -command mktaggo
button $top.buts.can -text [mc "Cancel"] -command mktagcan
+ bind $top <Key-Return> mktaggo
+ bind $top <Key-Escape> mktagcan
grid $top.buts.gen $top.buts.can
grid columnconfigure $top.buts 0 -weight 1 -uniform a
grid columnconfigure $top.buts 1 -weight 1 -uniform a
set id [$mktagtop.sha1 get]
set tag [$mktagtop.tag get]
if {$tag == {}} {
- error_popup [mc "No tag name specified"]
- return
+ error_popup [mc "No tag name specified"] $mktagtop
+ return 0
}
if {[info exists tagids($tag)]} {
- error_popup [mc "Tag \"%s\" already exists" $tag]
- return
+ error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
+ return 0
}
if {[catch {
exec git tag $tag $id
} err]} {
- error_popup "[mc "Error creating tag:"] $err"
- return
+ error_popup "[mc "Error creating tag:"] $err" $mktagtop
+ return 0
}
set tagids($tag) $id
addedtag $id
dispneartags 0
run refill_reflist
+ return 1
}
proc redrawtags {id} {
- global canv linehtag idpos currentid curview
- global canvxmax iddrawn
+ global canv linehtag idpos currentid curview cmitlisted
+ global canvxmax iddrawn circleitem mainheadid circlecolors
if {![commitinview $id $curview]} return
if {![info exists iddrawn($id)]} return
set row [rowofcommit $id]
+ if {$id eq $mainheadid} {
+ set ofill yellow
+ } else {
+ set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
+ }
+ $canv itemconf $circleitem($row) -fill $ofill
$canv delete tag.$id
set xt [eval drawtags $id $idpos($id)]
$canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
}
proc mktaggo {} {
- domktag
+ if {![domktag]} return
mktagcan
}
set wrcomtop $top
catch {destroy $top}
toplevel $top
+ wm transient $top .
label $top.title -text [mc "Write commit to file"]
grid $top.title - -pady 10
label $top.id -text [mc "ID:"]
frame $top.buts
button $top.buts.gen -text [mc "Write"] -command wrcomgo
button $top.buts.can -text [mc "Cancel"] -command wrcomcan
+ bind $top <Key-Return> wrcomgo
+ bind $top <Key-Escape> wrcomcan
grid $top.buts.gen $top.buts.can
grid columnconfigure $top.buts 0 -weight 1 -uniform a
grid columnconfigure $top.buts 1 -weight 1 -uniform a
set cmd "echo $id | [$wrcomtop.cmd get]"
set fname [$wrcomtop.fname get]
if {[catch {exec sh -c $cmd >$fname &} err]} {
- error_popup "[mc "Error writing commit:"] $err"
+ error_popup "[mc "Error writing commit:"] $err" $wrcomtop
}
catch {destroy $wrcomtop}
unset wrcomtop
set top .makebranch
catch {destroy $top}
toplevel $top
+ wm transient $top .
label $top.title -text [mc "Create new branch"]
grid $top.title - -pady 10
label $top.id -text [mc "ID:"]
grid $top.id $top.sha1 -sticky w
label $top.nlab -text [mc "Name:"]
entry $top.name -width 40
+ bind $top.name <Key-Return> "[list mkbrgo $top]"
grid $top.nlab $top.name -sticky w
frame $top.buts
button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
+ bind $top <Key-Return> [list mkbrgo $top]
+ bind $top <Key-Escape> "catch {destroy $top}"
grid $top.buts.go $top.buts.can
grid columnconfigure $top.buts 0 -weight 1 -uniform a
grid columnconfigure $top.buts 1 -weight 1 -uniform a
set name [$top.name get]
set id [$top.sha1 get]
+ set cmdargs {}
+ set old_id {}
if {$name eq {}} {
- error_popup [mc "Please specify a name for the new branch"]
+ error_popup [mc "Please specify a name for the new branch"] $top
return
}
+ if {[info exists headids($name)]} {
+ if {![confirm_popup [mc \
+ "Branch '%s' already exists. Overwrite?" $name] $top]} {
+ return
+ }
+ set old_id $headids($name)
+ lappend cmdargs -f
+ }
catch {destroy $top}
+ lappend cmdargs $name $id
nowbusy newbranch
update
if {[catch {
- exec git branch $name $id
+ eval exec git branch $cmdargs
} err]} {
notbusy newbranch
error_popup $err
} else {
- set headids($name) $id
- lappend idheads($id) $name
- addedhead $id $name
notbusy newbranch
- redrawtags $id
+ if {$old_id ne {}} {
+ movehead $id $name
+ movedhead $id $name
+ redrawtags $old_id
+ redrawtags $id
+ } else {
+ set headids($name) $id
+ lappend idheads($id) $name
+ addedhead $id $name
+ redrawtags $id
+ }
dispneartags 0
run refill_reflist
}
}
+proc exec_citool {tool_args {baseid {}}} {
+ global commitinfo env
+
+ set save_env [array get env GIT_AUTHOR_*]
+
+ if {$baseid ne {}} {
+ if {![info exists commitinfo($baseid)]} {
+ getcommit $baseid
+ }
+ set author [lindex $commitinfo($baseid) 1]
+ set date [lindex $commitinfo($baseid) 2]
+ if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
+ $author author name email]
+ && $date ne {}} {
+ set env(GIT_AUTHOR_NAME) $name
+ set env(GIT_AUTHOR_EMAIL) $email
+ set env(GIT_AUTHOR_DATE) $date
+ }
+ }
+
+ eval exec git citool $tool_args &
+
+ array unset env GIT_AUTHOR_*
+ array set env $save_env
+}
+
proc cherrypick {} {
global rowmenuid curview
global mainhead mainheadid
# no error occurs, and exec takes that as an indication of error...
if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
notbusy cherrypick
- error_popup $err
+ if {[regexp -line \
+ {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
+ $err msg fname]} {
+ error_popup [mc "Cherry-pick failed because of local changes\
+ to file '%s'.\nPlease commit, reset or stash\
+ your changes and try again." $fname]
+ } elseif {[regexp -line \
+ {^(CONFLICT \(.*\):|Automatic cherry-pick failed)} \
+ $err]} {
+ if {[confirm_popup [mc "Cherry-pick failed because of merge\
+ conflict.\nDo you wish to run git citool to\
+ resolve it?"]]} {
+ # Force citool to read MERGE_MSG
+ file delete [file join [gitdir] "GITGUI_MSG"]
+ exec_citool {} $rowmenuid
+ }
+ } else {
+ error_popup $err
+ }
+ run updatecommits
return
}
set newhead [exec git rev-parse HEAD]
if {$mainhead ne {}} {
movehead $newhead $mainhead
movedhead $newhead $mainhead
- set mainheadid $newhead
}
+ set mainheadid $newhead
redrawtags $oldhead
redrawtags $newhead
selbyid $newhead
button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
pack $w.ok -side left -fill x -padx 20 -pady 20
button $w.cancel -text [mc Cancel] -command "destroy $w"
+ bind $w <Key-Escape> [list destroy $w]
pack $w.cancel -side right -fill x -padx 20 -pady 20
bind $w <Visibility> "grab $w; focus $w"
tkwait window $w
if {!$confirm_ok} return
if {[catch {set fd [open \
- [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
+ [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
error_popup $err
} else {
dohidelocalchanges
}
proc cobranch {} {
- global headmenuid headmenuhead mainhead headids
+ global headmenuid headmenuhead headids
global showlocalchanges mainheadid
# check the tree is clean first??
- set oldmainhead $mainhead
nowbusy checkout [mc "Checking out"]
update
dohidelocalchanges
if {[catch {
- exec git checkout -q $headmenuhead
+ set fd [open [list | git checkout $headmenuhead 2>@1] r]
} err]} {
notbusy checkout
error_popup $err
+ if {$showlocalchanges} {
+ dodiffindex
+ }
} else {
- notbusy checkout
- set mainhead $headmenuhead
- set mainheadid $headmenuid
- if {[info exists headids($oldmainhead)]} {
- redrawtags $headids($oldmainhead)
+ filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
+ }
+}
+
+proc readcheckoutstat {fd newhead newheadid} {
+ global mainhead mainheadid headids showlocalchanges progresscoords
+
+ if {[gets $fd line] >= 0} {
+ if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
+ set progresscoords [list 0 [expr {1.0 * $m / $n}]]
+ adjustprogress
}
- redrawtags $headmenuid
- selbyid $headmenuid
+ return 1
+ }
+ set progresscoords {0 0}
+ adjustprogress
+ notbusy checkout
+ if {[catch {close $fd} err]} {
+ error_popup $err
}
+ set oldmainid $mainheadid
+ set mainhead $newhead
+ set mainheadid $newheadid
+ redrawtags $oldmainid
+ redrawtags $newheadid
+ selbyid $newheadid
if {$showlocalchanges} {
dodiffindex
}
}
toplevel $top
wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
+ wm transient $top .
text $top.list -background $bgcolor -foreground $fgcolor \
-selectbackground $selectbgcolor -font mainfont \
-xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
pack $top.f.l -side left
grid $top.f - -sticky ew -pady 2
button $top.close -command [list destroy $top] -text [mc "Close"]
+ bind $top <Key-Escape> [list destroy $top]
grid $top.close -
grid columnconfigure $top 0 -weight 1
grid rowconfigure $top 0 -weight 1
proc refill_reflist {} {
global reflist reflistfilter showrefstop headids tagids otherrefids
- global curview commitinterest
+ global curview
if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
set refs {}
if {[commitinview $headids($n) $curview]} {
lappend refs [list $n H]
} else {
- set commitinterest($headids($n)) {run refill_reflist}
+ interestedin $headids($n) {run refill_reflist}
}
}
}
if {[commitinview $tagids($n) $curview]} {
lappend refs [list $n T]
} else {
- set commitinterest($tagids($n)) {run refill_reflist}
+ interestedin $tagids($n) {run refill_reflist}
}
}
}
if {[commitinview $otherrefids($n) $curview]} {
lappend refs [list $n o]
} else {
- set commitinterest($otherrefids($n)) {run refill_reflist}
+ interestedin $otherrefids($n) {run refill_reflist}
}
}
}
[array names idheads] [array names idotherrefs]]]
foreach id $refids {
set v [listrefs $id]
- if {![info exists ref($id)] || $ref($id) != $v ||
- ($id eq $oldmainhead && $id ne $mainheadid) ||
- ($id eq $mainheadid && $id ne $oldmainhead)} {
+ if {![info exists ref($id)] || $ref($id) != $v} {
redrawtags $id
}
}
+ if {$oldmainhead ne $mainheadid} {
+ redrawtags $oldmainhead
+ redrawtags $mainheadid
+ }
run refill_reflist
}
proc doquit {} {
global stopped
+ global gitktmpdir
+
set stopped 100
savestuff .
destroy .
+
+ if {[info exists gitktmpdir]} {
+ catch {file delete -force $gitktmpdir}
+ }
}
proc mkfontdisp {font top which} {
proc choosefont {font which} {
global fontparam fontlist fonttop fontattr
+ global prefstop
set fontparam(which) $which
set fontparam(font) $font
font create sample
eval font config sample [font actual $font]
toplevel $top
+ wm transient $top $prefstop
wm title $top [mc "Gitk font chooser"]
label $top.l -textvariable fontparam(which)
pack $top.l -side top
frame $top.buts
button $top.buts.ok -text [mc "OK"] -command fontok -default active
button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
+ bind $top <Key-Return> fontok
+ bind $top <Key-Escape> fontcan
grid $top.buts.ok $top.buts.can
grid columnconfigure $top.buts 0 -weight 1 -uniform a
grid columnconfigure $top.buts 1 -weight 1 -uniform a
proc doprefs {} {
global maxwidth maxgraphpct
global oldprefs prefstop showneartags showlocalchanges
- global bgcolor fgcolor ctext diffcolors selectbgcolor
- global tabstop limitdiffs autoselect
+ global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
+ global tabstop limitdiffs autoselect extdifftool perfile_attrs
set top .gitkprefs
set prefstop $top
return
}
foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
- limitdiffs tabstop} {
+ limitdiffs tabstop perfile_attrs} {
set oldprefs($v) [set $v]
}
toplevel $top
wm title $top [mc "Gitk preferences"]
+ wm transient $top .
label $top.ldisp -text [mc "Commit list display options"]
grid $top.ldisp - -sticky w -pady 10
label $top.spacer -text " "
checkbutton $top.ldiff.b -variable limitdiffs
pack $top.ldiff.b $top.ldiff.l -side left
grid x $top.ldiff -sticky w
+ frame $top.lattr
+ label $top.lattr.l -text [mc "Support per-file encodings"] -font optionfont
+ checkbutton $top.lattr.b -variable perfile_attrs
+ pack $top.lattr.b $top.lattr.l -side left
+ grid x $top.lattr -sticky w
+
+ entry $top.extdifft -textvariable extdifftool
+ frame $top.extdifff
+ label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
+ -padx 10
+ button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
+ -command choose_extdiff
+ pack $top.extdifff.l $top.extdifff.b -side left
+ grid x $top.extdifff $top.extdifft -sticky w
label $top.cdisp -text [mc "Colors: press to choose"]
grid $top.cdisp - -sticky w -pady 10
label $top.bg -padx 40 -relief sunk -background $bgcolor
button $top.bgbut -text [mc "Background"] -font optionfont \
- -command [list choosecolor bgcolor 0 $top.bg background setbg]
+ -command [list choosecolor bgcolor {} $top.bg background setbg]
grid x $top.bgbut $top.bg -sticky w
label $top.fg -padx 40 -relief sunk -background $fgcolor
button $top.fgbut -text [mc "Foreground"] -font optionfont \
- -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
+ -command [list choosecolor fgcolor {} $top.fg foreground setfg]
grid x $top.fgbut $top.fg -sticky w
label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
"diff hunk header" \
[list $ctext tag conf hunksep -foreground]]
grid x $top.hunksepbut $top.hunksep -sticky w
+ label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
+ button $top.markbgbut -text [mc "Marked line bg"] -font optionfont \
+ -command [list choosecolor markbgcolor {} $top.markbgsep \
+ [mc "marked line background"] \
+ [list $ctext tag conf omark -background]]
+ grid x $top.markbgbut $top.markbgsep -sticky w
label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
button $top.selbgbut -text [mc "Select bg"] -font optionfont \
- -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
+ -command [list choosecolor selectbgcolor {} $top.selbgsep background setselbg]
grid x $top.selbgbut $top.selbgsep -sticky w
label $top.cfont -text [mc "Fonts: press to choose"]
frame $top.buts
button $top.buts.ok -text [mc "OK"] -command prefsok -default active
button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
+ bind $top <Key-Return> prefsok
+ bind $top <Key-Escape> prefscan
grid $top.buts.ok $top.buts.can
grid columnconfigure $top.buts 0 -weight 1 -uniform a
grid columnconfigure $top.buts 1 -weight 1 -uniform a
bind $top <Visibility> "focus $top.buts.ok"
}
+proc choose_extdiff {} {
+ global extdifftool
+
+ set prog [tk_getOpenFile -title "External diff tool" -multiple false]
+ if {$prog ne {}} {
+ set extdifftool $prog
+ }
+}
+
proc choosecolor {v vi w x cmd} {
global $v
global oldprefs prefstop
foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
- limitdiffs tabstop} {
+ limitdiffs tabstop perfile_attrs} {
global $v
set $v $oldprefs($v)
}
global maxwidth maxgraphpct
global oldprefs prefstop showneartags showlocalchanges
global fontpref mainfont textfont uifont
- global limitdiffs treediffs
+ global limitdiffs treediffs perfile_attrs
catch {destroy $prefstop}
unset prefstop
dohidelocalchanges
}
}
- if {$limitdiffs != $oldprefs(limitdiffs)} {
- # treediffs elements are limited by path
+ if {$limitdiffs != $oldprefs(limitdiffs) ||
+ ($perfile_attrs && !$oldprefs(perfile_attrs))} {
+ # treediffs elements are limited by path;
+ # won't have encodings cached if perfile_attrs was just turned on
catch {unset treediffs}
}
if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
{ ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
{ GBK CP936 MS936 windows-936 }
{ JIS_Encoding csJISEncoding }
- { Shift_JIS MS_Kanji csShiftJIS }
+ { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
{ Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
EUC-JP }
{ Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
}
proc tcl_encoding {enc} {
- global encoding_aliases
+ global encoding_aliases tcl_encoding_cache
+ if {[info exists tcl_encoding_cache($enc)]} {
+ return $tcl_encoding_cache($enc)
+ }
set names [encoding names]
set lcnames [string tolower $names]
set enc [string tolower $enc]
set i [lsearch -exact $lcnames $enc]
if {$i < 0} {
# look for "isonnn" instead of "iso-nnn" or "iso_nnn"
- if {[regsub {^iso[-_]} $enc iso encx]} {
+ if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
set i [lsearch -exact $lcnames $encx]
}
}
foreach e $ll {
set i [lsearch -exact $lcnames $e]
if {$i < 0} {
- if {[regsub {^iso[-_]} $e iso ex]} {
+ if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
set i [lsearch -exact $lcnames $ex]
}
}
break
}
}
+ set tclenc {}
if {$i >= 0} {
- return [lindex $names $i]
+ set tclenc [lindex $names $i]
}
- return {}
+ set tcl_encoding_cache($enc) $tclenc
+ return $tclenc
+}
+
+proc gitattr {path attr default} {
+ global path_attr_cache
+ if {[info exists path_attr_cache($attr,$path)]} {
+ set r $path_attr_cache($attr,$path)
+ } else {
+ set r "unspecified"
+ if {![catch {set line [exec git check-attr $attr -- $path]}]} {
+ regexp "(.*): encoding: (.*)" $line m f r
+ }
+ set path_attr_cache($attr,$path) $r
+ }
+ if {$r eq "unspecified"} {
+ return $default
+ }
+ return $r
+}
+
+proc cache_gitattr {attr pathlist} {
+ global path_attr_cache
+ set newlist {}
+ foreach path $pathlist {
+ if {![info exists path_attr_cache($attr,$path)]} {
+ lappend newlist $path
+ }
+ }
+ set lim 1000
+ if {[tk windowingsystem] == "win32"} {
+ # windows has a 32k limit on the arguments to a command...
+ set lim 30
+ }
+ while {$newlist ne {}} {
+ set head [lrange $newlist 0 [expr {$lim - 1}]]
+ set newlist [lrange $newlist $lim end]
+ if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
+ foreach row [split $rlist "\n"] {
+ if {[regexp "(.*): encoding: (.*)" $row m path value]} {
+ if {[string index $path 0] eq "\""} {
+ set path [encoding convertfrom [lindex $path 0]]
+ }
+ set path_attr_cache($attr,$path) $value
+ }
+ }
+ }
+ }
+}
+
+proc get_path_encoding {path} {
+ global gui_encoding perfile_attrs
+ set tcl_enc $gui_encoding
+ if {$path ne {} && $perfile_attrs} {
+ set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
+ if {$enc2 ne {}} {
+ set tcl_enc $enc2
+ }
+ }
+ return $tcl_enc
}
# First check that Tcl/Tk is recent enough
}
# defaults...
-set datemode 0
set wrcomcmd "git diff-tree --stdin -p --pretty"
set gitencoding {}
puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
}
+set gui_encoding [encoding system]
+catch {
+ set enc [exec git config --get gui.encoding]
+ if {$enc ne {}} {
+ set tclenc [tcl_encoding $enc]
+ if {$tclenc ne {}} {
+ set gui_encoding $tclenc
+ } else {
+ puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
+ }
+ }
+}
+
set mainfont {Helvetica 9}
set textfont {Courier 9}
set uifont {Helvetica 9 bold}
set limitdiffs 1
set datetimeformat "%Y-%m-%d %H:%M:%S"
set autoselect 1
+set perfile_attrs 0
+
+set extdifftool "meld"
set colors {green red blue magenta darkgrey brown orange}
set bgcolor white
set diffcontext 3
set ignorespace 0
set selectbgcolor gray85
+set markbgcolor "#e0e0ff"
+
+set circlecolors {white blue gray blue blue}
+
+# button for popping up context menus
+if {[tk windowingsystem] eq "aqua"} {
+ set ctxbut <Button-2>
+} else {
+ set ctxbut <Button-3>
+}
## For msgcat loading, first locate the installation location.
if { [info exists ::env(GITK_MSGSDIR)] } {
exit 1
}
-set mergeonly 0
+set selecthead {}
+set selectheadid {}
+
set revtreeargs {}
set cmdline_files {}
set i 0
foreach arg $argv {
switch -glob -- $arg {
"" { }
- "-d" { set datemode 1 }
- "--merge" {
- set mergeonly 1
- lappend revtreeargs $arg
- }
"--" {
set cmdline_files [lrange $argv [expr {$i + 1}] end]
break
}
+ "--select-commit=*" {
+ set selecthead [string range $arg 16 end]
+ }
"--argscmd=*" {
set revtreeargscmd [string range $arg 10 end]
}
incr i
}
+if {$selecthead eq "HEAD"} {
+ set selecthead {}
+}
+
if {$i >= [llength $argv] && $revtreeargs ne {}} {
- # no -- on command line, but some arguments (other than -d)
+ # no -- on command line, but some arguments (other than --argscmd)
if {[catch {
set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
set cmdline_files [split $f "\n"]
}
}
-if {$mergeonly} {
- # find the list of unmerged files
- set mlist {}
- set nr_unmerged 0
- if {[catch {
- set fd [open "| git ls-files -u" r]
- } err]} {
- show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
- exit 1
- }
- while {[gets $fd line] >= 0} {
- set i [string first "\t" $line]
- if {$i < 0} continue
- set fname [string range $line [expr {$i+1}] end]
- if {[lsearch -exact $mlist $fname] >= 0} continue
- incr nr_unmerged
- if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
- lappend mlist $fname
- }
- }
- catch {close $fd}
- if {$mlist eq {}} {
- if {$nr_unmerged == 0} {
- show_error {} . [mc "No files selected: --merge specified but\
- no files are unmerged."]
- } else {
- show_error {} . [mc "No files selected: --merge specified but\
- no unmerged files are within file limit."]
- }
- exit 1
- }
- set cmdline_files $mlist
-}
-
set nullid "0000000000000000000000000000000000000000"
set nullid2 "0000000000000000000000000000000000000001"
+set nullfile "/dev/null"
set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
set viewargs(0) {}
set viewargscmd(0) {}
+set selectedline {}
+set numcommits 0
set loginstance 0
set cmdlineok 0
set stopped 0
set viewargs(1) $revtreeargs
set viewargscmd(1) $revtreeargscmd
set viewperm(1) 0
+ set vdatemode(1) 0
addviewmenu 1
- .bar.view entryconf [mc "Edit view..."] -state normal
- .bar.view entryconf [mc "Delete view"] -state normal
+ .bar.view entryconf [mca "Edit view..."] -state normal
+ .bar.view entryconf [mca "Delete view"] -state normal
}
if {[info exists permviews]} {
addviewmenu $n
}
}
-getcommits
+getcommits {}