paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-04 01:39:47 +01:00
Code Issues Packages Projects Releases Wiki Activity
a30d79092d
lazarus/components/pochecker/simplepofiles.pp
mattias 5ff4472038 pochecker: unicode file names 
git-svn-id: trunk@46820 -
2014-11-12 19:16:26 +00:00

1312 lines
32 KiB
ObjectPascal
Raw Blame History

{
*****************************************************************************
This file is part of the Lazarus Component Library (LCL)
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
This file is based upon the translations.pas file by Mattias Gaertner
Author: Bart Broersma
Year: 2011
Abstract:
Methods and classes for loading and checking validity of po-files.
Note:
Most references to unneeded methods/functions/procedures are commented out,
if we later need them, we can easily uncomment the relevant parts
* For the moment I left out all character encoding stuff: all the relevant
strings I need to investigate can be investigated without knowing the encoding
If a program needs to know the encoding, it can read the CharSet property of TSimplePoFile
* Change the implementation of ReadPoText to use Strings instead of PChars, this resulted in
a speed-up with a factor 20
(ifdef-ed the old method)
* Added LineNr to TPoFileItem
}
{ $define DebugSimplePoFiles}
unit SimplePoFiles;
{$mode objfpc}{$H+}{$INLINE ON}
{ $include include/lcl_defines.inc}
interface
{$IFDEF USE_NEW_TRANSLATIONS}
uses
Classes,sysutils,Translations;
type
TSimplePOFile = class (TPOFile)
end;
implementation
{$ELSE}
uses
Classes, SysUtils, LCLProc, FileUtil, StringHashList, LazUTF8Classes
{, LConvEncoding}
//{$IFDEF UNIX}{$IFNDEF DisableCWString}, cwstring{$ENDIF}{$ENDIF}
;
{
type
TStringsType = (stLrt, stRst);
TTranslateUnitResult = (turOK, turNoLang, turNoFBLang, turEmptyParam);
}
type
{ TPOFileItem }
TPOFileItem = class
public
LineNr: Integer;
Tag: Integer;
Comments: string;
Identifier: string;
Original: string;
Translation: string;
Flags: string;
PreviousID: string;
Context: string;
constructor Create(const TheIdentifier, TheOriginal, TheTranslated: string);
procedure ModifyFlag(const AFlag: string; Check: boolean);
end;
{ TSimplePOFile }
TSimplePOFile = class
protected
FItems: TFPList;// list of TPOFileItem
FIdentifierToItem: TStringHashList;
//FIdentVarToItem: TStringHashList;
FOriginalToItem: TStringHashList;
FCharSet: String;
FHeader: TPOFileItem;
FAllEntries: boolean;
FTag: Integer;
//FModified: boolean;
FHelperList: TStringList;
FModuleList: TStringList;
//procedure RemoveTaggedItems(aTag: Integer);
//procedure RemoveUntaggedModules;
function GetCount: Integer;
procedure SetCharSet(const AValue: String);
procedure ReadPOText(AStream: TStream);
function GetPoItem(Index: Integer): TPoFileItem;
protected
property Items: TFPList read FItems;
public
property OriginalList: TStringHashList read FOriginalToItem;
public
constructor Create(const AFilename: String; const Full: Boolean = True);
constructor Create(AStream: TStream; const Full: Boolean = True);
destructor Destroy; override;
procedure Add(const Identifier, OriginalValue, TranslatedValue, Comments,
Context, Flags, PreviousID: string; LineNr: Integer);
//function Translate(const Identifier, OriginalValue: String): String;
procedure Report;
procedure Report(StartIndex, StopIndex: Integer; const DisplayHeader: Boolean);
procedure Report(Log: TStrings; StartIndex, StopIndex: Integer; const DisplayHeader: Boolean);
procedure CreateHeader;
//procedure UpdateStrings(InputLines:TStrings; SType: TStringsType);
//procedure SaveToFile(const AFilename: string);
//procedure UpdateItem(const Identifier: string; Original: string);
//procedure UpdateTranslation(BasePOFile: TSimplePOFile);
//procedure ClearModuleList;
//procedure AddToModuleList(Identifier: string);
//procedure UntagAll;
function FindPoItem(const Identifier: String): TPoFileItem;
function OriginalToItem(Data: String): TPoFileItem;
property CharSet: String read FCharSet;
property Tag: integer read FTag write FTag;
//property Modified: boolean read FModified;
property PoItems[Index: Integer]: TPoFileItem read GetPoItem;
property Count: Integer read GetCount;
end;
EPOFileError = class(Exception)
public
ResFileName: string;
POFileName: string;
end;
var
SystemCharSetIsUTF8: Boolean = true;// the LCL interfaces expect UTF-8 as default
// if you don't use UTF-8, install a proper widestring manager and set this
// to false.
// translate resource strings for one unit
function UTF8ToSystemCharSet(const s: string): string; inline;
//function UpdatePoFile(Files: TStrings; const POFilename: string): boolean;
const
tgHasDup = $01;
implementation
{$ifdef DebugSimplePoFiles}
var
T0, T1: DWord; function GetTickCount: DWord;
var
HH, MM, SS, MS: Word;
begin
DecodeTime(Now, HH, MM, SS, MS);
Result := DWord(MS) + (DWord(SS) * 1000) + (DWord(MM) * 1000 * 60) + (DWord(HH) * 1000 * 60 * 24);
end;
{$endif}
function UTF8ToSystemCharSet(const s: string): string; inline;
begin
{$IFDEF NoUTF8Translations}
if SystemCharSetIsUTF8 then
exit(s);
Result:=s;
{$ELSE}
Result:=UTF8ToSys(s);
{$ENDIF}
end;
function StrToPoStr(const s:string):string;
var
SrcPos, DestPos: Integer;
NewLength: Integer;
begin
NewLength:=length(s);
for SrcPos:=1 to length(s) do
if s[SrcPos] in ['"','\'] then inc(NewLength);
if NewLength=length(s) then begin
Result:=s;
end else begin
SetLength(Result,NewLength);
DestPos:=1;
for SrcPos:=1 to length(s) do begin
case s[SrcPos] of
'"','\':
begin
Result[DestPos]:='\';
inc(DestPos);
Result[DestPos]:=s[SrcPos];
inc(DestPos);
end;
else
Result[DestPos]:=s[SrcPos];
inc(DestPos);
end;
end;
end;
end;
{
function UpdatePOFile(Files: TStrings; const POFilename: string): boolean;
var
InputLines: TStringList;
Filename: string;
BasePoFile, POFile: TSimplePOFile;
i: Integer;
E: EPOFileError;
procedure UpdatePoFilesTranslation;
var
j: Integer;
Lines: TStringList;
begin
// Update translated PO files
Lines := FindAllTranslatedPoFiles(POFilename);
try
for j:=0 to Lines.Count-1 do begin
POFile := TSimplePOFile.Create(Lines[j], true);
try
POFile.Tag:=1;
POFile.UpdateTranslation(BasePOFile);
try
POFile.SaveToFile(Lines[j]);
except
on Ex: Exception do begin
E := EPOFileError.Create(Ex.Message);
E.ResFileName:=Lines[j];
E.POFileName:=POFileName;
raise E;
end;
end;
finally
POFile.Free;
end;
end;
finally
Lines.Free;
end;
end;
begin
Result := false;
if (Files=nil) or (Files.Count=0) then begin
if FileExistsUTF8(POFilename) then begin
// just update translated po files
BasePOFile := TSimplePOFile.Create(POFilename, true);
try
UpdatePoFilesTranslation;
finally
BasePOFile.Free;
end;
end;
exit;
end;
InputLines := TStringListUTF8.Create;
try
// Read base po items
if FileExistsUTF8(POFilename) then
BasePOFile := TSimplePOFile.Create(POFilename, true)
else
BasePOFile := TSimplePOFile.Create;
BasePOFile.Tag:=1;
// Update po file with lrt or/and rst files
for i:=0 to Files.Count-1 do begin
Filename:=Files[i];
if (CompareFileExt(Filename,'.lrt')=0)
or (CompareFileExt(Filename,'.rst')=0) then
try
//DebugLn('');
//DebugLn(['AddFiles2Po Filename="',Filename,'"']);
InputLines.Clear;
InputLines.LoadFromFile(FileName);
if CompareFileExt(Filename,'.lrt')=0 then
BasePOFile.UpdateStrings(InputLines, stLrt)
else
BasePOFile.UpdateStrings(InputLines, stRst);
except
on Ex: Exception do begin
E := EPOFileError.Create(Ex.Message);
E.ResFileName:=FileName;
E.POFileName:=POFileName;
raise E;
end;
end;
end;
BasePOFile.SaveToFile(POFilename);
Result := BasePOFile.Modified;
UpdatePOFilesTranslation;
finally
InputLines.Free;
BasePOFile.Free;
end;
end;
}
{
function Translate (Name,Value : AnsiString; Hash : Longint; arg:pointer) : AnsiString;
var
po: TSimplePOFile;
begin
po:=TSimplePOFile(arg);
// get UTF8 string
result := po.Translate(Name,Value);
// convert UTF8 to current local
if result<>'' then
result:=UTF8ToSystemCharSet(result);
end;
}
{ TSimplePOFile }
{
procedure TSimplePOFile.RemoveUntaggedModules;
var
Module: string;
Item,VItem: TPOFileItem;
i, p: Integer;
begin
if FModuleList=nil then
exit;
// remove all module references that were not tagged
for i:=FItems.Count-1 downto 0 do begin
Item := TPOFileItem(FItems[i]);
p := pos('.',Item.Identifier);
if P=0 then
continue; // module not found (?)
Module :=LeftStr(Item.Identifier, p-1);
if (FModuleList.IndexOf(Module)<0) then
continue; // module was not modified this time
if Item.Tag=FTag then
continue; // PO item was updated
// this item is not more in updated modules, delete it
FIdentifierToItem.Remove(Item.Identifier);
// delete it also from VarToItem
Module := RightStr(Item.Identifier, Length(Item.Identifier)-P);
VItem := TPoFileItem(FIdentVarToItem.Data[Module]);
if (VItem=Item) then
FIdentVarToItem.Remove(Module);
FOriginalToItem.Remove(Item.Original); // isn't this tricky?
FItems.Delete(i);
Item.Free;
end;
end;
}
function TSimplePOFile.GetCount: Integer;
begin
Result := FItems.Count;
end;
procedure TSimplePOFile.SetCharSet(const AValue: String);
begin
if (CompareText(FCharSet, AValue) = 0) then Exit;
if (AValue = '') then FCharSet := 'UTF-8'
else FCharSet := AValue;
end;
constructor TSimplePOFile.Create(const AFilename: String; const Full: Boolean = True);
var
f: TStream;
begin
f := TFileStreamUTF8.Create(AFilename, fmOpenRead or fmShareDenyNone);
try
Create(f, Full);
if FHeader=nil then CreateHeader;
finally
f.Free;
end;
end;
constructor TSimplePOFile.Create(AStream: TStream; const Full: Boolean = True);
var
Size: Integer;
begin
inherited Create;
FAllEntries:=true;
FItems:=TFPList.Create;
FIdentifierToItem:=TStringHashList.Create(false);
//FIdentVarToItem:=TStringHashList.Create(false);
FOriginalToItem:=TStringHashList.Create(true);
FAllEntries := Full;
Size:=AStream.Size-AStream.Position;
if Size<=0 then exit;
ReadPoText(AStream);
end;
destructor TSimplePOFile.Destroy;
var
i: Integer;
begin
if FModuleList<>nil then
FModuleList.Free;
if FHelperList<>nil then
FHelperList.Free;
if FHeader<>nil then
FHeader.Free;
for i:=0 to FItems.Count-1 do
TObject(FItems[i]).Free;
FItems.Free;
//FIdentVarToItem.Free;
FIdentifierToItem.Free;
FOriginalToItem.Free;
inherited Destroy;
end;
function SliceToStr(SourceStart: PChar; SourceLen: PtrInt) : string;
//converts PChar (can be in the middle of some larger string) to a string
var
Dest: PChar;
begin
SetLength(Result, SourceLen);
Dest := PChar(Result);
System.Move(SourceStart^, Dest^, SourceLen);
end;
procedure TSimplePOFile.ReadPOText(AStream: TStream);
{ Read a .po file. Structure:
Example
#: lazarusidestrconsts:lisdonotshowsplashscreen
msgid "Do not show splash screen"
msgstr ""
}
const
sCommentIdentifier = '#: ';
lCommentIdentifier = 3;
sCharSetIdentifier = '"Content-Type: text/plain; charset=';
lCharSetIdentifier = 35;
sMsgID = 'msgid "';
//lMsgId = 7;
sMsgStr = 'msgstr "';
//lMsgStr = 8;
sMsgCtxt = 'msgctxt "';
lMsgCtxt = 9;
sFlags = '#, ';
lFlags = 3;
sPrevMsgID = '#| msgid "';
//lPrevMsgId = 11;
sPrevStr = '#| "';
lPrevStr = 4;
const
ciNone = 0;
ciMsgID = 1;
ciMsgStr = 2;
ciPrevMsgID = 3;
var
SL: TStringList;
//l: Integer;
Cnt: Integer;
LineLen: Integer;
LineNr: Integer;
//LineStart: PChar;
//LineEnd: PChar;
Identifier: String;
MsgID,MsgStr,PrevMsgID: String;
Line: String;
Comments: String;
Context: string;
Flags: string;
//TextEnd: PChar;
i, CollectedIndex: Integer;
//OldLineStartPos: PtrUInt;
//NewSrc: String;
//s: String;
CurLine: String;
function HasPrefix(const Prefix, aStr: string): boolean;
var
k: Integer;
begin
Result:=false;
if length(aStr)<length(Prefix) then exit;
for k:=1 to length(Prefix) do
if Prefix[k]<>aStr[k] then exit;
Result:=true;
end;
procedure ResetVars;
begin
MsgId := '';
MsgStr := '';
Line := '';
Identifier := '';
Comments := '';
Context := '';
Flags := '';
PrevMsgID := '';
CollectedIndex := ciNone;
LineNr := 0;
end;
procedure StoreCollectedLine;
begin
case CollectedIndex of
ciMsgID: MsgID := Line;
ciMsgStr: MsgStr := Line;
ciPrevMsgID: PrevMsgID := Line;
end;
CollectedIndex := ciNone;
end;
procedure AddEntry(const LineNr: Integer);
//var
//Item: TPOFileItem;
begin
StoreCollectedLine;
if Identifier<>'' then
begin
// check for unresolved duplicates in po file
{
Item := TPOFileItem(FOriginalToItem.Data[MsgID]);
if (Item<>nil) then begin
// fix old duplicate context
if Item.Context='' then
Item.Context:=Item.Identifier;
// set context of new duplicate
if Context='' then
Context := Identifier;
// if old duplicate was translated and
// new one is not, provide a initial translation
if MsgStr='' then
MsgStr := Item.Translation;
end;
}
Add(Identifier,MsgID,MsgStr,Comments,Context,Flags,PrevMsgID, LineNr);
ResetVars;
end else
if (Line<>'') and (FHeader=nil) then
begin
FHeader := TPOFileItem.Create('',MsgID,Line);
FHeader.Comments:=Comments;
ResetVars;
end
end;
function TestPrefixStr(AIndex: Integer): boolean;
var
s: string;
l: Integer;
begin
case aIndex of
ciMsgID: s:=sMsgId;
ciMsgStr: s:=sMsgStr;
ciPrevMsgId: s:=sPrevMsgId;
end;
L := Length(s);
result := HasPrefix(S, CurLine);
if Result then
begin
StoreCollectedLine;
CollectedIndex := AIndex;
Line := Copy(CurLine,L+1,LineLen-L-1);
end;
end;
begin
{$ifdef DebugSimplePoFiles}
T0 := GetTickCount;
{$endif}
SL := TStringList.Create;
SL.LoadFromStream(AStream);
try
//if SL.Count > 0 then AdjustLinebreaks(SL.Text);
Identifier:='';
Comments:='';
Line:='';
Flags:='';
CollectedIndex := ciNone;
LineNr := 0;
for Cnt := 0 to SL.Count - 1 do
begin
CurLine := Sl.Strings[Cnt];
LineLen := Length(CurLine);
if (LineLen > 0) then
begin
if HasPrefix (sCommentIdentifier,CurLine) then
begin
//Add the Entry collected before this line (not the current line)
AddEntry(LineNr);
LineNr := Cnt + 1;
Identifier:=copy(CurLine,lCommentIdentifier+1,LineLen-lCommentIdentifier);
// the RTL creates identifier paths with point instead of colons
// fix it:
for i:=1 to length(Identifier) do
if Identifier[i]=':' then
Identifier[i]:='.';
end
else if TestPrefixStr(ciMsgId) then
begin
end
else if TestPrefixStr(ciMsgStr) then
begin
end
else if TestPrefixStr(ciPrevMsgId) then
begin
end else if HasPrefix(sMsgCtxt, CurLine) then
begin
Context:= Copy(CurLine,lMsgCtxt+1,LineLen - lMsgCtxt - 1);
end
else if HasPrefix(SFlags, CurLine) then
begin
Flags := Copy(CurLine, lFlags + 1, LineLen - lFlags);
end
else if (CurLine[1] = '"') then
begin
if (MsgID='') and HasPrefix(sCharSetIdentifier,CurLine) then
begin
SetCharSet(copy(CurLine,lCharSetIdentifier+1,LineLen-lCharSetIdentifier-3));
{if SysUtils.CompareText(FCharSet,'UTF-8')<>0 then begin
// convert encoding to UTF-8
OldLineStartPos:=PtrUInt(LineStart-PChar(s))+1;
NewSrc:=ConvertEncoding(copy(s,OldLineStartPos,length(s)),
FCharSet,EncodingUTF8);
// replace text and update all pointers
s:=copy(s,1,OldLineStartPos-1)+NewSrc;
l:=length(s);
p:=PChar(s);
TextEnd:=p+l;
LineStart:=p+(OldLineStartPos-1);
LineEnd:=LineStart;
while (not (LineEnd^ in [#0,#10,#13])) do inc(LineEnd);
LineLen:=LineEnd-LineStart;
end;
}
end;
Line := Line + Copy(CurLine,2,LineLen-2);
end
else if HasPrefix(sPrevStr,CurLine) then
begin
Line := Line + Copy(CurLine,lPrevStr + 1,LineLen - lPrevStr - 1);
end
else if CurLine[1] = '#' then
begin
if Comments<>'' then Comments := Comments + LineEnding;
Comments := Comments + CurLine;
end
else
begin
AddEntry(LineNr);
end;
end;//LineLen > 0
end;
//debugln('Last entry:');
//debugln('Identifier = ',Identifier);
//debugln('LineNr = ',DbgS(LineNr));
//debugln('Cnt = ',DbgS(Cnt));
AddEntry(LineNr);
finally
SL.Free;
end;
{$ifdef DebugSimplePoFiles}
T1 := gettickcount;
debugln('T1 = ',dbgs(t1-t0));
debugln('Count = ',DbgS(Count));
{$endif}
end;
procedure TSimplePOFile.Add(const Identifier, OriginalValue, TranslatedValue,
Comments, Context, Flags, PreviousID: string; LineNr: Integer);
var
Item, OItem: TPOFileItem;
OIndex: Integer;
//p: Integer;
begin
if (not FAllEntries) and (TranslatedValue='') then exit;
Item:=TPOFileItem.Create(Identifier,OriginalValue,TranslatedValue);
Item.Comments:=Comments;
Item.Context:=Context;
Item.Flags:=Flags;
Item.PreviousID:=PreviousID;
Item.Tag:=0;
Item.LineNr := LineNr;
FItems.Add(Item);
//debugln('TPOFile.Add %8x Tag=%d Id="%s" Org="%s" Trn="%s"',
// [ptrint(Item),FTag,Identifier,dbgstr(OriginalValue),dbgstr(TranslatedValue)]);
FIdentifierToItem.Add(Identifier,Item);
{
P := Pos('.', Identifier);
if P>0 then
FIdentVarToItem.Add(copy(Identifier, P+1, Length(IDentifier)), Item);
}
//if FIdentifierToItem.Data[UpperCase(Identifier)]=nil then raise Exception.Create('');
OIndex := FOriginalToItem.Find(OriginalValue);
if (OIndex > -1) then
begin
//TPoFileItem(FOriginalToItem.List[OIndex]^.Data).Tag := TPoFileItem(FOriginalToItem.List[OIndex]^.Data).Tag or tgHasDup;
OItem := TPoFileItem(FOriginalToItem.List[OIndex]^.Data);
OItem.Tag := OItem.Tag or tgHasDup;
Item.Tag := Item.Tag or tgHasDup;
end;
FOriginalToItem.Add(OriginalValue,Item);
//if FOriginalToItem.Data[OriginalValue]=nil then raise Exception.Create('');
end;
{
function TSimplePOFile.Translate(const Identifier, OriginalValue: String): String;
var
Item: TPOFileItem;
begin
Item:=TPOFileItem(FIdentifierToItem.Data[Identifier]);
if Item=nil then
Item:=TPOFileItem(FOriginalToItem.Data[OriginalValue]);
if Item<>nil then begin
Result:=Item.Translation;
if Result='' then RaiseGDBException('TPOFile.Translate Inconsistency');
end else
Result:=OriginalValue;
end;
}
procedure TSimplePOFile.Report;
begin
Report(0, Count - 1, True);
end;
procedure TSimplePOFile.Report(StartIndex, StopIndex: Integer;
const DisplayHeader: Boolean);
var
Item: TPOFileItem;
i: Integer;
begin
if DisplayHeader then
begin
DebugLn('Header:');
DebugLn('---------------------------------------------');
if FHeader=nil then
DebugLn('No header found in po file')
else begin
DebugLn('Comments=',FHeader.Comments);
DebugLn('Identifier=',FHeader.Identifier);
DebugLn('msgid=',FHeader.Original);
DebugLn('msgstr=', FHeader.Translation);
end;
DebugLn;
end;
if (StartIndex > StopIndex) then
begin
i := StopIndex;
StopIndex := StartIndex;
StartIndex := i;
end;
if (StopIndex > Count - 1) then StopIndex := Count - 1;
if (StartIndex < 0) then StartIndex := 0;
DebugLn('Entries [',DbgS(StartIndex),'..',Dbgs(StopIndex),']:');
DebugLn('---------------------------------------------');
for i := StartIndex to StopIndex do begin
DebugLn('#',dbgs(i),': ');
Item := TPOFileItem(FItems[i]);
DebugLn('Identifier=',Item.Identifier);
DebugLn('msgid=',Item.Original);
DebugLn('msgstr=', Item.Translation);
DebugLn('Comments=',Item.Comments);
DebugLn;
end;
end;
procedure TSimplePOFile.Report(Log: TStrings; StartIndex, StopIndex: Integer;
const DisplayHeader: Boolean);
var
Item: TPOFileItem;
i: Integer;
begin
if DisplayHeader then
begin
Log.Add('Header:');
Log.Add('---------------------------------------------');
if FHeader=nil then
Log.Add('No header found in po file')
else begin
Log.Add('Comments='+FHeader.Comments);
Log.Add('Identifier='+FHeader.Identifier);
Log.Add('msgid='+FHeader.Original);
Log.Add('msgstr='+ FHeader.Translation);
end;
Log.Add('');
end;
if (StartIndex > StopIndex) then
begin
i := StopIndex;
StopIndex := StartIndex;
StartIndex := i;
end;
if (StopIndex > Count - 1) then StopIndex := Count - 1;
if (StartIndex < 0) then StartIndex := 0;
Log.Add('Entries ['+DbgS(StartIndex)+'..'+Dbgs(StopIndex)+']:');
Log.Add('---------------------------------------------');
for i := StartIndex to StopIndex do begin
Log.Add('#'+dbgs(i)+': ');
Item := TPOFileItem(FItems[i]);
Log.Add('Identifier='+Item.Identifier);
Log.Add('msgid='+Item.Original);
Log.Add('msgstr='+ Item.Translation);
Log.Add('Comments='+Item.Comments);
Log.Add('');
end;
end;
procedure TSimplePOFile.CreateHeader;
begin
if FHeader=nil then
FHeader := TPOFileItem.Create('','','');
FHeader.Translation:='Content-Type: text/plain; charset=UTF-8';
FHeader.Comments:='';
end;
{
procedure TSimplePOFile.UpdateStrings(InputLines: TStrings; SType: TStringsType);
var
i,j,n: integer;
p: LongInt;
Identifier, Value,Line: string;
Ch: Char;
MultiLinedValue: boolean;
procedure NextLine;
begin
if i<InputLines.Count then
inc(i);
if i<InputLines.Count then
Line := InputLines[i]
else
Line := '';
n := Length(Line);
p := 1;
end;
begin
ClearModuleList;
UntagAll;
// for each string in lrt/rst list check if it's already
// in PO if not add it
Value := '';
Identifier := '';
i := 0;
while i < InputLines.Count do begin
Line := InputLines[i];
n := Length(Line);
if n=0 then
// empty line
else
if SType=stLrt then begin
p:=Pos('=',Line);
Value :=copy(Line,p+1,n-p); //if p=0, that's OK, all the string
Identifier:=copy(Line,1,p-1);
UpdateItem(Identifier, Value);
end else begin
// rst file
if Line[1]='#' then begin
// rst file: comment
Value := '';
Identifier := '';
MultilinedValue := false;
end else begin
p:=Pos('=',Line);
if P>0 then begin
Identifier := copy(Line,1,p-1);
inc(p); // points to ' after =
Value := '';
while p<=n do begin
if Line[p]='''' then begin
inc(p);
j:=p;
while (p<=n)and(Line[p]<>'''') do
inc(p);
Value := Value + copy(Line, j, P-j);
inc(p);
continue;
end else
if Line[p] = '#' then begin
// a #decimal
repeat
inc(p);
j:=p;
while (p<=n)and(Line[p] in ['0'..'9']) do
inc(p);
Ch := Chr(StrToInt(copy(Line, j, p-j)));
Value := Value + Ch;
if Ch in [#13,#10] then
MultilinedValue := True;
if (p=n) and (Line[p]='+') then
NextLine;
until (p>n) or (Line[p]<>'#');
end else
if Line[p]='+' then
NextLine
else
inc(p); // this is an unexpected string
end;
if Value<>'' then begin
if MultiLinedValue then begin
// check that we end on lineending, multilined
// resource strings from rst usually do not end
// in lineending, fix here.
if not (Value[Length(Value)] in [#13,#10]) then
Value := Value + LineEnding;
end;
// po requires special characters as #number
p:=1;
while p<=length(Value) do begin
j := UTF8CharacterLength(pchar(@Value[p]));
if (j=1) and (Value[p] in [#0..#9,#11,#12,#14..#31,#127..#255]) then
Value := copy(Value,1,p-1)+'#'+IntToStr(ord(Value[p]))+copy(Value,p+1,length(Value))
else
inc(p,j);
end;
UpdateItem(Identifier, Value);
end;
end; // if p>0 then begin
end;
end;
inc(i);
end;
RemoveUntaggedModules;
end;
}
{
procedure TSimplePOFile.RemoveTaggedItems(aTag: Integer);
var
Item: TPOFileItem;
i: Integer;
begin
// get rid of all entries that have Tag=aTag
for i:=FItems.Count-1 downto 0 do begin
Item := TPOFileItem(FItems[i]);
if Item.Tag<>aTag then
Continue;
FIdentifierToItem.Remove(Item.Identifier);
FOriginalToItem.Remove(Item.Original); // isn't this tricky?
FItems.Delete(i);
Item.Free;
end;
end;
}
function ComparePOItems(Item1, Item2: Pointer): Integer;
begin
result := CompareText(TPOFileItem(Item1).Identifier,
TPOFileItem(Item2).Identifier);
end;
{
procedure TSimplePOFile.SaveToFile(const AFilename: string);
var
OutLst: TStringListUTF8;
j: Integer;
procedure WriteLst(const AProp, AValue: string );
var
i: Integer;
s: string;
begin
if (AValue='') and (AProp='') then
exit;
FHelperList.Text:=AValue;
if FHelperList.Count=1 then begin
if AProp='' then OutLst.Add(FHelperList[0])
else OutLst.Add(AProp+' "'+FHelperList[0]+'"');
end else begin
if AProp<>'' then
OutLst.Add(AProp+' ""');
for i:=0 to FHelperList.Count-1 do begin
s := FHelperList[i];
if AProp<>'' then begin
s := '"' + s + '\n"';
if AProp='#| msgid' then
s := '#| ' + s;
end;
OutLst.Add(s)
end;
end;
end;
procedure WriteItem(Item: TPOFileItem);
begin
WriteLst('',Item.Comments);
if Item.Identifier<>'' then
OutLst.Add('#: '+Item.Identifier);
if Trim(Item.Flags)<>'' then
OutLst.Add('#, '+Trim(Item.Flags));
if Item.PreviousID<>'' then
WriteLst('#| msgid', strToPoStr(Item.PreviousID));
if Item.Context<>'' then
WriteLst('msgctxt', Item.Context);
WriteLst('msgid', StrToPoStr(Item.Original));
WriteLst('msgstr', StrToPoStr(Item.Translation));
OutLst.Add('');
end;
begin
if FHeader=nil then
CreateHeader;
if FHelperList=nil then
FHelperList:=TStringList.Create;
OutLst := TStringList.Create;
try
// write header
WriteItem(FHeader);
// Sort list of items by identifier
FItems.Sort(@ComparePOItems);
for j:=0 to Fitems.Count-1 do
WriteItem(TPOFileItem(FItems[j]));
OutLst.SaveToFile(AFilename);
finally
OutLst.Free;
end;
end;
}
function SkipLineEndings(var P: PChar; var DecCount: Integer): Integer;
procedure Skip;
begin
Dec(DecCount);
Inc(P);
end;
begin
Result := 0;
while (P^ in [#10,#13]) do begin
Inc(Result);
if (P^=#13) then begin
Skip;
if P^=#10 then
Skip;
end else
Skip;
end;
end;
function CompareMultilinedStrings(const S1,S2: string): Integer;
var
C1,C2,L1,L2: Integer;
P1,P2: PChar;
begin
L1 := Length(S1);
L2 := Length(S2);
P1 := pchar(S1);
P2 := pchar(S2);
Result := ord(P1^) - ord(P2^);
while (Result=0) and (P1^<>#0) do begin
Inc(P1); Inc(P2);
Dec(L1); Dec(L2);
if P1^<>P2^ then begin
C1 := SkipLineEndings(P1, L1);
C2 := SkipLineEndings(P2, L2);
if (C1<>C2) then
// different amount of lineendings
result := C1-C2
else
if (C1=0) then
// there are no lineendings at all, will end loop
result := Ord(P1^)-Ord(P2^);
end;
end;
// if strings are the same, check that all chars have been consumed
// just in case there are unexpected chars in between, in this case
// L1=L2=0;
if Result=0 then
Result := L1-L2;
end;
{
procedure TSimplePOFile.UpdateItem(const Identifier: string; Original: string);
var
Item: TPOFileItem;
AContext,AComment,ATranslation,AFlags,APrevStr: string;
begin
if FHelperList=nil then
FHelperList := TStringList.Create;
// try to find PO entry by identifier
Item:=TPOFileItem(FIdentifierToItem.Data[Identifier]);
if Item<>nil then begin
// found, update item value
AddToModuleList(IDentifier);
if CompareMultilinedStrings(Item.Original, Original)<>0 then begin
FModified := True;
if Item.Translation<>'' then begin
Item.ModifyFlag('fuzzy', true);
Item.PreviousID:=Item.Original;
end;
end;
Item.Original:=Original;
Item.Tag:=FTag;
exit;
end;
// try to find po entry based only on it's value
AContext := '';
AComment := '';
ATranslation := '';
AFlags := '';
APrevStr := '';
Item := TPOFileItem(FOriginalToItem.Data[Original]);
if Item<>nil then begin
// old item don't have context, add one
if Item.Context='' then
Item.Context := Item.Identifier;
// if old item it's already translated use translation
if Item.Translation<>'' then
ATranslation := Item.Translation;
AFlags := Item.Flags;
// if old item was fuzzy, new should be fuzzy too.
if (ATranslation<>'') and (pos('fuzzy', AFlags)<>0) then
APrevStr := Item.PreviousID;
// update identifier list
AContext := Identifier;
end;
// this appear to be a new item
FModified := true;
Add(Identifier, Original, ATranslation, AComment, AContext, AFlags, APrevStr);
end;
}
{
procedure TSimplePOFile.UpdateTranslation(BasePOFile: TSimplePOFile);
var
Item: TPOFileItem;
i: Integer;
begin
UntagAll;
ClearModuleList;
for i:=0 to BasePOFile.Items.Count-1 do begin
Item := TPOFileItem(BasePOFile.Items[i]);
UpdateItem(Item.Identifier, Item.Original);
end;
RemoveTaggedItems(0); // get rid of any item not existing in BasePOFile
end;
}
{
procedure TSimplePOFile.ClearModuleList;
begin
if FModuleList<>nil then
FModuleList.Clear;
end;
}
{
procedure TSimplePOFile.AddToModuleList(Identifier: string);
var
p: Integer;
begin
if FModuleList=nil then begin
FModuleList := TStringList.Create;
FModuleList.Duplicates:=dupIgnore;
end;
p := pos('.', Identifier);
if p>0 then
FModuleList.Add(LeftStr(Identifier, P-1));
end;
}
{
procedure TSimplePOFile.UntagAll;
var
Item: TPOFileItem;
i: Integer;
begin
for i:=0 to Items.Count-1 do begin
Item := TPOFileItem(Items[i]);
Item.Tag:=0;
end;
end;
}
function TSimplePOFile.FindPoItem(const Identifier: String): TPoFileItem;
begin
Result := TPOFileItem(FIdentifierToItem.Data[Identifier]);
end;
function TSimplePOFile.GetPoItem(Index: Integer): TPoFileItem;
begin
Result := TPoFileItem(FItems.Items[Index]);
end;
function TSimplePOFile.OriginalToItem(Data: String): TPoFileItem;
begin
Result := TPOFileItem(FOriginalToItem.Data[Data]);
end;
{ TPOFileItem }
constructor TPOFileItem.Create(const TheIdentifier, TheOriginal,
TheTranslated: string);
begin
Identifier:=TheIdentifier;
Original:=TheOriginal;
Translation:=TheTranslated;
end;
procedure TPOFileItem.ModifyFlag(const AFlag: string; Check: boolean);
var
i: Integer;
F: TStringList;
begin
F := TStringList.Create;
try
F.CommaText := Flags;
i := F.IndexOf(AFlag);
if (i<0) and Check then
F.Add(AFlag)
else
if (i>=0) and (not Check) then
F.Delete(i);
Flags := F.CommaText;
finally
F.Free;
end;
end;
{$ENDIF}
end.
Reference in New Issue View Git Blame Copy Permalink