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>
Paul Mackerras committed
Oct 15, 2008 at 22:23 UTC
39ee47ef0616fb67ffdffca98283272c36deecc9
1 file changed
+92
-59
gitk
+92
-59
@@ -2332,7 +2332,7 @@ proc savestuff {w} {
2332
global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2333
global cmitmode wrapcomment datetimeformat limitdiffs
2334
global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
2335
- global autoselect extdifftool
2335
+ global autoselect extdifftool perfile_attrs
2336
2337
if {$stuffsaved} return
2338
if {![winfo viewable .]} return
@@ -2359,6 +2359,7 @@ proc savestuff {w} {
2359
puts $f [list set diffcontext $diffcontext]
2360
puts $f [list set selectbgcolor $selectbgcolor]
2361
puts $f [list set extdifftool $extdifftool]
2362
+ puts $f [list set perfile_attrs $perfile_attrs]
2363
2364
puts $f "set geometry(main) [wm geometry .]"
2365
puts $f "set geometry(topwidth) [winfo width .tf]"
@@ -6528,11 +6529,20 @@ proc gettreediffs {ids} {
6529
6530
proc gettreediffline {gdtf ids} {
6531
global treediff treediffs treepending diffids diffmergeid
6531
- global cmitmode vfilelimit curview limitdiffs
6532
+ global cmitmode vfilelimit curview limitdiffs perfile_attrs
6533
6534
set nr 0
6535
set sublist {}
6535
- while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
6536
+ set max 1000
6537
+ if {$perfile_attrs} {
6538
+ # cache_gitattr is slow, and even slower on win32 where we
6539
+ # have to invoke it for only about 30 paths at a time
6540
+ set max 500
6541
+ if {[tk windowingsystem] == "win32"} {
6542
+ set max 120
6543
+ }
6544
+ }
6545
+ while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
6546
set i [string first "\t" $line]
6547
if {$i >= 0} {
6548
set file [string range $line [expr {$i+1}] end]
@@ -6544,9 +6554,11 @@ proc gettreediffline {gdtf ids} {
6554
lappend sublist $file
6555
}
6556
}
6547
- cache_gitattr encoding $sublist
6557
+ if {$perfile_attrs} {
6558
+ cache_gitattr encoding $sublist
6559
+ }
6560
if {![eof $gdtf]} {
6549
- return [expr {$nr >= 1000? 2: 1}]
6561
+ return [expr {$nr >= $max? 2: 1}]
6562
}
6563
close $gdtf
6564
if {$limitdiffs && $vfilelimit($curview) ne {}} {
@@ -9318,7 +9330,7 @@ proc doprefs {} {
9330
global maxwidth maxgraphpct
9331
global oldprefs prefstop showneartags showlocalchanges
9332
global bgcolor fgcolor ctext diffcolors selectbgcolor
9321
- global tabstop limitdiffs autoselect extdifftool
9333
+ global tabstop limitdiffs autoselect extdifftool perfile_attrs
9334
9335
set top .gitkprefs
9336
set prefstop $top
@@ -9327,7 +9339,7 @@ proc doprefs {} {
9339
return
9340
}
9341
foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9330
- limitdiffs tabstop} {
9342
+ limitdiffs tabstop perfile_attrs} {
9343
set oldprefs($v) [set $v]
9344
}
9345
toplevel $top
@@ -9369,6 +9381,11 @@ proc doprefs {} {
9381
checkbutton $top.ldiff.b -variable limitdiffs
9382
pack $top.ldiff.b $top.ldiff.l -side left
9383
grid x $top.ldiff -sticky w
9384
+ frame $top.lattr
9385
+ label $top.lattr.l -text [mc "Support per-file encodings"] -font optionfont
9386
+ checkbutton $top.lattr.b -variable perfile_attrs
9387
+ pack $top.lattr.b $top.lattr.l -side left
9388
+ grid x $top.lattr -sticky w
9389
9390
entry $top.extdifft -textvariable extdifftool
9391
frame $top.extdifff
@@ -9478,7 +9495,7 @@ proc prefscan {} {
9495
global oldprefs prefstop
9496
9497
foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9481
- limitdiffs tabstop} {
9498
+ limitdiffs tabstop perfile_attrs} {
9499
global $v
9500
set $v $oldprefs($v)
9501
}
@@ -9491,7 +9508,7 @@ proc prefsok {} {
9508
global maxwidth maxgraphpct
9509
global oldprefs prefstop showneartags showlocalchanges
9510
global fontpref mainfont textfont uifont
9494
- global limitdiffs treediffs
9511
+ global limitdiffs treediffs perfile_attrs
9512
9513
catch {destroy $prefstop}
9514
unset prefstop
@@ -9524,8 +9541,10 @@ proc prefsok {} {
9541
dohidelocalchanges
9542
}
9543
}
9527
- if {$limitdiffs != $oldprefs(limitdiffs)} {
9528
- # treediffs elements are limited by path
9544
+ if {$limitdiffs != $oldprefs(limitdiffs) ||
9545
+ ($perfile_attrs && !$oldprefs(perfile_attrs))} {
9546
+ # treediffs elements are limited by path;
9547
+ # won't have encodings cached if perfile_attrs was just turned on
9548
catch {unset treediffs}
9549
}
9550
if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
@@ -9784,7 +9803,10 @@ set encoding_aliases {
9803
}
9804
9805
proc tcl_encoding {enc} {
9787
- global encoding_aliases
9806
+ global encoding_aliases tcl_encoding_cache
9807
+ if {[info exists tcl_encoding_cache($enc)]} {
9808
+ return $tcl_encoding_cache($enc)
9809
+ }
9810
set names [encoding names]
9811
set lcnames [string tolower $names]
9812
set enc [string tolower $enc]
@@ -9812,68 +9834,70 @@ proc tcl_encoding {enc} {
9834
break
9835
}
9836
}
9837
+ set tclenc {}
9838
if {$i >= 0} {
9816
- return [lindex $names $i]
9839
+ set tclenc [lindex $names $i]
9840
}
9818
- return {}
9841
+ set tcl_encoding_cache($enc) $tclenc
9842
+ return $tclenc
9843
}
9844
9845
proc gitattr {path attr default} {
9822
- global path_attr_cache
9823
- if {[info exists path_attr_cache($attr,$path)]} {
9824
- set r $path_attr_cache($attr,$path)
9825
- } elseif {[catch {set r [exec git check-attr $attr -- $path]}]} {
9826
- set r unspecified
9827
- } else {
9828
- set r [join [lrange [split $r :] 2 end] :]
9829
- regsub {^ } $r {} r
9846
+ global path_attr_cache
9847
+ if {[info exists path_attr_cache($attr,$path)]} {
9848
+ set r $path_attr_cache($attr,$path)
9849
+ } else {
9850
+ set r "unspecified"
9851
+ if {![catch {set line [exec git check-attr $attr -- $path]}]} {
9852
+ regexp "(.*): encoding: (.*)" $line m f r
9853
}
9854
set path_attr_cache($attr,$path) $r
9832
- if {$r eq {unspecified}} {
9833
- return $default
9834
- }
9835
- return $r
9855
+ }
9856
+ if {$r eq "unspecified"} {
9857
+ return $default
9858
+ }
9859
+ return $r
9860
}
9861
9862
proc cache_gitattr {attr pathlist} {
9839
- global path_attr_cache
9840
- set newlist {}
9841
- foreach path $pathlist {
9842
- if {[info exists path_attr_cache($attr,$path)]} continue
9843
- lappend newlist $path
9844
- }
9845
- while {$newlist ne {}} {
9846
- set head [lrange $newlist 0 29]
9847
- set newlist [lrange $newlist 30 end]
9848
- if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
9849
- foreach row [split $rlist "\n"] {
9850
- set cols [split $row :]
9851
- set path [lindex $cols 0]
9852
- set value [join [lrange $cols 2 end] :]
9853
- if {[string index $path 0] eq "\""} {
9854
- set path [encoding convertfrom [lindex $path 0]]
9855
- }
9856
- regsub {^ } $value {} value
9857
- set path_attr_cache($attr,$path) $value
9858
- }
9863
+ global path_attr_cache
9864
+ set newlist {}
9865
+ foreach path $pathlist {
9866
+ if {![info exists path_attr_cache($attr,$path)]} {
9867
+ lappend newlist $path
9868
+ }
9869
+ }
9870
+ set lim 1000
9871
+ if {[tk windowingsystem] == "win32"} {
9872
+ # windows has a 32k limit on the arguments to a command...
9873
+ set lim 30
9874
+ }
9875
+ while {$newlist ne {}} {
9876
+ set head [lrange $newlist 0 [expr {$lim - 1}]]
9877
+ set newlist [lrange $newlist $lim end]
9878
+ if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
9879
+ foreach row [split $rlist "\n"] {
9880
+ if {[regexp "(.*): encoding: (.*)" $row m path value]} {
9881
+ if {[string index $path 0] eq "\""} {
9882
+ set path [encoding convertfrom [lindex $path 0]]
9883
+ }
9884
+ set path_attr_cache($attr,$path) $value
9885
}
9860
- update
9886
+ }
9887
}
9888
+ }
9889
}
9890
9891
proc get_path_encoding {path} {
9865
- global gui_encoding
9866
- set tcl_enc [tcl_encoding $gui_encoding]
9867
- if {$tcl_enc eq {}} {
9868
- set tcl_enc [encoding system]
9869
- }
9870
- if {$path ne {}} {
9871
- set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
9872
- if {$enc2 ne {}} {
9873
- set tcl_enc $enc2
9874
- }
9892
+ global gui_encoding perfile_attrs
9893
+ set tcl_enc $gui_encoding
9894
+ if {$path ne {} && $perfile_attrs} {
9895
+ set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
9896
+ if {$enc2 ne {}} {
9897
+ set tcl_enc $enc2
9898
}
9876
- return $tcl_enc
9899
+ }
9900
+ return $tcl_enc
9901
}
9902
9903
# First check that Tcl/Tk is recent enough
@@ -9900,7 +9924,15 @@ if {$tclencoding == {}} {
9924
9925
set gui_encoding [encoding system]
9926
catch {
9903
- set gui_encoding [exec git config --get gui.encoding]
9927
+ set enc [exec git config --get gui.encoding]
9928
+ if {$enc ne {}} {
9929
+ set tclenc [tcl_encoding $enc]
9930
+ if {$tclenc ne {}} {
9931
+ set gui_encoding $tclenc
9932
+ } else {
9933
+ puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
9934
+ }
9935
+ }
9936
}
9937
9938
set mainfont {Helvetica 9}
@@ -9924,6 +9956,7 @@ set showlocalchanges 1
9956
set limitdiffs 1
9957
set datetimeformat "%Y-%m-%d %H:%M:%S"
9958
set autoselect 1
9959
+set perfile_attrs 0
9960
9961
set extdifftool "meld"
9962