make_unicode: Make support of registry values more generic.

Signed-off-by: Alexandre Julliard <julliard@winehq.org>
This commit is contained in:
Alexandre Julliard 2022-06-24 10:54:01 +02:00
parent c59d25d3ae
commit 630f605c26
2 changed files with 62 additions and 29 deletions

View file

@ -356,9 +356,6 @@ HKLM
val '0000540a' = s '1' val '0000540a' = s '1'
val '0000580a' = s '1' val '0000580a' = s '1'
val '00005c0a' = s '1' val '00005c0a' = s '1'
}
Locale
{
'Alternate Sorts' 'Alternate Sorts'
{ {
val '0000040a' = s '1' val '0000040a' = s '1'

View file

@ -46,6 +46,8 @@ my $DEF_CHAR = ord '?';
# Last valid Unicode character # Last valid Unicode character
my $MAX_CHAR = 0x10ffff; my $MAX_CHAR = 0x10ffff;
my $nlskey = "-SYSTEM\\-CurrentControlSet\\-Control\\-Nls";
my @allfiles = my @allfiles =
( (
"CodpageFiles/037.txt", "CodpageFiles/037.txt",
@ -2268,19 +2270,44 @@ sub load_data()
################################################################ ################################################################
# add a new registry key # add a new registry key
sub add_registry_key($$) sub add_registry_key($$$)
{ {
my ($key, $defval) = @_; my ($base, $key, $defval) = @_;
$registry_keys{$key} = [ $defval ] unless defined $registry_keys{$key}; $registry_keys{"$base\\$key"} = [ $defval ] unless defined $registry_keys{"$base\\$key"};
} }
################################################################ ################################################################
# add a new registry value # add a new registry value with explicit type
sub add_registry_value($$$) sub add_registry_value($$$$)
{ {
my ($key, $name, $value) = @_; my ($base, $key, $name, $value) = @_;
add_registry_key( $key, undef ); add_registry_key( $base, $key, undef );
push @{$registry_keys{$key}}, "'$name' = s '$value'"; push @{$registry_keys{"$base\\$key"}}, "'$name' = $value";
}
################################################################
# add a new registry string value
sub add_registry_string_value($$$$)
{
my ($base, $key, $name, $value) = @_;
$value =~ s/\'/\'\'/g;
add_registry_value( $base, $key, $name, "s '$value'" );
}
################################################################
# add a new registry dword value
sub add_registry_dword_value($$$$)
{
my ($base, $key, $name, $value) = @_;
add_registry_value( $base, $key, $name, "d $value" );
}
################################################################
# add a new registry binary value
sub add_registry_binary_value($$$$)
{
my ($base, $key, $name, $value) = @_;
add_registry_value( $base, $key, $name, "b " . join "", map { sprintf "%02x", $_; } unpack( "C*", $value ));
} }
################################################################ ################################################################
@ -3603,7 +3630,7 @@ sub dump_norm_table($)
close OUTPUT; close OUTPUT;
save_file($filename); save_file($filename);
add_registry_value( "Normalization", sprintf( "%x", $forms{$type} ), "norm$type.nls" ); add_registry_string_value( $nlskey, "Normalization", sprintf( "%x", $forms{$type} ), "norm$type.nls" );
} }
@ -3623,7 +3650,7 @@ sub output_codepage_file($)
close OUTPUT; close OUTPUT;
save_file($output); save_file($output);
add_registry_value( "Codepage", sprintf( "%d", $codepage ), sprintf( "c_%03d.nls", $codepage )); add_registry_string_value( $nlskey, "Codepage", sprintf( "%d", $codepage ), sprintf( "c_%03d.nls", $codepage ));
} }
################################################################ ################################################################
@ -4098,14 +4125,14 @@ sub dump_sortkey_table($$)
# Locales # Locales
add_registry_key( "Sorting\\Ids", "{$default_guid}" ); add_registry_key( $nlskey, "Sorting\\Ids", "{$default_guid}" );
foreach my $loc (sort keys %locales) foreach my $loc (sort keys %locales)
{ {
# skip specific locales that match more general ones # skip specific locales that match more general ones
my @parts = split /[-_]/, $loc; my @parts = split /[-_]/, $loc;
next if @parts > 1 && defined($locales{$parts[0]}) && $locales{$parts[0]} eq $locales{$loc}; next if @parts > 1 && defined($locales{$parts[0]}) && $locales{$parts[0]} eq $locales{$loc};
next if @parts > 2 && defined($locales{"$parts[0]-$parts[1]"}) && $locales{"$parts[0]-$parts[1]"} eq $locales{$loc}; next if @parts > 2 && defined($locales{"$parts[0]-$parts[1]"}) && $locales{"$parts[0]-$parts[1]"} eq $locales{$loc};
add_registry_value( "Sorting\\Ids", $loc, "\{$locales{$loc}\}" ); add_registry_string_value( $nlskey, "Sorting\\Ids", $loc, "\{$locales{$loc}\}" );
} }
# File header # File header
@ -4956,7 +4983,7 @@ sub build_locale_data()
# output language groups # output language groups
my %groups; my %groups;
add_registry_key( "Locale", "00000409" ); add_registry_key( $nlskey, "Locale", "00000409" );
foreach my $loc (@locales) foreach my $loc (@locales)
{ {
next unless defined $loc->{lcid}; next unless defined $loc->{lcid};
@ -4965,11 +4992,11 @@ sub build_locale_data()
my $group = locale_entry( $loc, "group", 1 ); my $group = locale_entry( $loc, "group", 1 );
my $name = sprintf( "%08x", $loc->{lcid} ); my $name = sprintf( "%08x", $loc->{lcid} );
my $val = sprintf( "%x", $group ); my $val = sprintf( "%x", $group );
add_registry_value( "Locale", $name, $val ) unless ($loc->{lcid} & 0x000f0000); add_registry_string_value( $nlskey, "Locale", $name, $val ) unless ($loc->{lcid} & 0x000f0000);
add_registry_value( "Locale\\Alternate Sorts", $name, $val ) if $loc->{name} =~ /_/; add_registry_string_value( $nlskey, "Locale\\Alternate Sorts", $name, $val ) if $loc->{name} =~ /_/;
$groups{$val} = 1; $groups{$val} = 1;
} }
foreach my $group (keys %groups) { add_registry_value( "Language Groups", $group, "1" ); } foreach my $group (keys %groups) { add_registry_string_value( $nlskey, "Language Groups", $group, "1" ); }
# output calendar data # output calendar data
@ -5263,30 +5290,39 @@ sub dump_registry_script($%)
{ {
my ($filename, %keys) = @_; my ($filename, %keys) = @_;
my $indent = 1; my $indent = 1;
my @prev;
printf "Building %s\n", $filename; printf "Building %s\n", $filename;
open OUTPUT, ">$filename.new" or die "Cannot create $filename"; open OUTPUT, ">$filename.new" or die "Cannot create $filename";
print OUTPUT "HKLM\n{\n"; print OUTPUT "HKLM\n{\n";
foreach my $k (split /\\/, "SYSTEM\\CurrentControlSet\\Control\\Nls") foreach my $k (sort { ($a =~ tr/a-z\\/A-Z\001/r) cmp ($b =~ tr/a-z\\/A-Z\001/r) } keys %keys)
{
printf OUTPUT "%*sNoRemove %s\n%*s{\n", 4 * $indent, "", $k, 4 * $indent, "";
$indent++;
}
foreach my $k (sort keys %keys)
{ {
my @subkeys = split /\\/, $k; my @subkeys = split /\\/, $k;
while (@prev && @subkeys && $prev[0] eq $subkeys[0]) { shift @prev; shift @subkeys; }
while (@prev) { printf OUTPUT "%*s}\n", 4 * --$indent, ""; shift @prev; }
my ($def, @vals) = @{$keys{$k}}; my ($def, @vals) = @{$keys{$k}};
for (my $i = 0; $i < @subkeys; $i++) for (my $i = 0; $i < @subkeys; $i++)
{ {
printf OUTPUT "%*s%s%s\n%*s{\n", 4 * $indent, "", my $name = $subkeys[$i];
$subkeys[$i] =~ /\s/ ? "'$subkeys[$i]'" : $subkeys[$i], my $prefix = "";
if ($name =~ /^-/)
{
$name =~ s/^-//;
$prefix = "NoRemove ";
}
if ($name =~ /\s/)
{
$name = "'$name'";
}
printf OUTPUT "%*s%s%s%s\n%*s{\n", 4 * $indent, "", $prefix, $name,
$i == $#subkeys && $def ? " = s '$def'" : "", 4 * $indent, ""; $i == $#subkeys && $def ? " = s '$def'" : "", 4 * $indent, "";
$indent++; $indent++;
} }
foreach my $v (sort @vals) { printf OUTPUT "%*sval $v\n", 4 * $indent, ""; } foreach my $v (sort @vals) { printf OUTPUT "%*sval $v\n", 4 * $indent, ""; }
for (my $i = 0; $i < @subkeys; $i++) { printf OUTPUT "%*s}\n", 4 * --$indent, ""; } @prev = split /\\/, $k;
} }
while ($indent) { printf OUTPUT "%*s}\n", 4 * --$indent, ""; } while (@prev) { printf OUTPUT "%*s}\n", 4 * --$indent, ""; shift @prev; }
printf OUTPUT "}\n";
close OUTPUT; close OUTPUT;
save_file($filename); save_file($filename);
} }