1 {
2 *****************************************************************************
3 This file is part of LazUtils.
4
5 See the file COPYING.modifiedLGPL.txt, included in this distribution,
6 for details about the license.
7 *****************************************************************************
8
9 Initial authors: Mattias Gaertner, Bart Broersma, Giuliano Colla
10
11 Abstract:
12 Methods and classes for loading/checking/maintaining translations from po files.
13
14 Example 1: Load a specific .po file:
15
16 procedure TForm1.FormCreate(Sender: TObject);
17 var
18 PODirectory: String;
19 begin
20 PODirectory:='/path/to/lazarus/lcl/languages/';
21 TranslateUnitResourceStrings('LCLStrConsts',PODirectory+'lcl.%s.po',
22 'nl','');
23 MessageDlg('Title','Text',mtInformation,[mbOk,mbCancel,mbYes],0);
24 end;
25
26
27 Example 2: Load the current language file using the GetLanguageIDs function
28 of the gettext unit in the project lpr file:
29
30 uses
31 ...
32 Translations, LCLProc;
33
34 procedure TranslateLCL;
35 var
36 PODirectory, Lang, FallbackLang: String;
37 begin
38 PODirectory:='/path/to/lazarus/lcl/languages/';
39 Lang:='';
40 FallbackLang:='';
41 LCLGetLanguageIDs(Lang,FallbackLang); // in unit LCLProc
42 Translations.TranslateUnitResourceStrings('LCLStrConsts',
43 PODirectory+'lclstrconsts.%s.po',Lang,FallbackLang);
44 end;
45
46 begin
47 TranslateLCL;
48 Application.Initialize;
49 Application.CreateForm(TForm1, Form1);
50 Application.Run;
51 end.
52
53 Note for Mac OS X:
54 The supported language IDs should be added into the application
55 bundle property list to CFBundleLocalizations key, see
56 lazarus.app/Contents/Info.plist for example.
57 }
58 unit Translations;
59
60 {$mode objfpc}{$H+}{$INLINE ON}
61
62 interface
63
64 uses
65 Classes, SysUtils,
66 {$IF FPC_FULLVERSION>=30001}jsonscanner,{$ENDIF} jsonparser, fpjson,
67 // LazUtils
68 FileUtil, LazFileUtils, LazUTF8, LazUTF8Classes, LConvEncoding, LazLoggerBase,
69 AvgLvlTree, StringHashList;
70
71 type
72 TStringsType = (
73 stLrj, // Lazarus resource string table in JSON format
74 stRst, // FPC resource string table (before FPC 2.7.1)
75 stRsj // FPC resource string table in JSON format (since FPC 2.7.1)
76 );
77 TTranslateUnitResult = (turOK, turNoLang, turNoFBLang, turEmptyParam);
78
79 TTranslationStatistics = record
80 Translated: Integer;
81 Untranslated: Integer;
82 Fuzzy: Integer;
83 end;
84
85 type
86 { TPOFileItem }
87
88 TPOFileItem = class
89 public
90 Tag: Integer;
91 LineNr: Integer; // required by pochecker
92 Comments: string;
93 IdentifierLow: string; // lowercase
94 Original: string;
95 Translation: string;
96 Flags: string;
97 PreviousID: string;
98 Context: string;
99 Duplicate: boolean;
100 constructor Create(const TheIdentifierLow, TheOriginal, TheTranslated: string);
101 procedure ModifyFlag(const AFlag: string; Check: boolean);
102 end;
103
104 { TPOFile }
105
106 TPOFile = class
107 private
108 FAllowChangeFuzzyFlag: boolean;
109 FStatisticsUpdated: boolean;
110 FStatistics: TTranslationStatistics;
GetStatisticsnull111 function GetStatistics: TTranslationStatistics;
112 protected
113 FItems: TFPList;// list of TPOFileItem
114 FIdentifierLowToItem: TStringToPointerTree; // lowercase identifier to TPOFileItem
115 FOriginalToItem: TStringHashList; // of TPOFileItem
116 FCharSet: String;
117 FHeader: TPOFileItem;
118 FAllEntries: boolean;
119 FTag: Integer;
120 FModified: boolean;
121 FHelperList: TStringList;
122 // New fields
123 FPoName: string;
Removenull124 function Remove(Index: Integer): TPOFileItem;
125 // used by pochecker
GetCountnull126 function GetCount: Integer;
127 procedure SetCharSet(const AValue: String);
GetPoItemnull128 function GetPoItem(Index: Integer): TPoFileItem;
129 procedure ReadPOText(AStream: TStream);
130 public
131 constructor Create(Full:Boolean=True); //when loading from internal resource Full needs to be False
132 constructor Create(const AFilename: String; Full: boolean=false; AllowChangeFuzzyFlag: boolean=true);
133 constructor Create(AStream: TStream; Full: boolean=false; AllowChangeFuzzyFlag: boolean=true);
134 destructor Destroy; override;
135 procedure ReadPOText(const Txt: string);
Translatenull136 function Translate(const Identifier, OriginalValue: String): String;
137 Property CharSet: String read FCharSet;
138 procedure Report;
139 procedure Report(StartIndex, StopIndex: Integer; const DisplayHeader: Boolean); //pochecker
140 procedure Report(Log: TStrings; StartIndex, StopIndex: Integer; const DisplayHeader: Boolean); //pochecker
141 procedure CreateHeader;
142 procedure UpdateStrings(InputLines:TStrings; SType: TStringsType);
143 procedure SaveToStrings(OutLst: TStrings);
144 procedure SaveToFile(const AFilename: string);
145 procedure UpdateItem(const Identifier: string; Original: string);
146 procedure FillItem(var CurrentItem: TPOFileItem; Identifier, Original,
147 Translation, Comments, Context, Flags, PreviousID: string; LineNr: Integer = -1);
148 procedure UpdateTranslation(BasePOFile: TPOFile);
149
150 procedure UntagAll;
151 procedure RemoveTaggedItems(aTag: Integer);
152
153 procedure RemoveIdentifier(const AIdentifier: string);
154 procedure RemoveOriginal(const AOriginal: string);
155 procedure RemoveIdentifiers(AIdentifiers: TStrings);
156 procedure RemoveOriginals(AOriginals: TStrings);
157
158 property Tag: integer read FTag write FTag;
159 property Modified: boolean read FModified;
160 property Items: TFPList read FItems;
161 // used by pochecker /pohelper
162 public
163 procedure CleanUp; // removes previous ID from non-fuzzy entries
164 property PoName: String read FPoName;
165 property PoRename: String write FPoName;
166 property Statistics: TTranslationStatistics read GetStatistics;
167 procedure InvalidateStatistics;
FindPoItemnull168 function FindPoItem(const Identifier: String): TPoFileItem;
OriginalToItemnull169 function OriginalToItem(const Data: String): TPoFileItem;
170 property PoItems[Index: Integer]: TPoFileItem read GetPoItem;
171 property Count: Integer read GetCount;
172 property Header: TPOFileItem read FHeader;
173 end;
174
175 EPOFileError = class(Exception)
176 public
177 ResFileName: string;
178 POFileName: string;
179 end;
180
181 var
182 SystemCharSetIsUTF8: Boolean = true;// the LCL interfaces expect UTF-8 as default
183 // if you don't use UTF-8, install a proper widestring manager and set this
184 // to false.
185
186 function FindAllTranslatedPoFiles(const Filename: string): TStringList;
187
188 // translate resource strings for one unit
189 function TranslateUnitResourceStrings(const ResUnitName, BaseFilename,
190 Lang, FallbackLang: string):TTranslateUnitResult; overload;
191 function TranslateUnitResourceStrings(const ResUnitName, AFilename: string
192 ): boolean; overload;
193 function TranslateUnitResourceStrings(const ResUnitName:string; po: TPOFile): boolean; overload;
194
195 // translate all resource strings
196 function TranslateResourceStrings(po: TPOFile): boolean;
197 function TranslateResourceStrings(const AFilename: string): boolean;
198 procedure TranslateResourceStrings(const BaseFilename, Lang, FallbackLang: string);
199
200 function UTF8ToSystemCharSet(const s: string): string; inline;
201
202 function UpdatePoFile(RSTFiles: TStrings; const POFilename: string): boolean;
203 procedure UpdatePoFileTranslations(const BasePOFilename: string; BasePOFile: TPOFile = nil);
204
205 const
206 sFuzzyFlag = 'fuzzy';
207 sBadFormatFlag = 'badformat';
208
209
210 implementation
211
212 function IsKey(Txt, Key: PChar): boolean;
213 begin
214 if Txt=nil then exit(false);
215 if Key=nil then exit(true);
216 repeat
217 if Key^=#0 then exit(true);
218 if Txt^<>Key^ then exit(false);
219 inc(Key);
220 inc(Txt);
221 until false;
222 end;
223
224 function GetUTF8String(TxtStart, TxtEnd: PChar): string; inline;
225 begin
226 Result:=UTF8CStringToUTF8String(TxtStart,TxtEnd-TxtStart);
227 end;
228
229 function ComparePOItems(Item1, Item2: Pointer): Integer;
230 begin
231 Result := CompareText(TPOFileItem(Item1).IdentifierLow,
232 TPOFileItem(Item2).IdentifierLow);
233 end;
234
235 function UTF8ToSystemCharSet(const s: string): string; inline;
236 begin
237 if SystemCharSetIsUTF8 then
238 exit(s);
239 {$IFDEF NoUTF8Translations}
240 Result:=s;
241 {$ELSE}
242 Result:=UTF8ToSys(s);
243 {$ENDIF}
244 end;
245
246 function SkipLineEndings(var P: PChar; var DecCount: Integer): Integer;
247 procedure Skip;
248 begin
249 Dec(DecCount);
250 Inc(P);
251 end;
252 begin
253 Result := 0;
254 while (P^ in [#10,#13]) do begin
255 Inc(Result);
256 if (P^=#13) then begin
257 Skip;
258 if P^=#10 then
259 Skip;
260 end else
261 Skip;
262 end;
263 end;
264
265 function CompareMultilinedStrings(const S1,S2: string): Integer;
266 var
267 C1,C2,L1,L2: Integer;
268 P1,P2: PChar;
269 begin
270 L1 := Length(S1);
271 L2 := Length(S2);
272 P1 := pchar(S1);
273 P2 := pchar(S2);
274 Result := ord(P1^) - ord(P2^);
275
276 while (Result=0) and (L1>0) and (L2>0) and (P1^<>#0) do begin
277 if (P1^<>P2^) or (P1^ in [#10,#13]) then begin
278 C1 := SkipLineEndings(P1, L1);
279 C2 := SkipLineEndings(P2, L2);
280 if (C1<>C2) then
281 // different amount of lineendings
282 result := C1-C2
283 else
284 if (C1=0) then
285 // there are no lineendings at all, will end loop
286 result := Ord(P1^)-Ord(P2^);
287 end;
288 Inc(P1); Inc(P2);
289 Dec(L1); Dec(L2);
290 end;
291
292 // if strings are the same, check that all chars have been consumed
293 // just in case there are unexpected chars in between, in this case
294 // L1=L2=0;
295 if Result=0 then
296 Result := L1-L2;
297 end;
298
299 function StrToPoStr(const s:string):string;
300 var
301 SrcPos, DestPos: Integer;
302 NewLength: Integer;
303 begin
304 NewLength:=length(s);
305 for SrcPos:=1 to length(s) do
306 if s[SrcPos] in ['"','\'] then inc(NewLength);
307 if NewLength=length(s) then begin
308 Result:=s;
309 end else begin
310 SetLength(Result,NewLength);
311 DestPos:=1;
312 for SrcPos:=1 to length(s) do begin
313 case s[SrcPos] of
314 '"','\':
315 begin
316 Result[DestPos]:='\';
317 inc(DestPos);
318 Result[DestPos]:=s[SrcPos];
319 inc(DestPos);
320 end;
321 else
322 Result[DestPos]:=s[SrcPos];
323 inc(DestPos);
324 end;
325 end;
326 end;
327 end;
328
329 function ExtractFormatArgs(S: String; out ArgumentError: Integer): String;
330 const
331 FormatArgs = 'DEFGMNPSUX';
332 FormatChar = '%';
333 FormatSpecs = ':-.0123456789';
334 var
335 p: PtrInt;
336 NewStr, Symb: String;
337 begin
338 NewStr := '';
339 ArgumentError := 0;
340 p := UTF8Pos(FormatChar, S);
341 while (Length(S)>0) and (p>0) and (ArgumentError=0) do
342 begin
343 UTF8Delete(S, 1, p);
344 if Length(S)>0 then
345 begin
346 Symb := UTF8UpperCase(UTF8Copy(S, 1, 1));
347 while (Length(S)>1) and (UTF8Pos(Symb, FormatSpecs)>0) do
348 begin
349 //weak syntax check for formatting options, skip them if found
350 UTF8Delete(S, 1, 1);
351 Symb := UTF8UpperCase(UTF8Copy(S, 1, 1));
352 end;
353 if Symb <> FormatChar then
354 begin
355 NewStr := NewStr+Symb;
356 if UTF8Pos(Symb, FormatArgs)=0 then
357 ArgumentError := Utf8Length(NewStr);
358 end;
359 //removing processed symbol
360 UTF8Delete(S, 1, 1);
361 //searching for next argument
362 p := UTF8Pos(FormatChar, S);
363 end
364 else
365 //in this case formatting symbol doesn't have its argument
366 ArgumentError := Utf8Length(NewStr) + 1;
367 end;
368 Result := NewStr;
369 end;
370
CompareFormatArgsnull371 function CompareFormatArgs(S1, S2: String): Boolean;
372 var
373 Extr1, Extr2: String;
374 ArgErr1, ArgErr2: Integer;
375 begin
376 Result := true;
377 //do not check arguments if strings are equal to save time and avoid some
378 //false positives, e.g. for '{%Region}' string in lazarusidestrconsts
379 if S1 <> S2 then
380 begin
381 Extr1 := ExtractFormatArgs(S1, ArgErr1);
382 Extr2 := ExtractFormatArgs(S2, ArgErr2);
383 //writeln('Extr1 = ',Extr1,' ArgErr1 = ',ArgErr1);
384 //writeln('Extr2 = ',Extr1,' ArgErr2 = ',ArgErr2);
385 if (ArgErr1 = 0) then
386 begin
387 if (ArgErr2 = 0) then
388 begin
389 Result := Utf8CompareText(Extr1, Extr2) = 0;
390 end
391 else
392 begin
393 //Extr2 can have dangling %'s
394 //e.g. Extr1 = "%s %d" Extr2 = "%s %d {%H}", it does not make sense, but it's not illegal
395 if (ArgErr2 = Utf8Length(Extr1)+1) and not (ArgErr2 > Utf8Length(Extr2)) then Extr2 := Utf8Copy(Extr2,1,ArgErr2-1);
396 Result := Utf8CompareText(Extr1, Extr2) = 0;
397 end;
398 end
399 else
400 begin //ArgErr1 <> 0
401 //Assume Extr1 is always legal, otherwise the IDE would crash in it's default language...
402 //Only compare until the last valid argument in Extr1
403 if (ArgErr1 = Utf8Length(Extr1)) then Utf8Delete(Extr1, ArgErr1, 1);
404 if Utf8Length(Extr2) > Utf8Length(Extr1) then Extr2 := Utf8Copy(Extr2, 1, Utf8Length(Extr1));
405 Result := Utf8CompareText(Extr1, Extr2) = 0;
406 end;
407 //writeln('CompareFormatArgs: Result = ',Result);
408 end;
409 end;
410
411 function FindAllTranslatedPoFiles(const Filename: string): TStringList;
412 var
413 Path: String;
414 Name: String;
415 NameOnly: String;
416 Ext: String;
417 FileInfo: TSearchRec;
418 CurExt: String;
419 begin
420 Result:=TStringList.Create;
421 Path:=ExtractFilePath(Filename);
422 Name:=ExtractFilename(Filename);
423 Ext:=ExtractFileExt(Filename);
424 NameOnly:=LeftStr(Name,length(Name)-length(Ext));
425 if FindFirstUTF8(Path+GetAllFilesMask,faAnyFile,FileInfo)=0 then begin
426 repeat
427 if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='')
428 or (CompareFilenames(FileInfo.Name,Name)=0) then continue;
429 CurExt:=ExtractFileExt(FileInfo.Name);
430 if (CompareFilenames(CurExt,'.po')<>0)
431 //skip files which names don't have form 'nameonly.foo.po', e.g. 'nameonlyfoo.po'
432 or (CompareFilenames(LeftStr(FileInfo.Name,length(NameOnly)+1),NameOnly+'.')<>0)
433 then
434 continue;
435 Result.Add(Path+FileInfo.Name);
436 until FindNextUTF8(FileInfo)<>0;
437 end;
438 FindCloseUTF8(FileInfo);
439 end;
440
441 procedure UpdatePoFileTranslations(const BasePOFilename: string; BasePOFile: TPOFile);
442 var
443 j: Integer;
444 Lines: TStringList;
445 FreeBasePOFile: Boolean;
446 TranslatedPOFile: TPOFile;
447 E: EPOFileError;
448 begin
449 // Update translated PO files
450 FreeBasePOFile := false;
451 Lines := FindAllTranslatedPoFiles(BasePOFilename);
452 try
453 for j:=0 to Lines.Count-1 do begin
454 TranslatedPOFile := TPOFile.Create(Lines[j], true);
455 try
456 TranslatedPOFile.Tag:=1;
457 if BasePOFile=nil then begin
458 BasePOFile := TPOFile.Create(BasePOFilename, true);
459 FreeBasePOFile := true;
460 end;
461 TranslatedPOFile.UpdateTranslation(BasePOFile);
462 try
463 TranslatedPOFile.SaveToFile(Lines[j]);
464 except
465 on Ex: Exception do begin
466 E := EPOFileError.Create(Ex.Message);
467 E.ResFileName:=Lines[j];
468 E.POFileName:=BasePOFileName;
469 raise E;
470 end;
471 end;
472 finally
473 TranslatedPOFile.Free;
474 end;
475 end;
476 finally
477 if FreeBasePOFile then
478 BasePOFile.Free;
479 Lines.Free;
480 end;
481 end;
482
UpdatePOFilenull483 function UpdatePOFile(RSTFiles: TStrings; const POFilename: string): boolean;
484 var
485 InputLines: TStringListUTF8;
486 Filename: string;
487 BasePoFile: TPoFile;
488 i: Integer;
489 E: EPOFileError;
490 begin
491 Result := false;
492
493 if (RSTFiles=nil) or (RSTFiles.Count=0) then begin
494 if FileExistsUTF8(POFilename) then begin
495 // just update translated po RSTFiles
496 UpdatePoFileTranslations(POFilename);
497 end;
498 exit;
499 end;
500
501 InputLines := TStringListUTF8.Create;
502 try
503 // Read base po items
504 if FileExistsUTF8(POFilename) then
505 BasePOFile := TPOFile.Create(POFilename, true)
506 else
507 BasePOFile := TPOFile.Create;
508 BasePOFile.Tag:=1;
509 // untagging is done only once for BasePoFile
510 BasePOFile.UntagAll;
511
512 // Update po file with lrj, rst/rsj of RSTFiles
513 for i:=0 to RSTFiles.Count-1 do begin
514 Filename:=RSTFiles[i];
515 if (CompareFileExt(Filename,'.lrj')=0) or
516 (CompareFileExt(Filename,'.rst')=0) or
517 (CompareFileExt(Filename,'.rsj')=0) then
518 try
519 //DebugLn('');
520 //DebugLn(['AddFiles2Po Filename="',Filename,'"']);
521 InputLines.Clear;
522 InputLines.LoadFromFile(FileName);
523
524 if CompareFileExt(Filename,'.lrj')=0 then
525 BasePOFile.UpdateStrings(InputLines, stLrj)
526 else
527 if CompareFileExt(Filename,'.rsj')=0 then
528 BasePOFile.UpdateStrings(InputLines, stRsj)
529 else
530 BasePOFile.UpdateStrings(InputLines, stRst);
531 except
532 on Ex: Exception do begin
533 E := EPOFileError.Create(Ex.Message);
534 E.ResFileName:=FileName;
535 E.POFileName:=POFileName;
536 raise E;
537 end;
538 end;
539 end;
540 // once all rst/rsj/lrj files are processed, remove all unneeded (missing in them) items
541 BasePOFile.RemoveTaggedItems(0);
542
543 BasePOFile.SaveToFile(POFilename);
544 Result := BasePOFile.Modified;
545
546 UpdatePoFileTranslations(POFilename,BasePoFile);
547
548 finally
549 InputLines.Free;
550 BasePOFile.Free;
551 end;
552 end;
553
Translatenull554 function Translate (Name,Value : AnsiString; {%H-}Hash : Longint; arg:pointer) : AnsiString;
555 var
556 po: TPOFile;
557 begin
558 po:=TPOFile(arg);
559 // get UTF8 string
560 result := po.Translate(Name,Value);
561 // convert UTF8 to current local
562 if result<>'' then
563 result:=UTF8ToSystemCharSet(result);
564 end;
565
TranslateUnitResourceStringsnull566 function TranslateUnitResourceStrings(const ResUnitName, AFilename: string
567 ): boolean;
568 var po: TPOFile;
569 begin
570 //debugln('TranslateUnitResourceStrings) ResUnitName="',ResUnitName,'" AFilename="',AFilename,'"');
571 if (ResUnitName='') or (AFilename='') or (not FileExistsUTF8(AFilename)) then
572 exit;
573 result:=false;
574 po:=nil;
575 try
576 po:=TPOFile.Create(AFilename);
577 result:=TranslateUnitResourceStrings(ResUnitName,po);
578 finally
579 po.free;
580 end;
581 end;
582
TranslateUnitResourceStringsnull583 function TranslateUnitResourceStrings(const ResUnitName: string; po: TPOFile): boolean;
584 begin
585 Result:=false;
586 try
587 SetUnitResourceStrings(ResUnitName,@Translate,po);
588 Result:=true;
589 except
590 on e: Exception do begin
591 {$IFnDEF DisableChecks}
592 DebugLn('Exception while translating ', ResUnitName);
593 DebugLn(e.Message);
594 DumpExceptionBackTrace;
595 {$ENDIF}
596 end;
597 end;
598 end;
599
TranslateUnitResourceStringsnull600 function TranslateUnitResourceStrings(const ResUnitName, BaseFilename,
601 Lang, FallbackLang: string):TTranslateUnitResult;
602 begin
603 Result:=turOK; //Result: OK
604 if (ResUnitName='') or (BaseFilename='') then
605 Result:=turEmptyParam //Result: empty Parameter
606 else begin
607 if (FallbackLang<>'') and FileExistsUTF8(Format(BaseFilename,[FallbackLang])) then
608 TranslateUnitResourceStrings(ResUnitName,Format(BaseFilename,[FallbackLang]))
609 else
610 Result:=turNoFBLang; //Result: missing FallbackLang file
611 if (Lang<>'') and FileExistsUTF8(Format(BaseFilename,[Lang])) then
612 TranslateUnitResourceStrings(ResUnitName,Format(BaseFilename,[Lang]))
613 else
614 Result:=turNoLang; //Result: missing Lang file
615 end;
616 end;
617
TranslateResourceStringsnull618 function TranslateResourceStrings(po: TPOFile): boolean;
619 begin
620 Result:=false;
621 try
622 SetResourceStrings(@Translate,po);
623 Result:=true;
624 except
625 on e: Exception do begin
626 {$IFnDEF DisableChecks}
627 DebugLn('Exception while translating:');
628 DebugLn(e.Message);
629 DumpExceptionBackTrace;
630 {$ENDIF}
631 end;
632 end;
633 end;
634
TranslateResourceStringsnull635 function TranslateResourceStrings(const AFilename: string): boolean;
636 var
637 po: TPOFile;
638 begin
639 //debugln('TranslateResourceStrings) AFilename="',AFilename,'"');
640 if (AFilename='') or (not FileExistsUTF8(AFilename)) then
641 exit;
642 Result:=false;
643 po:=nil;
644 try
645 po:=TPOFile.Create(AFilename);
646 Result:=TranslateResourceStrings(po);
647 finally
648 po.free;
649 end;
650 end;
651
652 procedure TranslateResourceStrings(const BaseFilename, Lang, FallbackLang: string);
653 begin
654 if (BaseFilename='') then exit;
655
656 //debugln('TranslateResourceStrings BaseFilename="',BaseFilename,'"');
657 if (FallbackLang<>'') then
658 TranslateResourceStrings(Format(BaseFilename,[FallbackLang]));
659 if (Lang<>'') then
660 TranslateResourceStrings(Format(BaseFilename,[Lang]));
661 end;
662
663 { TPOFile }
664
GetCountnull665 function TPOFile.GetCount: Integer;
666 begin
667 Result := FItems.Count;
668 end;
669
670 procedure TPOFile.SetCharSet(const AValue: String);
671 begin
672 if (CompareText(FCharSet, AValue) = 0) then Exit;
673 if (AValue = '') then FCharSet := 'UTF-8'
674 else FCharSet := AValue;
675 end;
676
TPOFile.GetPoItemnull677 function TPOFile.GetPoItem(Index: Integer): TPoFileItem;
678 begin
679 Result := TPoFileItem(FItems.Items[Index]);
680 end;
681
682 procedure TPOFile.ReadPOText(AStream: TStream);
683 var
684 Size: Integer;
685 s: string;
686 begin
687 Size:=AStream.Size-AStream.Position;
688 if Size<=0 then exit;
689 SetLength(s,Size);
690 AStream.Read(s[1],Size);
691 ReadPOText(s);
692 end;
693
694 constructor TPOFile.Create(Full:Boolean=True);
695 begin
696 inherited Create;
697 FAllEntries:=Full;
698 // changing 'fuzzy' flag is allowed by default
699 FAllowChangeFuzzyFlag:=true;
700 FItems:=TFPList.Create;
701 FIdentifierLowToItem:=TStringToPointerTree.Create(true);
702 FOriginalToItem:=TStringHashList.Create(true);
703 end;
704
705 constructor TPOFile.Create(const AFilename: String; Full: boolean=false; AllowChangeFuzzyFlag: boolean=true);
706 var
707 f: TStream;
708 begin
709 FPoName := AFilename;
710 f := TFileStreamUTF8.Create(AFilename, fmOpenRead or fmShareDenyNone);
711 try
712 Create(f, Full, AllowChangeFuzzyFlag);
713 if FHeader=nil then
714 CreateHeader;
715 finally
716 f.Free;
717 end;
718 end;
719
720 constructor TPOFile.Create(AStream: TStream; Full: boolean=false; AllowChangeFuzzyFlag: boolean=true);
721 begin
722 Create;
723
724 FAllEntries := Full;
725 //AllowChangeFuzzyFlag allows not to change fuzzy flag for items with bad format arguments,
726 //so there can be arguments with only badformat flag set. This is needed for POChecker.
727 FAllowChangeFuzzyFlag := AllowChangeFuzzyFlag;
728
729 ReadPOText(AStream);
730
731 if AllowChangeFuzzyFlag then
732 CleanUp; // Removes previous ID from non-fuzzy entries (not needed for POChecker)
733 InvalidateStatistics;
734 end;
735
736 destructor TPOFile.Destroy;
737 var
738 i: Integer;
739 begin
740 if FHelperList<>nil then
741 FHelperList.Free;
742 if FHeader<>nil then
743 FHeader.Free;
744 for i:=0 to FItems.Count-1 do
745 TObject(FItems[i]).Free;
746 FItems.Free;
747 FIdentifierLowToItem.Free;
748 FOriginalToItem.Free;
749 inherited Destroy;
750 end;
751
752 procedure TPOFile.ReadPOText(const Txt: string);
753 { Read a .po file. Structure:
754
755 Example
756 #: lazarusidestrconsts:lisdonotshowsplashscreen
757 msgid " Do not show splash screen"
758 msgstr ""
759
760 }
761 type
762 TMsg = (
763 mid,
764 mstr,
765 mctxt
766 );
767 var
768 l: Integer;
769 LineLen: Integer;
770 p: PChar;
771 LineStart: PChar;
772 LineEnd: PChar;
773 Cnt: Integer;
774 LineNr: Integer;
775 Identifier: String;
776 PrevMsgID: String;
777 Comments: String;
778 Flags: string;
779 TextEnd: PChar;
780 i: Integer;
781 OldLineStartPos: PtrUInt;
782 NewSrc: String;
783 s: String;
784 Handled: Boolean;
785 CurMsg: TMsg;
786 Msg: array[TMsg] of string;
787 MsgStrFlag: boolean;
788
789 procedure ResetVars;
790 begin
791 CurMsg:=mid;
792 Msg[mid]:='';
793 Msg[mstr]:='';
794 Msg[mctxt]:='';
795 Identifier := '';
796 Comments := '';
797 Flags := '';
798 PrevMsgID := '';
799 MsgStrFlag := false;
800 end;
801
802 procedure AddEntry (LineNr: Integer);
803 var
804 Item: TPOFileItem;
805 begin
806 Item := nil;
807 if Identifier<>'' then begin
808 FillItem(Item,Identifier,Msg[mid],Msg[mstr],Comments,Msg[mctxt],Flags,PrevMsgID,LineNr);
809 ResetVars;
810 end
811 else if (Msg[CurMsg]<>'') and (FHeader=nil) then begin
812 FHeader := TPOFileItem.Create('',Msg[mid],Msg[CurMsg]);
813 FHeader.Comments:=Comments;
814 ResetVars;
815 end;
816 end;
817
818 begin
819 if Txt='' then exit;
820 s:=Txt;
821 l:=length(s);
822 p:=PChar(s);
823 LineStart:=p;
824 TextEnd:=p+l;
825 Cnt := 0;
826 LineNr := 0;
827 ResetVars;
828
829 while LineStart<TextEnd do begin
830 LineEnd:=LineStart;
831 while (not (LineEnd^ in [#0,#10,#13])) do inc(LineEnd);
832 LineLen:=LineEnd-LineStart;
833 Inc(Cnt); // we must count also empty lines
834 if LineLen>0 then begin
835 Handled:=false;
836 case LineStart^ of
837 '#':
838 begin
839 if MsgStrFlag=true then begin
840 //we detected comments after previous MsgStr. Consider it as start of new entry
841 AddEntry(LineNr);
842 inc(Cnt); // for empty line before comment
843 LineNr := Cnt; // the comment line is the line number for this entry
844 end;
845 case LineStart[1] of
846 ':':
847 if LineStart[2]=' ' then begin
848 // '#: '
849 Identifier:=copy(s,LineStart-p+4,LineLen-3);
850 // the RTL creates identifier paths with point instead of colons
851 // fix it:
852 for i:=1 to length(Identifier) do
853 if Identifier[i]=':' then
854 Identifier[i]:='.';
855 Handled:=true;
856 end;
857 '|':
858 if IsKey(LineStart,'#| msgid "') then begin
859 PrevMsgID:=PrevMsgID+GetUTF8String(LineStart+length('#| msgid "'),LineEnd-1);
860 Handled:=true;
861 end else if IsKey(LineStart, '#| "') then begin
862 PrevMsgID := PrevMsgID + GetUTF8String(LineStart+length('#| "'),LineEnd-1);
863 Handled:=true;
864 end;
865 ',':
866 if LineStart[2]=' ' then begin
867 // '#, '
868 Flags := GetUTF8String(LineStart+3,LineEnd);
869 Handled:=true;
870 end;
871 end;
872 if not Handled then begin
873 // '#'
874 if Comments<>'' then
875 Comments := Comments + LineEnding;
876 // if comment is valid then store it, otherwise omit it
877 if (LineStart[1]=' ') or (LineStart[1]='.') then
878 Comments := Comments + GetUTF8String(LineStart+1,LineEnd)
879 else
880 GetUTF8String(LineStart+1,LineEnd);
881 Handled:=true;
882 end;
883 end;
884 'm':
885 if (LineStart[1]='s') and (LineStart[2]='g') then begin
886 case LineStart[3] of
887 'i':
888 if IsKey(LineStart,'msgid "') then begin
889 CurMsg:=mid;
890 Msg[CurMsg]:=Msg[CurMsg]+GetUTF8String(LineStart+length('msgid "'),LineEnd-1);
891 Handled:=true;
892 end;
893 's':
894 if IsKey(LineStart,'msgstr "') then begin
895 MsgStrFlag:=true;
896 CurMsg:=mstr;
897 Msg[CurMsg]:=Msg[CurMsg]+GetUTF8String(LineStart+length('msgstr "'),LineEnd-1);
898 Handled:=true;
899 end;
900 'c':
901 if IsKey(LineStart, 'msgctxt "') then begin
902 CurMsg:=mctxt;
903 Msg[CurMsg]:=Msg[CurMsg]+GetUTF8String(LineStart+length('msgctxt "'), LineEnd-1);
904 Handled:=true;
905 end;
906 end;
907 end;
908 '"':
909 begin
910 if (Msg[mid]='')
911 and IsKey(LineStart,'"Content-Type: text/plain; charset=') then
912 begin
913 FCharSet:=GetUTF8String(LineStart+length('"Content-Type: text/plain; charset='),LineEnd);
914 if SysUtils.CompareText(FCharSet,'UTF-8')<>0 then begin
915 // convert encoding to UTF-8
916 OldLineStartPos:=PtrUInt(LineStart-PChar(s))+1;
917 NewSrc:=ConvertEncoding(copy(s,OldLineStartPos,length(s)),
918 FCharSet,EncodingUTF8);
919 // replace text and update all pointers
920 s:=copy(s,1,OldLineStartPos-1)+NewSrc;
921 l:=length(s);
922 p:=PChar(s);
923 TextEnd:=p+l;
924 LineStart:=p+(OldLineStartPos-1);
925 LineEnd:=LineStart;
926 while (not (LineEnd^ in [#0,#10,#13])) do inc(LineEnd);
927 LineLen:=LineEnd-LineStart;
928 end;
929 end;
930 // continuation
931 Msg[CurMsg]:=Msg[CurMsg]+GetUTF8String(LineStart+1,LineEnd-1);
932 Handled:=true;
933 end;
934 end;
935 if not Handled then
936 AddEntry(LineNr);
937 end;
938 LineStart:=LineEnd+1;
939 while (LineStart^ in [#10,#13]) do inc(LineStart);
940 end;
941 AddEntry(LineNr);
942 end;
943
944 procedure TPOFile.RemoveIdentifiers(AIdentifiers: TStrings);
945 var
946 I: Integer;
947 begin
948 for I := 0 to AIdentifiers.Count - 1 do
949 RemoveIdentifier(AIdentifiers[I]);
950 end;
951
952 procedure TPOFile.RemoveOriginals(AOriginals: TStrings);
953 var
954 I: Integer;
955 begin
956 for I := 0 to AOriginals.Count - 1 do
957 RemoveOriginal(AOriginals[I]);
958 end;
959
960 procedure TPOFile.RemoveIdentifier(const AIdentifier: string);
961 var
962 Index: Integer;
963 Item: TPOFileItem;
964 begin
965 if Length(AIdentifier) > 0 then
966 begin
967 Item := TPOFileItem(FIdentifierLowToItem[LowerCase(AIdentifier)]);
968 if Item <> nil then
969 begin
970 Index := FItems.IndexOf(Item);
971 // We should always find our item, unless there is data corruption.
972 if Index >= 0 then
973 begin
974 Remove(Index);
975 Item.Free;
976 end;
977 end;
978 end;
979 end;
980
981 procedure TPOFile.RemoveOriginal(const AOriginal: string);
982 var
983 Index: Integer;
984 Item: TPOFileItem;
985 begin
986 if Length(AOriginal) > 0 then
987 // This search is expensive, it could be reimplemented using
988 // yet another hash map which maps to items by "original" value
989 // with stripped line ending characters.
990 for Index := FItems.Count - 1 downto 0 do
991 begin
992 Item := TPOFileItem(FItems[Index]);
993 if CompareMultilinedStrings(Item.Original, AOriginal) = 0 then
994 begin
995 Remove(Index);
996 Item.Free;
997 end;
998 end;
999 end;
1000
TPOFile.GetStatisticsnull1001 function TPOFile.GetStatistics: TTranslationStatistics;
1002 var
1003 Item: TPOFileItem;
1004 i: Integer;
1005 begin
1006 if FStatisticsUpdated = false then
1007 begin
1008 FStatistics.Translated := 0;
1009 FStatistics.Untranslated := 0;
1010 FStatistics.Fuzzy := 0;
1011 for i:=0 to Items.Count-1 do
1012 begin
1013 Item := TPOFileItem(FItems[i]);
1014 if Item.Translation = '' then
1015 Inc(FStatistics.Untranslated)
1016 else
1017 if Pos(sFuzzyFlag, Item.Flags)<>0 then
1018 Inc(FStatistics.Fuzzy)
1019 else
1020 Inc(FStatistics.Translated);
1021 end;
1022 FStatisticsUpdated := true;
1023 end;
1024 Result.Translated := FStatistics.Translated;
1025 Result.Untranslated := FStatistics.Untranslated;
1026 Result.Fuzzy := FStatistics.Fuzzy;
1027 end;
1028
TPOFile.Removenull1029 function TPOFile.Remove(Index: Integer): TPOFileItem;
1030 begin
1031 Result := TPOFileItem(FItems[Index]);
1032 FOriginalToItem.Remove(Result.Original, Result);
1033 FIdentifierLowToItem.Remove(Result.IdentifierLow);
1034 FItems.Delete(Index);
1035 end;
1036
TPOFile.Translatenull1037 function TPOFile.Translate(const Identifier, OriginalValue: String): String;
1038 var
1039 Item: TPOFileItem;
1040 l: Integer;
1041 begin
1042 Item:=TPOFileItem(FIdentifierLowToItem[lowercase(Identifier)]);
1043 if Item=nil then
1044 Item:=TPOFileItem(FOriginalToItem.Data[OriginalValue]);
1045 //Load translation only if it exists and is NOT fuzzy.
1046 //This matches gettext behaviour and allows to avoid a lot of crashes related
1047 //to formatting arguments mismatches.
1048 if (Item<>nil) and (pos(sFuzzyFlag, Item.Flags)=0)
1049 //Load translation only if it is not flagged as badformat.
1050 //This allows to avoid even more crashes related
1051 //to formatting arguments mismatches.
1052 and (pos(sBadFormatFlag, Item.Flags)=0) then
1053 begin
1054 if Item.Translation<>'' then
1055 Result:=Item.Translation
1056 else
1057 Result:=Item.Original;
1058 if Result='' then
1059 Raise Exception.Create('TPOFile.Translate Inconsistency');
1060 end else
1061 Result:=OriginalValue;
1062 //Remove lineending at the end of the string if present.
1063 //This is the case e.g. for multiline strings and not desired when assigning e.g. to
1064 //Caption property (can negatively affect form layout). In other cases it should not matter.
1065 l:=Length(Result);
1066 if l>1 then
1067 begin
1068 //Every string with #13 and/or #10 character at the end was treated as multiline, this means that
1069 //extra lineending could have been added to it.
1070 if RightStr(Result,2)=#13#10 then
1071 begin
1072 if l>2 then //do not leave the string empty
1073 SetLength(Result,l-2);
1074 end
1075 else
1076 if (Result[l]=#13) or (Result[l]=#10) then
1077 SetLength(Result,l-1);
1078 end;
1079 end;
1080
1081 procedure TPOFile.Report;
1082 var
1083 Item: TPOFileItem;
1084 i: Integer;
1085 begin
1086 DebugLn('Header:');
1087 DebugLn('---------------------------------------------');
1088
1089 if FHeader=nil then
1090 DebugLn('No header found in po file')
1091 else begin
1092 DebugLn('Comments=',FHeader.Comments);
1093 DebugLn('Identifier=',FHeader.IdentifierLow);
1094 DebugLn('msgid=',FHeader.Original);
1095 DebugLn('msgstr=', FHeader.Translation);
1096 end;
1097 DebugLn;
1098
1099 DebugLn('Entries:');
1100 DebugLn('---------------------------------------------');
1101 for i:=0 to FItems.Count-1 do begin
1102 DebugLn(['#', i ,': ']);
1103 Item := TPOFileItem(FItems[i]);
1104 DebugLn('Comments=',Item.Comments);
1105 DebugLn('Identifier=',Item.IdentifierLow);
1106 DebugLn('msgid=',Item.Original);
1107 DebugLn('msgstr=', Item.Translation);
1108 DebugLn;
1109 end;
1110
1111 end;
1112
1113 procedure TPOFile.Report(StartIndex, StopIndex: Integer;
1114 const DisplayHeader: Boolean);
1115 var
1116 Item: TPOFileItem;
1117 i: Integer;
1118 begin
1119 if DisplayHeader then
1120 begin
1121 DebugLn('Header:');
1122 DebugLn('---------------------------------------------');
1123
1124 if FHeader=nil then
1125 DebugLn('No header found in po file')
1126 else begin
1127 DebugLn('Comments=',FHeader.Comments);
1128 DebugLn('Identifier=',FHeader.IdentifierLow);
1129 DebugLn('msgid=',FHeader.Original);
1130 DebugLn('msgstr=', FHeader.Translation);
1131 end;
1132 DebugLn;
1133 end;
1134
1135 if (StartIndex > StopIndex) then
1136 begin
1137 i := StopIndex;
1138 StopIndex := StartIndex;
1139 StartIndex := i;
1140 end;
1141 if (StopIndex > Count - 1) then StopIndex := Count - 1;
1142 if (StartIndex < 0) then StartIndex := 0;
1143
1144 DebugLn(['Entries [', StartIndex, '..', StopIndex, ']:']);
1145 DebugLn('---------------------------------------------');
1146 for i := StartIndex to StopIndex do begin
1147 DebugLn(['#', i, ': ']);
1148 Item := TPOFileItem(FItems[i]);
1149 DebugLn('Identifier=',Item.IdentifierLow);
1150 DebugLn('msgid=',Item.Original);
1151 DebugLn('msgstr=', Item.Translation);
1152 DebugLn('Comments=',Item.Comments);
1153 DebugLn;
1154 end;
1155 end;
1156
1157 procedure TPOFile.Report(Log: TStrings; StartIndex, StopIndex: Integer;
1158 const DisplayHeader: Boolean);
1159 var
1160 Item: TPOFileItem;
1161 i: Integer;
1162 begin
1163 if DisplayHeader then
1164 begin
1165 Log.Add('Header:');
1166 Log.Add('---------------------------------------------');
1167
1168 if FHeader=nil then
1169 Log.Add('No header found in po file')
1170 else begin
1171 Log.Add('Comments='+FHeader.Comments);
1172 Log.Add('Identifier='+FHeader.IdentifierLow);
1173 Log.Add('msgid='+FHeader.Original);
1174 Log.Add('msgstr='+ FHeader.Translation);
1175 end;
1176 Log.Add('');
1177 end;
1178
1179 if (StartIndex > StopIndex) then
1180 begin
1181 i := StopIndex;
1182 StopIndex := StartIndex;
1183 StartIndex := i;
1184 end;
1185 if (StopIndex > Count - 1) then StopIndex := Count - 1;
1186 if (StartIndex < 0) then StartIndex := 0;
1187
1188 Log.Add(Format('Entries [%d..%d]:', [StartIndex, StopIndex]));
1189 Log.Add('---------------------------------------------');
1190 for i := StartIndex to StopIndex do begin
1191 Log.Add(Format('#%d: ', [i]));
1192 Item := TPOFileItem(FItems[i]);
1193 Log.Add('Identifier='+Item.IdentifierLow);
1194 Log.Add('msgid='+Item.Original);
1195 Log.Add('msgstr='+ Item.Translation);
1196 Log.Add('Comments='+Item.Comments);
1197 Log.Add('');
1198 end;
1199 end;
1200
1201 procedure TPOFile.CreateHeader;
1202 begin
1203 if FHeader=nil then
1204 FHeader := TPOFileItem.Create('','','');
1205 FHeader.Translation:='Content-Type: text/plain; charset=UTF-8';
1206 FHeader.Comments:='';
1207 end;
1208
1209 procedure TPOFile.UpdateStrings(InputLines: TStrings; SType: TStringsType);
1210 var
1211 i, j, n: integer;
1212 p: LongInt;
1213 Identifier, Value, Line: string;
1214 Ch: Char;
1215 MultiLinedValue: boolean;
1216
1217 procedure NextLine;
1218 begin
1219 if i<InputLines.Count then
1220 inc(i);
1221 if i<InputLines.Count then
1222 Line := InputLines[i]
1223 else
1224 Line := '';
1225 n := Length(Line);
1226 p := 1;
1227 end;
1228
1229 procedure NormalizeValue;
1230 begin
1231 if MultiLinedValue then begin
1232 // check that we end on lineending, multilined
1233 // resource strings from rst usually do not end
1234 // in lineending, fix here.
1235 if not (Value[Length(Value)] in [#13,#10]) then
1236 Value := Value + LineEnding;
1237
1238 //treat #10#13 sequences as #13#10 for consistency,
1239 //e.g. #10#13#13#13#10#13#10 should become #13#10#13#13#10#13#10
1240 p:=2;
1241 while p<=Length(Value) do begin
1242 if (Value[p]=#13) and (Value[p-1]=#10) then begin
1243 Value[p]:=#10;
1244 Value[p-1]:=#13;
1245 end;
1246 // further analysis shouldn't affect found #13#10 pair
1247 if (Value[p]=#10) and (Value[p-1]=#13) then
1248 inc(p);
1249 inc(p);
1250 end;
1251 Value := AdjustLineBreaks(Value);
1252 end;
1253 // po requires special characters as #number
1254 p:=1;
1255 while p<=length(Value) do begin
1256 j := UTF8CodepointSize(pchar(@Value[p]));
1257 if (j=1) and (Value[p] in [#0..#9,#11,#12,#14..#31,#127..#255]) then
1258 Value := copy(Value,1,p-1)+'#'+IntToStr(ord(Value[p]))+copy(Value,p+1,length(Value))
1259 else
1260 inc(p,j);
1261 end;
1262 end;
1263
1264 procedure UpdateFromRSJ;
1265 var
1266 Parser: TJSONParser;
1267 JsonItems, SourceBytes: TJSONArray;
1268 JsonData, JsonItem: TJSONObject;
1269 K, L: Integer;
1270 Data: TJSONData;
1271 begin
1272 Parser := TJSONParser.Create(InputLines.Text{$IF FPC_FULLVERSION>=30001},jsonscanner.DefaultOptions{$ENDIF});
1273 try
1274 JsonData := Parser.Parse as TJSONObject;
1275 try
1276 JsonItems := JsonData.Arrays['strings'];
1277 for K := 0 to JsonItems.Count - 1 do
1278 begin
1279 MultiLinedValue := false;
1280 JsonItem := JsonItems.Items[K] as TJSONObject;
1281 Data:=JsonItem.Find('sourcebytes');
1282 if Data is TJSONArray then begin
1283 // fpc 3.1.1 writes the bytes of the source without encoding change
1284 // while 'value' contains the string encoded as UTF16 with \u hexcodes.
1285 SourceBytes := TJSONArray(Data);
1286 SetLength(Value,SourceBytes.Count);
1287 for L := 1 to length(Value) do begin
1288 Value[L] := chr(SourceBytes.Integers[L-1]);
1289 if Value[L] in [#13,#10] then
1290 MultilinedValue := True;
1291 end;
1292 end else begin
1293 Value:=JsonItem.Get('value');
1294 // check if the value we got is multilined
1295 L := 1;
1296 while (L<=Length(Value)) and (MultiLinedValue = false) do begin
1297 if Value[L] in [#13,#10] then
1298 MultilinedValue := True;
1299 inc(L);
1300 end;
1301 end;
1302 if Value<>'' then begin
1303 NormalizeValue;
1304 UpdateItem(JsonItem.Get('name'), Value);
1305 end;
1306 end;
1307 finally
1308 JsonData.Free;
1309 end;
1310 finally
1311 Parser.Free;
1312 end;
1313 end;
1314
1315 begin
1316 if (SType = stLrj) or (SType = stRsj) then
1317 // .lrj/.rsj file
1318 UpdateFromRSJ
1319 else
1320 begin
1321 // for each string in lrt/rst/rsj list check if it's already in PO
1322 // if not add it
1323 MultilinedValue := false;
1324 Value := '';
1325 Identifier := '';
1326 i := 0;
1327 while i < InputLines.Count do begin
1328
1329 Line := InputLines[i];
1330 n := Length(Line);
1331
1332 if n=0 then
1333 // empty line
1334 else begin
1335 // .rst file
1336 if Line[1]='#' then begin
1337 // rst file: comment
1338
1339 Value := '';
1340 Identifier := '';
1341 MultilinedValue := false;
1342
1343 end else begin
1344
1345 p:=Pos('=',Line);
1346 if P>0 then begin
1347
1348 Identifier := copy(Line,1,p-1);
1349 inc(p); // points to ' after =
1350
1351 Value := '';
1352 while p<=n do begin
1353
1354 if Line[p]='''' then begin
1355 inc(p);
1356 j:=p;
1357 while (p<=n)and(Line[p]<>'''') do
1358 inc(p);
1359 Value := Value + copy(Line, j, P-j);
1360 inc(p);
1361 continue;
1362 end else
1363 if Line[p] = '#' then begin
1364 // a #decimal
1365 repeat
1366 inc(p);
1367 j:=p;
1368 while (p<=n)and(Line[p] in ['0'..'9']) do
1369 inc(p);
1370
1371 Ch := Chr(StrToInt(copy(Line, j, p-j)));
1372 Value := Value + Ch;
1373 if Ch in [#13,#10] then
1374 MultilinedValue := True;
1375
1376 if (p=n) and (Line[p]='+') then
1377 NextLine;
1378
1379 until (p>n) or (Line[p]<>'#');
1380 end else
1381 if Line[p]='+' then
1382 NextLine
1383 else
1384 inc(p); // this is an unexpected string
1385 end;
1386
1387 if Value<>'' then begin
1388 NormalizeValue;
1389 UpdateItem(Identifier, Value);
1390 end;
1391
1392 end; // if p>0 then begin
1393 end;
1394 end;
1395
1396 inc(i);
1397 end;
1398 end;
1399 end;
1400
1401 procedure TPOFile.SaveToStrings(OutLst: TStrings);
1402 var
1403 j: Integer;
1404
1405 procedure WriteLst(const AProp, AValue: string );
1406 var
1407 i: Integer;
1408 s: string;
1409 begin
1410 if (AValue='') and (AProp='') then
1411 exit;
1412
1413 FHelperList.Text:=AValue;
1414 if FHelperList.Count=1 then begin
1415 if AProp='' then
1416 OutLst.Add(FHelperList[0])
1417 else begin
1418 if AProp='#' then
1419 //comments are not quoted
1420 OutLst.Add(AProp+FHelperList[0])
1421 else
1422 OutLst.Add(AProp+' "'+FHelperList[0]+'"');
1423 end;
1424 end else begin
1425 //comments are not quoted, instead prepend each line with '#'
1426 if (AProp<>'') and (AProp<>'#') then
1427 OutLst.Add(AProp+' ""');
1428 for i:=0 to FHelperList.Count-1 do begin
1429 s := FHelperList[i];
1430 if (AProp<>'') and (AProp<>'#') then begin
1431 s := '"' + s + '\n"';
1432 if AProp='#| msgid' then
1433 s := '#| ' + s;
1434 end else
1435 if AProp='#' then
1436 s := AProp + s;
1437 OutLst.Add(s)
1438 end;
1439 end;
1440 end;
1441
1442 procedure WriteItem(Item: TPOFileItem);
1443 begin
1444 if Item.Comments<>'' then
1445 WriteLst('#', Item.Comments);
1446 if Item.IdentifierLow<>'' then
1447 OutLst.Add('#: '+Item.IdentifierLow);
1448 if Trim(Item.Flags)<>'' then
1449 OutLst.Add('#, '+Trim(Item.Flags));
1450 if Item.PreviousID<>'' then
1451 WriteLst('#| msgid', strToPoStr(Item.PreviousID));
1452 if Item.Context<>'' then
1453 WriteLst('msgctxt', Item.Context);
1454 WriteLst('msgid', StrToPoStr(Item.Original));
1455 WriteLst('msgstr', StrToPoStr(Item.Translation));
1456 OutLst.Add('');
1457 end;
1458
1459 begin
1460 if FHeader=nil then
1461 CreateHeader;
1462
1463 if FHelperList=nil then
1464 FHelperList:=TStringList.Create;
1465
1466 // write header
1467 WriteItem(FHeader);
1468
1469 // Sort list of items by identifier
1470 FItems.Sort(@ComparePOItems);
1471
1472 for j:=0 to Fitems.Count-1 do
1473 WriteItem(TPOFileItem(FItems[j]));
1474 end;
1475
1476 // Remove all entries that have Tag=aTag
1477 procedure TPOFile.RemoveTaggedItems(aTag: Integer);
1478 var
1479 Item: TPOFileItem;
1480 i: Integer;
1481 begin
1482 for i:=FItems.Count-1 downto 0 do
1483 begin
1484 Item := TPOFileItem(FItems[i]);
1485 if Item.Tag = aTag then
1486 begin
1487 Remove(i);
1488 Item.Free;
1489 end;
1490 end;
1491 end;
1492
1493 procedure TPOFile.SaveToFile(const AFilename: string);
1494 var
1495 OutLst: TStringListUTF8;
1496 begin
1497 OutLst := TStringListUTF8.Create;
1498 try
1499 SaveToStrings(OutLst);
1500 OutLst.SaveToFile(AFilename);
1501 finally
1502 OutLst.Free;
1503 end;
1504 end;
1505
1506 procedure TPOFile.UpdateItem(const Identifier: string; Original: string);
1507 var
1508 Item: TPOFileItem;
1509 begin
1510 // try to find PO entry by identifier
1511 Item:=TPOFileItem(FIdentifierLowToItem[lowercase(Identifier)]);
1512 if Item<>nil then begin
1513 // found, update item value
1514 if CompareMultilinedStrings(Item.Original, Original)<>0 then begin
1515 FModified := True;
1516 if Item.Translation <> '' then begin
1517 if (Item.PreviousID = '') or (pos(sFuzzyFlag, Item.Flags) = 0) then
1518 Item.PreviousID:=Item.Original;
1519 Item.ModifyFlag(sFuzzyFlag, true);
1520 end;
1521 Item.Original:=Original;
1522 end;
1523 end
1524 else // in this case new item will be added
1525 FModified := true;
1526 FillItem(Item, Identifier, Original, '', '', '', '', '');
1527 end;
1528
1529 procedure TPOFile.FillItem(var CurrentItem: TPOFileItem; Identifier, Original,
1530 Translation, Comments, Context, Flags, PreviousID: string; LineNr: Integer = -1);
1531
1532 function VerifyItemFormatting(var Item: TPOFileItem): boolean;
1533 var
1534 HasBadFormatFlag: boolean;
1535 begin
1536 // this function verifies item formatting and sets its flags if the formatting is bad
1537 Result := true;
1538 if Item.Translation <> '' then
1539 begin
1540 Result := CompareFormatArgs(Item.Original,Item.Translation);
1541 if not Result then
1542 begin
1543 if pos(sFuzzyFlag, Item.Flags) = 0 then
1544 begin
1545 if FAllowChangeFuzzyFlag = true then
1546 begin
1547 Item.ModifyFlag(sFuzzyFlag, true);
1548 FModified := true;
1549 end;
1550 end;
1551 end;
1552 HasBadFormatFlag := pos(sBadFormatFlag, Item.Flags) <> 0;
1553 if HasBadFormatFlag <> not Result then
1554 begin
1555 Item.ModifyFlag(sBadFormatFlag, not Result);
1556 FModified := true;
1557 end;
1558 end
1559 else
1560 begin
1561 if pos(sFuzzyFlag, Item.Flags)<>0 then
1562 begin
1563 Item.ModifyFlag(sFuzzyFlag, false);
1564 FModified := true;
1565 end;
1566 if pos(sBadFormatFlag, Item.Flags) <> 0 then
1567 begin
1568 Item.ModifyFlag(sBadFormatFlag, false);
1569 FModified := true;
1570 end;
1571 end;
1572 end;
1573
1574 var
1575 FoundItem: TPOFileItem;
1576 begin
1577 FoundItem := TPOFileItem(FOriginalToItem.Data[Original]);
1578
1579 if CurrentItem = nil then
1580 begin
1581 if (not FAllEntries) and (((FoundItem=nil) or (FoundItem.Translation='')) and (Translation='')) then
1582 exit;
1583 CurrentItem:=TPOFileItem.Create(lowercase(Identifier), Original, Translation);
1584 CurrentItem.Comments := Comments;
1585 CurrentItem.Context := Context;
1586 CurrentItem.Flags := lowercase(Flags);
1587 CurrentItem.PreviousID := PreviousID;
1588 CurrentItem.LineNr := LineNr;
1589 FItems.Add(CurrentItem);
1590 //debugln(['TPOFile.FillItem Identifier=',Identifier,' Orig="',dbgstr(OriginalValue),'" Transl="',dbgstr(TranslatedValue),'"']);
1591 FIdentifierLowToItem[CurrentItem.IdentifierLow]:=CurrentItem;
1592 end;
1593
1594 CurrentItem.Tag := FTag;
1595
1596 if FoundItem <> nil then
1597 begin
1598 if FoundItem.IdentifierLow<>CurrentItem.IdentifierLow then
1599 begin
1600 // if old item doesn't have context, add one
1601 if FoundItem.Context='' then
1602 FoundItem.Context := FoundItem.IdentifierLow;
1603 // if current item doesn't have context, add one
1604 if CurrentItem.Context='' then
1605 CurrentItem.Context := CurrentItem.IdentifierLow;
1606 // marking items as duplicate (needed only by POChecker)
1607 FoundItem.Duplicate := true;
1608 CurrentItem.Duplicate := true;
1609 // if old item is already translated and current item not, use translation
1610 // note, that we do not copy fuzzy translations in order not to potentially mislead translators
1611 if (CurrentItem.Translation='') and (FoundItem.Translation<>'') and (pos(sFuzzyFlag, FoundItem.Flags) = 0) then
1612 begin
1613 CurrentItem.Translation := FoundItem.Translation;
1614 if CurrentItem.Flags='' then
1615 CurrentItem.Flags := FoundItem.Flags;
1616 CurrentItem.ModifyFlag(sFuzzyFlag, true);
1617 FModified := True;
1618 end;
1619 end;
1620 end;
1621
1622 VerifyItemFormatting(CurrentItem);
1623
1624 if Original <> '' then
1625 begin
1626 if (FoundItem = nil) or ((FoundItem.Translation = '') and (CurrentItem.Translation <> '')) or
1627 ((FoundItem.Translation <> '') and (CurrentItem.Translation <> '') and
1628 (pos(sFuzzyFlag, FoundItem.Flags) <> 0) and (pos(sFuzzyFlag, CurrentItem.Flags) = 0)) then
1629 begin
1630 if FoundItem <> nil then
1631 FOriginalToItem.Remove(Original);
1632 FOriginalToItem.Add(Original,CurrentItem);
1633 end;
1634 end;
1635
1636 end;
1637
1638 procedure TPOFile.UpdateTranslation(BasePOFile: TPOFile);
1639 var
1640 Item: TPOFileItem;
1641 i: Integer;
1642 begin
1643 UntagAll;
1644 for i:=0 to BasePOFile.Items.Count-1 do begin
1645 Item := TPOFileItem(BasePOFile.Items[i]);
1646 UpdateItem(Item.IdentifierLow, Item.Original);
1647 end;
1648 RemoveTaggedItems(0); // get rid of any item not existing in BasePOFile
1649 InvalidateStatistics;
1650 end;
1651
1652 procedure TPOFile.UntagAll;
1653 var
1654 Item: TPOFileItem;
1655 i: Integer;
1656 begin
1657 for i:=0 to Items.Count-1 do begin
1658 Item := TPOFileItem(Items[i]);
1659 Item.Tag:=0;
1660 end;
1661 end;
1662
1663 procedure TPOFile.CleanUp;
1664 var
1665 i: Integer;
1666 aPoItem: TPOFileItem;
1667 isFuzzy: boolean;
1668 begin
1669 for i := 0 to FItems.Count -1 do begin
1670 aPoItem := TPOFileItem(FItems.Items[i]);
1671 isFuzzy := pos(sFuzzyFlag,aPoItem.Flags) <> 0;
1672 if not isFuzzy then
1673 // remove PreviousID from non-fuzzy Items
1674 if aPoItem.PreviousID <> '' then begin
1675 aPoItem.PreviousID := '';
1676 FModified := true;
1677 end;
1678 end;
1679 end;
1680
1681 procedure TPOFile.InvalidateStatistics;
1682 begin
1683 FStatisticsUpdated := false;
1684 end;
1685
FindPoItemnull1686 function TPOFile.FindPoItem(const Identifier: String): TPoFileItem;
1687 begin
1688 Result := TPOFileItem(FIdentifierLowToItem[lowercase(Identifier)]);
1689 end;
1690
OriginalToItemnull1691 function TPOFile.OriginalToItem(const Data: String): TPoFileItem;
1692 begin
1693 // TODO: Should we take into account CompareMultilinedStrings ?
1694 Result := TPOFileItem(FOriginalToItem.Data[Data]);
1695 end;
1696
1697 { TPOFileItem }
1698
1699 constructor TPOFileItem.Create(const TheIdentifierLow, TheOriginal,
1700 TheTranslated: string);
1701 begin
1702 Duplicate:=false;
1703 IdentifierLow:=TheIdentifierLow;
1704 Original:=TheOriginal;
1705 Translation:=TheTranslated;
1706 end;
1707
1708 procedure TPOFileItem.ModifyFlag(const AFlag: string; Check: boolean);
1709 var
1710 i: Integer;
1711 F: TStringList;
1712 begin
1713 F := TStringList.Create;
1714 try
1715 F.CommaText := Flags;
1716 i := F.IndexOf(AFlag);
1717 if (i<0) and Check then
1718 F.Add(AFlag)
1719 else
1720 if (i>=0) and (not Check) then
1721 F.Delete(i);
1722 Flags := F.CommaText;
1723 finally
1724 F.Free;
1725 end;
1726 end;
1727
1728 end.
1729
1730