mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-23 20:49:43 +02:00
--- Merging (from foreign repository) r31878 into '.':
U compiler/widestr.pas --- Merging (from foreign repository) r31881 into '.': G compiler/widestr.pas U compiler/cresstr.pas U utils/rstconv.pp # revisions: 31878, 31881 git-svn-id: branches/fixes_3_0@31964 -
This commit is contained in:
parent
49cf7bbadb
commit
a608ba6fc6
@ -234,11 +234,22 @@ uses
|
||||
message1(general_e_errorwritingresourcefile,ResFileName);
|
||||
exit;
|
||||
end;
|
||||
{ write the data in two formats:
|
||||
a) backward compatible: the plain bytes from the source file
|
||||
b) portable: converted to utf-16
|
||||
}
|
||||
writeln(f,'{"version":1,"strings":[');
|
||||
R:=TResourceStringItem(List.First);
|
||||
while assigned(R) do
|
||||
begin
|
||||
write(f, '{"hash":',R.Hash,',"name":"',R.Name,'","value":"');
|
||||
write(f, '{"hash":',R.Hash,',"name":"',R.Name,'","sourcebytes":[');
|
||||
for i:=0 to R.Len-1 do
|
||||
begin
|
||||
write(f,ord(R.Value[i]));
|
||||
if i<>R.Len-1 then
|
||||
write(f,',');
|
||||
end;
|
||||
write(f,'],"value":"');
|
||||
initwidestring(W);
|
||||
ascii2unicode(R.Value,R.Len,current_settings.sourcecodepage,W);
|
||||
for I := 0 to W^.len - 1 do
|
||||
|
@ -199,6 +199,7 @@ unit widestr;
|
||||
Result := getascii(c,getmap(current_settings.sourcecodepage))[1];
|
||||
end;
|
||||
|
||||
|
||||
procedure ascii2unicode(p : pchar;l : SizeInt;cp : tstringencoding;r : pcompilerwidestring;codepagetranslation : boolean = true);
|
||||
var
|
||||
source : pchar;
|
||||
@ -210,15 +211,25 @@ unit widestr;
|
||||
setlengthwidestring(r,l);
|
||||
source:=p;
|
||||
dest:=tcompilerwidecharptr(r^.data);
|
||||
if (current_settings.sourcecodepage <> CP_UTF8) and
|
||||
codepagetranslation then
|
||||
if codepagetranslation then
|
||||
begin
|
||||
for i:=1 to l do
|
||||
begin
|
||||
dest^:=getunicode(source^,m);
|
||||
inc(dest);
|
||||
inc(source);
|
||||
end;
|
||||
if cp<>CP_UTF8 then
|
||||
begin
|
||||
for i:=1 to l do
|
||||
begin
|
||||
dest^:=getunicode(source^,m);
|
||||
inc(dest);
|
||||
inc(source);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
r^.len:=Utf8ToUnicode(punicodechar(r^.data),r^.maxlen,p,l);
|
||||
{ -1, because utf8tounicode includes room for a terminating 0 in
|
||||
its result count }
|
||||
if r^.len>0 then
|
||||
dec(r^.len);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -231,6 +242,7 @@ unit widestr;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure unicode2ascii(r : pcompilerwidestring;p:pchar;cp : tstringencoding);
|
||||
var
|
||||
m : punicodemap;
|
||||
|
@ -18,7 +18,11 @@
|
||||
|
||||
program rstconv;
|
||||
|
||||
uses sysutils, classes, jsonparser, fpjson;
|
||||
uses
|
||||
{$ifdef unix}
|
||||
cwstring,
|
||||
{$endif}
|
||||
sysutils, classes, jsonparser, fpjson, charset, cpall;
|
||||
|
||||
resourcestring
|
||||
help =
|
||||
@ -40,7 +44,10 @@ resourcestring
|
||||
'Resource compiler script only options are:'+LineEnding+
|
||||
' -s Use STRINGTABLE instead of MESSAGETABLE'+LineEnding+
|
||||
' -c identifier Use identifier as ID base (ID+n) (OPTIONAL)'+LineEnding+
|
||||
' -n number Specifies the first ID number (OPTIONAL)'+LineEnding;
|
||||
' -n number Specifies the first ID number (OPTIONAL)'+LineEnding+
|
||||
'.rsj-input format-only options are:'+LineEnding+
|
||||
' -p codepage Convert the string data to the specified code page before'+LineEnding+
|
||||
' writing it to the output file. Possible values:';
|
||||
|
||||
|
||||
InvalidOption = 'Invalid option - ';
|
||||
@ -50,7 +57,9 @@ resourcestring
|
||||
InvalidOutputFormat = 'Invalid output format -';
|
||||
MessageNumberTooBig = 'Message number too big';
|
||||
InvalidRange = 'Invalid range of the first message number';
|
||||
|
||||
MissingOption = 'Missing option after parameter ';
|
||||
UnsupportedOutputCodePage = 'Unsupported output code page specified: ';
|
||||
RstNoOutputCodePage = 'It is not possible to specify an output code page when using a .rst file';
|
||||
|
||||
type
|
||||
|
||||
@ -62,8 +71,9 @@ type
|
||||
var
|
||||
InFilename, OutFilename: String;
|
||||
ConstItems: TCollection;
|
||||
CharSet: String;
|
||||
HeaderCharSet: String;
|
||||
Identifier: String;
|
||||
OutputCodePage: Longint;
|
||||
FirstMessage: Word;
|
||||
MessageTable: Boolean;
|
||||
|
||||
@ -121,12 +131,15 @@ procedure ReadRSJFile;
|
||||
var
|
||||
Stream: TFileStream;
|
||||
Parser: TJSONParser;
|
||||
JsonItems: TJSONArray;
|
||||
JsonItems,
|
||||
RawStringData: TJSONArray;
|
||||
JsonData, JsonItem: TJSONObject;
|
||||
S: String;
|
||||
item: TConstItem;
|
||||
DotPos, I: Integer;
|
||||
DotPos, I, J: Integer;
|
||||
begin
|
||||
if OutputCodePage<>-1 then
|
||||
DefaultSystemCodePage:=OutputCodePage;
|
||||
Stream := TFileStream.Create(InFilename, fmOpenRead or fmShareDenyNone);
|
||||
Parser := TJSONParser.Create(Stream);
|
||||
try
|
||||
@ -141,7 +154,17 @@ begin
|
||||
DotPos := Pos('.', s);
|
||||
item.ModuleName := Copy(s, 1, DotPos - 1);
|
||||
item.ConstName := Copy(s, DotPos + 1, Length(S) - DotPos);
|
||||
item.Value := JsonItem.Get('value');
|
||||
if OutputCodePage=-1 then
|
||||
begin
|
||||
RawStringData:=JsonItem.Get('sourcebytes',TJSONArray(nil));
|
||||
SetLength(item.Value, RawStringData.Count);
|
||||
for J := 1 to Length(item.Value) do
|
||||
item.Value[J]:=char(RawStringData.Integers[J-1]);
|
||||
end
|
||||
else
|
||||
{ automatically converts from UTF-16 to the correct code page due
|
||||
to the change of DefaultSystemCodePage to OutputCodePage above }
|
||||
item.Value := JsonItem.Get('value');
|
||||
end;
|
||||
finally
|
||||
JsonData.Free;
|
||||
@ -164,12 +187,12 @@ begin
|
||||
Assign(f, OutFilename);
|
||||
Rewrite(f);
|
||||
|
||||
if CharSet<>'' then begin
|
||||
if HeaderCharSet<>'' then begin
|
||||
// Write file header with
|
||||
WriteLn(f, 'msgid ""');
|
||||
WriteLn(f, 'msgstr ""');
|
||||
WriteLn(f, '"MIME-Version: 1.0\n"');
|
||||
WriteLn(f, '"Content-Type: text/plain; charset=', CharSet, '\n"');
|
||||
WriteLn(f, '"Content-Type: text/plain; charset=', HeaderCharSet, '\n"');
|
||||
WriteLn(f, '"Content-Transfer-Encoding: 8bit\n"');
|
||||
WriteLn(f);
|
||||
end;
|
||||
@ -345,15 +368,21 @@ begin
|
||||
|
||||
if (ParamStr(1) = '-h') or (ParamStr(1) = '--help') then begin
|
||||
WriteLn(help);
|
||||
for i:=low(word) to high(word) do
|
||||
if mappingavailable(i) then
|
||||
writeln(' ',getmap(i)^.cpname);
|
||||
{ UTF-8 is not supported via the CharSet unit }
|
||||
writeln(' UTF-8');
|
||||
exit;
|
||||
end;
|
||||
|
||||
ConversionProc := @ConvertToGettextPO;
|
||||
OutputFormat:='';
|
||||
CharSet:='';
|
||||
HeaderCharSet:='';
|
||||
Identifier:='';
|
||||
FirstMessage:=0;
|
||||
MessageTable:=True;
|
||||
OutputCodePage:=-1;
|
||||
|
||||
i := 1;
|
||||
while i <= ParamCount do begin
|
||||
@ -391,11 +420,11 @@ begin
|
||||
Inc(i, 2);
|
||||
end else if ParamStr(i) = '-c' then begin
|
||||
if (OutputFormat='') or (OutputFormat='po') then begin
|
||||
if CharSet <> '' then begin
|
||||
if HeaderCharSet <> '' then begin
|
||||
WriteLn(StdErr, OptionAlreadySpecified, '-c');
|
||||
Halt(1);
|
||||
end;
|
||||
CharSet:=ParamStr(i+1);
|
||||
HeaderCharSet:=ParamStr(i+1);
|
||||
end else
|
||||
begin
|
||||
if Identifier <> '' then begin
|
||||
@ -428,13 +457,32 @@ begin
|
||||
end;
|
||||
end;
|
||||
Inc(i, 2);
|
||||
end else begin
|
||||
end else if ParamStr(i) = '-p' then
|
||||
begin
|
||||
if paramcount=i then
|
||||
begin
|
||||
WriteLn(StdErr, MissingOption,'-p');
|
||||
Halt(1)
|
||||
end;
|
||||
if UpperCase(paramstr(i+1))<>'UTF-8' then
|
||||
if not mappingavailable(ParamStr(i+1)) then
|
||||
begin
|
||||
WriteLn(StdErr, UnsupportedOutputCodePage, ParamStr(i+1));
|
||||
Halt(1);
|
||||
end
|
||||
else
|
||||
OutputCodePage:=getmap(ParamStr(i+1))^.cp
|
||||
else
|
||||
OutputCodePage:=CP_UTF8;
|
||||
Inc(i, 2);
|
||||
end
|
||||
else begin
|
||||
WriteLn(StdErr, InvalidOption, ParamStr(i));
|
||||
Halt(1);
|
||||
end;
|
||||
end;
|
||||
|
||||
If ((OutputFormat<>'') and (OutputFormat<>'po')) and (CharSet<>'') then begin
|
||||
If ((OutputFormat<>'') and (OutputFormat<>'po')) and (HeaderCharSet<>'') then begin
|
||||
WriteLn(StdErr, InvalidOption, '');
|
||||
Halt(1);
|
||||
end;
|
||||
@ -459,7 +507,14 @@ begin
|
||||
if ExtractFileExt(InFilename) = '.rsj' then
|
||||
ReadRSJFile
|
||||
else
|
||||
ReadRSTFile;
|
||||
begin
|
||||
if OutputCodePage<>-1 then
|
||||
begin
|
||||
WriteLn(StdErr, RstNoOutputCodePage);
|
||||
Halt(1);
|
||||
end;
|
||||
ReadRSTFile;
|
||||
end;
|
||||
|
||||
ConversionProc;
|
||||
end.
|
||||
|
Loading…
Reference in New Issue
Block a user