{ ***************************************************************************** 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 uses Classes, SysUtils, LCLProc, FileUtil, StringHashList {, 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 if SystemCharSetIsUTF8 then exit(s); {$IFDEF NoUTF8Translations} 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 := TStringList.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(UTF8ToSys(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 := TFileStream.Create(UTF8ToSys(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)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 i0 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: TStringList; 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(UTF8ToSys(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; end.