gitk: Clean up file encoding code and add enable/disable option

This adds an option allowing the user to select whether gitk should
look up per-file encoding settings using git check-attr or not.  If
not, gitk uses the global encoding set in the git config (as reported
by git config --get gui.encoding) for all files, or if that is not
set, then the system encoding.

The option is controlled by a checkbox in the Edit->Preferences
window, and defaults to off for now because git check-attr is so
slow.  When the user turns it on we discard any cached diff file
lists in treediffs, because we may not have encodings cached for
the files listed in those lists, meaning that getblobdiffline will
do it for each file, which will be really really slow.

This adjusts the limit of how many paths cache_gitattr passes to each
instance of git check-attr depending on whether we're running under
windows or not.  Passing only 30 doesn't effectively amortize the
startup costs of git check-attr, but it's all we can do under windows
because of the 32k limit on arguments to a command.  Under other OSes
we pass up to 1000.

Similarly we adjust how many lines gettreediffline processes depending
on whether we are doing per-file encodings so that we don't run for
too long.  When we are, 500 seems to be a reasonable limit, leading
to gettreediffline taking about 60-70ms under Linux (almost all of
which is in cache_gitattr, unfortunately).  This means that we can
take out the update call in cache_gitattr.

This adds a simple cache on [tclencoding].  Now that we get repeated
calls to translate the same encoding, this is useful.

This reindents the new code added in the last couple of commits to
conform to the gitk 4-space indent and makes various other improvements:
use regexp in gitattr and cache_gitattr instead of split + join + regsub,
make gui_encoding be the value from [tclencoding] to avoid having to
do [tcl_encoding $gui_encoding] in each call to get_path_encoding,
and print a warning message at startup if $gui_encoding isn't
supported by Tcl.

Signed-off-by: Paul Mackerras <paulus@samba.org>
This commit is contained in:
Paul Mackerras 2008-10-15 22:23:03 +11:00
parent 4db09304f9
commit 39ee47ef06

149
gitk
View File

@ -2332,7 +2332,7 @@ proc savestuff {w} {
global viewname viewfiles viewargs viewargscmd viewperm nextviewnum global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
global cmitmode wrapcomment datetimeformat limitdiffs global cmitmode wrapcomment datetimeformat limitdiffs
global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
global autoselect extdifftool global autoselect extdifftool perfile_attrs
if {$stuffsaved} return if {$stuffsaved} return
if {![winfo viewable .]} return if {![winfo viewable .]} return
@ -2359,6 +2359,7 @@ proc savestuff {w} {
puts $f [list set diffcontext $diffcontext] puts $f [list set diffcontext $diffcontext]
puts $f [list set selectbgcolor $selectbgcolor] puts $f [list set selectbgcolor $selectbgcolor]
puts $f [list set extdifftool $extdifftool] 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(main) [wm geometry .]"
puts $f "set geometry(topwidth) [winfo width .tf]" puts $f "set geometry(topwidth) [winfo width .tf]"
@ -6528,11 +6529,20 @@ proc gettreediffs {ids} {
proc gettreediffline {gdtf ids} { proc gettreediffline {gdtf ids} {
global treediff treediffs treepending diffids diffmergeid global treediff treediffs treepending diffids diffmergeid
global cmitmode vfilelimit curview limitdiffs global cmitmode vfilelimit curview limitdiffs perfile_attrs
set nr 0 set nr 0
set sublist {} set sublist {}
while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} { 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] set i [string first "\t" $line]
if {$i >= 0} { if {$i >= 0} {
set file [string range $line [expr {$i+1}] end] set file [string range $line [expr {$i+1}] end]
@ -6544,9 +6554,11 @@ proc gettreediffline {gdtf ids} {
lappend sublist $file lappend sublist $file
} }
} }
cache_gitattr encoding $sublist if {$perfile_attrs} {
cache_gitattr encoding $sublist
}
if {![eof $gdtf]} { if {![eof $gdtf]} {
return [expr {$nr >= 1000? 2: 1}] return [expr {$nr >= $max? 2: 1}]
} }
close $gdtf close $gdtf
if {$limitdiffs && $vfilelimit($curview) ne {}} { if {$limitdiffs && $vfilelimit($curview) ne {}} {
@ -9318,7 +9330,7 @@ proc doprefs {} {
global maxwidth maxgraphpct global maxwidth maxgraphpct
global oldprefs prefstop showneartags showlocalchanges global oldprefs prefstop showneartags showlocalchanges
global bgcolor fgcolor ctext diffcolors selectbgcolor global bgcolor fgcolor ctext diffcolors selectbgcolor
global tabstop limitdiffs autoselect extdifftool global tabstop limitdiffs autoselect extdifftool perfile_attrs
set top .gitkprefs set top .gitkprefs
set prefstop $top set prefstop $top
@ -9327,7 +9339,7 @@ proc doprefs {} {
return return
} }
foreach v {maxwidth maxgraphpct showneartags showlocalchanges \ foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
limitdiffs tabstop} { limitdiffs tabstop perfile_attrs} {
set oldprefs($v) [set $v] set oldprefs($v) [set $v]
} }
toplevel $top toplevel $top
@ -9369,6 +9381,11 @@ proc doprefs {} {
checkbutton $top.ldiff.b -variable limitdiffs checkbutton $top.ldiff.b -variable limitdiffs
pack $top.ldiff.b $top.ldiff.l -side left pack $top.ldiff.b $top.ldiff.l -side left
grid x $top.ldiff -sticky w 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 entry $top.extdifft -textvariable extdifftool
frame $top.extdifff frame $top.extdifff
@ -9478,7 +9495,7 @@ proc prefscan {} {
global oldprefs prefstop global oldprefs prefstop
foreach v {maxwidth maxgraphpct showneartags showlocalchanges \ foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
limitdiffs tabstop} { limitdiffs tabstop perfile_attrs} {
global $v global $v
set $v $oldprefs($v) set $v $oldprefs($v)
} }
@ -9491,7 +9508,7 @@ proc prefsok {} {
global maxwidth maxgraphpct global maxwidth maxgraphpct
global oldprefs prefstop showneartags showlocalchanges global oldprefs prefstop showneartags showlocalchanges
global fontpref mainfont textfont uifont global fontpref mainfont textfont uifont
global limitdiffs treediffs global limitdiffs treediffs perfile_attrs
catch {destroy $prefstop} catch {destroy $prefstop}
unset prefstop unset prefstop
@ -9524,8 +9541,10 @@ proc prefsok {} {
dohidelocalchanges dohidelocalchanges
} }
} }
if {$limitdiffs != $oldprefs(limitdiffs)} { if {$limitdiffs != $oldprefs(limitdiffs) ||
# treediffs elements are limited by path ($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} catch {unset treediffs}
} }
if {$fontchanged || $maxwidth != $oldprefs(maxwidth) if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
@ -9784,7 +9803,10 @@ set encoding_aliases {
} }
proc tcl_encoding {enc} { 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 names [encoding names]
set lcnames [string tolower $names] set lcnames [string tolower $names]
set enc [string tolower $enc] set enc [string tolower $enc]
@ -9812,68 +9834,70 @@ proc tcl_encoding {enc} {
break break
} }
} }
set tclenc {}
if {$i >= 0} { 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} { proc gitattr {path attr default} {
global path_attr_cache global path_attr_cache
if {[info exists path_attr_cache($attr,$path)]} { if {[info exists path_attr_cache($attr,$path)]} {
set r $path_attr_cache($attr,$path) set r $path_attr_cache($attr,$path)
} elseif {[catch {set r [exec git check-attr $attr -- $path]}]} { } else {
set r unspecified set r "unspecified"
} else { if {![catch {set line [exec git check-attr $attr -- $path]}]} {
set r [join [lrange [split $r :] 2 end] :] regexp "(.*): encoding: (.*)" $line m f r
regsub {^ } $r {} r
} }
set path_attr_cache($attr,$path) $r set path_attr_cache($attr,$path) $r
if {$r eq {unspecified}} { }
return $default if {$r eq "unspecified"} {
} return $default
return $r }
return $r
} }
proc cache_gitattr {attr pathlist} { proc cache_gitattr {attr pathlist} {
global path_attr_cache global path_attr_cache
set newlist {} set newlist {}
foreach path $pathlist { foreach path $pathlist {
if {[info exists path_attr_cache($attr,$path)]} continue if {![info exists path_attr_cache($attr,$path)]} {
lappend newlist $path lappend newlist $path
} }
while {$newlist ne {}} { }
set head [lrange $newlist 0 29] set lim 1000
set newlist [lrange $newlist 30 end] if {[tk windowingsystem] == "win32"} {
if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} { # windows has a 32k limit on the arguments to a command...
foreach row [split $rlist "\n"] { set lim 30
set cols [split $row :] }
set path [lindex $cols 0] while {$newlist ne {}} {
set value [join [lrange $cols 2 end] :] set head [lrange $newlist 0 [expr {$lim - 1}]]
if {[string index $path 0] eq "\""} { set newlist [lrange $newlist $lim end]
set path [encoding convertfrom [lindex $path 0]] if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
} foreach row [split $rlist "\n"] {
regsub {^ } $value {} value if {[regexp "(.*): encoding: (.*)" $row m path value]} {
set path_attr_cache($attr,$path) $value if {[string index $path 0] eq "\""} {
} set path [encoding convertfrom [lindex $path 0]]
}
set path_attr_cache($attr,$path) $value
} }
update }
} }
}
} }
proc get_path_encoding {path} { proc get_path_encoding {path} {
global gui_encoding global gui_encoding perfile_attrs
set tcl_enc [tcl_encoding $gui_encoding] set tcl_enc $gui_encoding
if {$tcl_enc eq {}} { if {$path ne {} && $perfile_attrs} {
set tcl_enc [encoding system] set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
if {$enc2 ne {}} {
set tcl_enc $enc2
} }
if {$path ne {}} { }
set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]] return $tcl_enc
if {$enc2 ne {}} {
set tcl_enc $enc2
}
}
return $tcl_enc
} }
# First check that Tcl/Tk is recent enough # First check that Tcl/Tk is recent enough
@ -9900,7 +9924,15 @@ if {$tclencoding == {}} {
set gui_encoding [encoding system] set gui_encoding [encoding system]
catch { catch {
set gui_encoding [exec git config --get gui.encoding] 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 mainfont {Helvetica 9}
@ -9924,6 +9956,7 @@ set showlocalchanges 1
set limitdiffs 1 set limitdiffs 1
set datetimeformat "%Y-%m-%d %H:%M:%S" set datetimeformat "%Y-%m-%d %H:%M:%S"
set autoselect 1 set autoselect 1
set perfile_attrs 0
set extdifftool "meld" set extdifftool "meld"