![[tokkee]](http://tokkee.org/images/avatar.png){kind=avatar}
index d48fbad857c02bc12e058bb020d014268803b984..61771bd05cdb33f59458a192ff84e59b85a4ef2c 100755 (executable)
--- a/gitk
+++ b/gitk
if {$sdm != 2} {
lappend ret $id
} else {
if {$sdm != 2} {
lappend ret $id
} else {
- lset ret end [lindex $ret end]...$id
+ lset ret end $id...[lindex $ret end]
}
lappend pos $id
}
}
lappend pos $id
}
global tagids idtags headids idheads tagobjid
global otherrefids idotherrefs mainhead mainheadid
global selecthead selectheadid
global tagids idtags headids idheads tagobjid
global otherrefids idotherrefs mainhead mainheadid
global selecthead selectheadid
+ global hideremotes
foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
catch {unset $v}
foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
catch {unset $v}
if {![string match "refs/*" $ref]} continue
set name [string range $ref 5 end]
if {[string match "remotes/*" $name]} {
if {![string match "refs/*" $ref]} continue
set name [string range $ref 5 end]
if {[string match "remotes/*" $name]} {
- if {![string match "*/HEAD" $name]} {
+ if {![string match "*/HEAD" $name] && !$hideremotes} {
set headids($name) $id
lappend idheads($id) $name
}
set headids($name) $id
lappend idheads($id) $name
}
}
}
}
}
-proc show_error {w top msg} {
+proc show_error {w top msg {mc mc}} {
message $w.m -text $msg -justify center -aspect 400
pack $w.m -side top -fill x -padx 20 -pady 20
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 "destroy $top"
+ button $w.ok -text [$mc OK] -command "destroy $top"
pack $w.ok -side bottom -fill x
bind $top <Visibility> "grab $top; focus $top"
bind $top <Key-Return> "destroy $top"
pack $w.ok -side bottom -fill x
bind $top <Visibility> "grab $top; focus $top"
bind $top <Key-Return> "destroy $top"
label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
spinbox .bleft.mid.diffcontext -width 5 -font textfont \
label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
spinbox .bleft.mid.diffcontext -width 5 -font textfont \
- -from 1 -increment 1 -to 10000000 \
+ -from 0 -increment 1 -to 10000000 \
-validate all -validatecommand "diffcontextvalidate %P" \
-textvariable diffcontextstring
.bleft.mid.diffcontext set $diffcontext
-validate all -validatecommand "diffcontextvalidate %P" \
-textvariable diffcontextstring
.bleft.mid.diffcontext set $diffcontext
global maxwidth showneartags showlocalchanges
global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
global cmitmode wrapcomment datetimeformat limitdiffs
global maxwidth showneartags showlocalchanges
global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
global cmitmode wrapcomment datetimeformat limitdiffs
- global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
+ global colors uicolor bgcolor fgcolor diffcolors diffcontext selectbgcolor
global autoselect extdifftool perfile_attrs markbgcolor
global autoselect extdifftool perfile_attrs markbgcolor
+ global hideremotes
if {$stuffsaved} return
if {![winfo viewable .]} return
catch {
if {$stuffsaved} return
if {![winfo viewable .]} return
catch {
+ if {[file exists ~/.gitk-new]} {file delete -force ~/.gitk-new}
set f [open "~/.gitk-new" w]
if {$::tcl_platform(platform) eq {windows}} {
file attributes "~/.gitk-new" -hidden true
set f [open "~/.gitk-new" w]
if {$::tcl_platform(platform) eq {windows}} {
file attributes "~/.gitk-new" -hidden true
puts $f [list set wrapcomment $wrapcomment]
puts $f [list set autoselect $autoselect]
puts $f [list set showneartags $showneartags]
puts $f [list set wrapcomment $wrapcomment]
puts $f [list set autoselect $autoselect]
puts $f [list set showneartags $showneartags]
+ puts $f [list set hideremotes $hideremotes]
puts $f [list set showlocalchanges $showlocalchanges]
puts $f [list set datetimeformat $datetimeformat]
puts $f [list set limitdiffs $limitdiffs]
puts $f [list set showlocalchanges $showlocalchanges]
puts $f [list set datetimeformat $datetimeformat]
puts $f [list set limitdiffs $limitdiffs]
+ puts $f [list set uicolor $uicolor]
puts $f [list set bgcolor $bgcolor]
puts $f [list set fgcolor $fgcolor]
puts $f [list set colors $colors]
puts $f [list set bgcolor $bgcolor]
puts $f [list set fgcolor $fgcolor]
puts $f [list set colors $colors]
set gdttype [mc "touching paths:"]
}
set gdttype [mc "touching paths:"]
}
+proc gitknewtmpdir {} {
+ global diffnum gitktmpdir gitdir
+
+ 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 {}
+ }
+ return $diffdir
+}
+
proc save_file_from_commit {filename output what} {
global nullfile
proc save_file_from_commit {filename output what} {
global nullfile
}
proc external_diff {} {
}
proc external_diff {} {
- global gitktmpdir nullid nullid2
+ global nullid nullid2
global flist_menu_file
global diffids
global flist_menu_file
global diffids
- global diffnum
- global gitdir extdifftool
+ global extdifftool
if {[llength $diffids] == 1} {
# no reference commit given
if {[llength $diffids] == 1} {
# no reference commit given
}
# make sure that several diffs wont collide
}
# 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
- }
+ set diffdir [gitknewtmpdir]
+ if {$diffdir eq {}} return
# gather files to diff
set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
# gather files to diff
set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
global known_view_options
toplevel $top
global known_view_options
toplevel $top
- wm title $top [concat $title "-- criteria for selecting revisions"]
+ wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
make_transient $top .
# View name
make_transient $top .
# View name
set cmd [concat | git diff-index --cached $flags]
if {[llength $ids] > 1} {
# comparing index with specific revision
set cmd [concat | git diff-index --cached $flags]
if {[llength $ids] > 1} {
# comparing index with specific revision
- if {$i == 0} {
+ if {$j == 0} {
lappend cmd -R [lindex $ids 1]
} else {
lappend cmd [lindex $ids 0]
lappend cmd -R [lindex $ids 1]
} else {
lappend cmd [lindex $ids 0]
global diffcontextstring diffcontext
if {[string is integer -strict $diffcontextstring]} {
global diffcontextstring diffcontext
if {[string is integer -strict $diffcontextstring]} {
- if {$diffcontextstring > 0} {
+ if {$diffcontextstring >= 0} {
set diffcontext $diffcontextstring
reselectline
}
set diffcontext $diffcontextstring
reselectline
}
if {[package vcompare $git_version "1.6.1"] >= 0} {
set textconv "--textconv"
}
if {[package vcompare $git_version "1.6.1"] >= 0} {
set textconv "--textconv"
}
- set cmd [diffcmd $ids "-p $textconv -C --cc --no-commit-id -U$diffcontext"]
+ set submodule {}
+ if {[package vcompare $git_version "1.6.6"] >= 0} {
+ set submodule "--submodule"
+ }
+ set cmd [diffcmd $ids "-p $textconv $submodule -C --cc --no-commit-id -U$diffcontext"]
if {$ignorespace} {
append cmd " -w"
}
if {$ignorespace} {
append cmd " -w"
}
$ctext conf -state normal
while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
$ctext conf -state normal
while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
- close $bdf
+ catch {close $bdf}
return 0
}
if {![string compare -length 5 "diff " $line]} {
return 0
}
if {![string compare -length 5 "diff " $line]} {
set diffnparents [expr {[string length $ats] - 1}]
set diffinhdr 0
set diffnparents [expr {[string length $ats] - 1}]
set diffinhdr 0
+ } elseif {![string compare -length 10 "Submodule " $line]} {
+ # start of a new submodule
+ if {[string compare [$ctext get "end - 4c" end] "\n \n\n"]} {
+ $ctext insert end "\n"; # Add newline after commit message
+ }
+ set curdiffstart [$ctext index "end - 1c"]
+ lappend ctext_file_names ""
+ set fname [string range $line 10 [expr [string last " " $line] - 1]]
+ lappend ctext_file_lines $fname
+ makediffhdr $fname $ids
+ $ctext insert end "\n$line\n" filesep
+ } elseif {![string compare -length 3 " >" $line]} {
+ $ctext insert end "$line\n" dresult
+ } elseif {![string compare -length 3 " <" $line]} {
+ $ctext insert end "$line\n" d0
} elseif {$diffinhdr} {
if {![string compare -length 12 "rename from " $line]} {
set fname [string range $line [expr 6 + [string first " from " $line] ] end]
} elseif {$diffinhdr} {
if {![string compare -length 12 "rename from " $line]} {
set fname [string range $line [expr 6 + [string first " from " $line] ] end]
}
$ctext conf -state disabled
if {[eof $bdf]} {
}
$ctext conf -state disabled
if {[eof $bdf]} {
- close $bdf
+ catch {close $bdf}
return 0
}
return [expr {$nr >= 1000? 2: 1}]
return 0
}
return [expr {$nr >= 1000? 2: 1}]
}
set id [lindex $matches 0]
}
}
set id [lindex $matches 0]
}
+ } else {
+ if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
+ error_popup [mc "Revision %s is not known" $sha1string]
+ return
+ }
}
}
if {[commitinview $id $curview]} {
}
}
if {[commitinview $id $curview]} {
if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
set msg [mc "SHA1 id %s is not known" $sha1string]
} else {
if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
set msg [mc "SHA1 id %s is not known" $sha1string]
} else {
- set msg [mc "Tag/Head %s is not known" $sha1string]
+ set msg [mc "Revision %s is not in the current view" $sha1string]
}
error_popup $msg
}
}
error_popup $msg
}
appendshortlink $a [mc "Commit "] " $heada\n"
appendshortlink $b [mc " differs from\n "] \
" $headb\n"
appendshortlink $a [mc "Commit "] " $heada\n"
appendshortlink $b [mc " differs from\n "] \
" $headb\n"
- $ctext insert end [mc "- stopping\n"]
- break
+ $ctext insert end [mc "Diff of commits:\n\n"]
+ $ctext conf -state disabled
+ update
+ diffcommits $a $b
+ return
}
}
if {$skipa} {
}
}
if {$skipa} {
$ctext conf -state disabled
}
$ctext conf -state disabled
}
+proc diffcommits {a b} {
+ global diffcontext diffids blobdifffd diffinhdr
+
+ set tmpdir [gitknewtmpdir]
+ set fna [file join $tmpdir "commit-[string range $a 0 7]"]
+ set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
+ if {[catch {
+ exec git diff-tree -p --pretty $a >$fna
+ exec git diff-tree -p --pretty $b >$fnb
+ } err]} {
+ error_popup [mc "Error writing commit to file: %s" $err]
+ return
+ }
+ if {[catch {
+ set fd [open "| diff -U$diffcontext $fna $fnb" r]
+ } err]} {
+ error_popup [mc "Error diffing commits: %s" $err]
+ return
+ }
+ set diffids [list commits $a $b]
+ set blobdifffd($diffids) $fd
+ set diffinhdr 0
+ filerun $fd [list getblobdiffline $fd $diffids]
+}
+
proc diffvssel {dirn} {
global rowmenuid selectedline
proc diffvssel {dirn} {
global rowmenuid selectedline
proc doprefs {} {
global maxwidth maxgraphpct
global oldprefs prefstop showneartags showlocalchanges
proc doprefs {} {
global maxwidth maxgraphpct
global oldprefs prefstop showneartags showlocalchanges
- global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
+ global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
global tabstop limitdiffs autoselect extdifftool perfile_attrs
global tabstop limitdiffs autoselect extdifftool perfile_attrs
+ global hideremotes
set top .gitkprefs
set prefstop $top
set top .gitkprefs
set prefstop $top
return
}
foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
return
}
foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
- limitdiffs tabstop perfile_attrs} {
+ limitdiffs tabstop perfile_attrs hideremotes} {
set oldprefs($v) [set $v]
}
toplevel $top
set oldprefs($v) [set $v]
}
toplevel $top
checkbutton $top.ntag -text [mc "Display nearby tags"] \
-font optionfont -variable showneartags
grid x $top.ntag -sticky w
checkbutton $top.ntag -text [mc "Display nearby tags"] \
-font optionfont -variable showneartags
grid x $top.ntag -sticky w
+ checkbutton $top.hideremotes -text [mc "Hide remote refs"] \
+ -font optionfont -variable hideremotes
+ grid x $top.hideremotes -sticky w
checkbutton $top.ldiff -text [mc "Limit diffs to listed paths"] \
-font optionfont -variable limitdiffs
grid x $top.ldiff -sticky w
checkbutton $top.ldiff -text [mc "Limit diffs to listed paths"] \
-font optionfont -variable limitdiffs
grid x $top.ldiff -sticky w
label $top.cdisp -text [mc "Colors: press to choose"]
grid $top.cdisp - -sticky w -pady 10
label $top.cdisp -text [mc "Colors: press to choose"]
grid $top.cdisp - -sticky w -pady 10
+ label $top.ui -padx 40 -relief sunk -background $uicolor
+ button $top.uibut -text [mc "Interface"] -font optionfont \
+ -command [list choosecolor uicolor {} $top.ui [mc "interface"] setui]
+ grid x $top.uibut $top.ui -sticky w
label $top.bg -padx 40 -relief sunk -background $bgcolor
button $top.bgbut -text [mc "Background"] -font optionfont \
-command [list choosecolor bgcolor {} $top.bg [mc "background"] setbg]
label $top.bg -padx 40 -relief sunk -background $bgcolor
button $top.bgbut -text [mc "Background"] -font optionfont \
-command [list choosecolor bgcolor {} $top.bg [mc "background"] setbg]
allcanvs itemconf secsel -fill $c
}
allcanvs itemconf secsel -fill $c
}
+# This sets the background color and the color scheme for the whole UI.
+# For some reason, tk_setPalette chooses a nasty dark red for selectColor
+# if we don't specify one ourselves, which makes the checkbuttons and
+# radiobuttons look bad. This chooses white for selectColor if the
+# background color is light, or black if it is dark.
+proc setui {c} {
+ set bg [winfo rgb . $c]
+ set selc black
+ if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
+ set selc white
+ }
+ tk_setPalette background $c selectColor $selc
+}
+
proc setbg {c} {
global bglist
proc setbg {c} {
global bglist
global oldprefs prefstop
foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
global oldprefs prefstop
foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
- limitdiffs tabstop perfile_attrs} {
+ limitdiffs tabstop perfile_attrs hideremotes} {
global $v
set $v $oldprefs($v)
}
global $v
set $v $oldprefs($v)
}
global oldprefs prefstop showneartags showlocalchanges
global fontpref mainfont textfont uifont
global limitdiffs treediffs perfile_attrs
global oldprefs prefstop showneartags showlocalchanges
global fontpref mainfont textfont uifont
global limitdiffs treediffs perfile_attrs
+ global hideremotes
catch {destroy $prefstop}
unset prefstop
catch {destroy $prefstop}
unset prefstop
$limitdiffs != $oldprefs(limitdiffs)} {
reselectline
}
$limitdiffs != $oldprefs(limitdiffs)} {
reselectline
}
+ if {$hideremotes != $oldprefs(hideremotes)} {
+ rereadrefs
+ }
}
proc formatdate {d} {
}
proc formatdate {d} {
} else {
set r "unspecified"
if {![catch {set line [exec git check-attr $attr -- $path]}]} {
} else {
set r "unspecified"
if {![catch {set line [exec git check-attr $attr -- $path]}]} {
- regexp "(.*): encoding: (.*)" $line m f r
+ regexp "(.*): $attr: (.*)" $line m f r
}
set path_attr_cache($attr,$path) $r
}
}
set path_attr_cache($attr,$path) $r
}
set newlist [lrange $newlist $lim end]
if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
foreach row [split $rlist "\n"] {
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 {[regexp "(.*): $attr: (.*)" $row m path value]} {
if {[string index $path 0] eq "\""} {
set path [encoding convertfrom [lindex $path 0]]
}
if {[string index $path 0] eq "\""} {
set path [encoding convertfrom [lindex $path 0]]
}
# First check that Tcl/Tk is recent enough
if {[catch {package require Tk 8.4} err]} {
# First check that Tcl/Tk is recent enough
if {[catch {package require Tk 8.4} err]} {
- show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
- Gitk requires at least Tcl/Tk 8.4."]
+ show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
+ Gitk requires at least Tcl/Tk 8.4." list
exit 1
}
exit 1
}
set cmitmode "patch"
set wrapcomment "none"
set showneartags 1
set cmitmode "patch"
set wrapcomment "none"
set showneartags 1
+set hideremotes 0
set maxrefs 20
set maxlinelen 200
set showlocalchanges 1
set maxrefs 20
set maxlinelen 200
set showlocalchanges 1
}
set colors {green red blue magenta darkgrey brown orange}
}
set colors {green red blue magenta darkgrey brown orange}
+set uicolor grey85
set bgcolor white
set fgcolor black
set diffcolors {red "#00a000" blue}
set bgcolor white
set fgcolor black
set diffcolors {red "#00a000" blue}
parsefont uifont $uifont
eval font create uifont [fontflags uifont]
parsefont uifont $uifont
eval font create uifont [fontflags uifont]
+setui $uicolor
+
setoptions
# check that we can find a .git directory somewhere...
setoptions
# check that we can find a .git directory somewhere...