1 {
2  ***************************************************************************
3  *                                                                         *
4  *   This source is free software; you can redistribute it and/or modify   *
5  *   it under the terms of the GNU General Public License as published by  *
6  *   the Free Software Foundation; either version 2 of the License, or     *
7  *   (at your option) any later version.                                   *
8  *                                                                         *
9  *   This code is distributed in the hope that it will be useful, but      *
10  *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
11  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
12  *   General Public License for more details.                              *
13  *                                                                         *
14  *   A copy of the GNU General Public License is available on the World    *
15  *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
16  *   obtain it by writing to the Free Software Foundation,                 *
17  *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
18  *                                                                         *
19  ***************************************************************************
20 
21   Author: Mattias Gaertner
22 
23   Abstract:
24     Methods and classes for loading the IDE translations/localizations.
25 }
26 unit IDETranslations;
27 
28 {$mode objfpc}{$H+}
29 
30 {$I ide.inc}
31 
32 interface
33 
34 uses
35   Classes, SysUtils, GetText,
36   // LazUtils
37   LazFileUtils, LazFileCache, LazUTF8, Translations,
38   // Codetools
39   FileProcs, CodeToolManager, DirectoryCacher, CodeCache,
40   // IDE
41   LazarusIDEStrConsts;  { IDE Language (Human, not computer) }
42 
43 type
44   { TLazarusTranslation }
45 
46   TLazarusTranslation = class
47   private
48     FID: string;
49   public
50     property ID: string read FID;
51   end;
52   PLazarusTranslation = ^TLazarusTranslation;
53 
54 
55   { TLazarusTranslations }
56 
57   TLazarusTranslations = class
58   private
59     FCount: integer;
60     FItems: PLazarusTranslation;
GetItemsnull61     function GetItems(Index: integer): TLazarusTranslation;
62   public
63     destructor Destroy; override;
64     procedure Add(const ID: string);
IndexOfnull65     function IndexOf(const ID: string): integer;
66     procedure Clear;
67   public
68     property Count: integer read FCount;
69     property Items[Index: integer]: TLazarusTranslation read GetItems; default;
70   end;
71 
72   PPOFile = ^TPOFile;
73 
74 // translate all resource strings
75 procedure TranslateResourceStrings(const LazarusDir, CustomLang: string);
76 
77 // get language name for ID
GetLazarusLanguageLocalizedNamenull78 function GetLazarusLanguageLocalizedName(const ID: string): String;
79 
80 // collect all available translations
81 procedure CollectTranslations(const LazarusDir: string); // this updates LazarusTranslations
82 
ConvertRSTFilesnull83 function ConvertRSTFiles(RSTDirectory, PODirectory: string;
84   POFilename: string = '' // set POFilename to gather all rst into one po file
85   ): Boolean;
86 procedure UpdatePoFileAndTranslations(SrcFiles: TStrings;
87   const POFilename: string);
88 procedure UpdatePoFileAndTranslations(SrcFiles: TStrings;
89   const POFilename: string; ForceUpdatePoFiles: Boolean;
90   ExcludedIdentifiers: TStrings; ExcludedOriginals: TStrings);
91 procedure UpdateBasePoFile(SrcFiles: TStrings;
92   const POFilename: string; POFile: PPOFile = nil);
93 procedure UpdateBasePoFile(SrcFiles: TStrings;
94   const POFilename: string; POFile: PPOFile;
95   ExcludedIdentifiers: TStrings; ExcludedOriginals: TStrings);
FindTranslatedPoFilesnull96 function FindTranslatedPoFiles(const BasePOFilename: string): TStringList;
97 procedure UpdateTranslatedPoFile(const BasePOFile: TPOFile; TranslatedFilename: string);
98 
99 var
100   LazarusTranslations: TLazarusTranslations = nil; // see CollectTranslations
101   SystemLanguageID1, SystemLanguageID2: string;
102 
103 implementation
104 
GetLazarusLanguageLocalizedNamenull105 function GetLazarusLanguageLocalizedName(const ID: string): String;
106 begin
107   if ID='' then
108     Result:=rsLanguageAutomatic
109   else if CompareText(ID,'en')=0 then
110     Result:=rsLanguageEnglish
111   else if CompareText(ID,'de')=0 then
112     Result:=rsLanguageGerman
113   else if CompareText(ID,'ca')=0 then
114     Result:=rsLanguageCatalan
115   else if CompareText(ID,'fr')=0 then
116     Result:=rsLanguageFrench
117   else if CompareText(ID,'it')=0 then
118     Result:=rsLanguageItalian
119   else if CompareText(ID,'pl')=0 then
120     Result:=rsLanguagePolish
121   else if CompareText(ID,'ru')=0 then
122     Result:=rsLanguageRussian
123   else if CompareText(ID,'es')=0 then
124     Result:=rsLanguageSpanish
125   else if CompareText(ID,'fi')=0 then
126     Result:=rsLanguageFinnish
127   else if CompareText(ID,'he')=0 then
128     Result:=rsLanguageHebrew
129   else if CompareText(ID,'ar')=0 then
130     Result:=rsLanguageArabic
131   else if CompareText(ID,'pt_BR')=0 then
132     Result:=rsLanguagePortugueseBr
133 //  else if CompareText(ID,'pt')=0 then
134 //    Result:=rsLanguagePortuguese
135   else if CompareText(ID,'uk')=0 then
136     Result:=rsLanguageUkrainian
137   else if CompareText(ID,'nl')=0 then
138     Result:=rsLanguageDutch
139   else if CompareText(ID,'ja')=0 then
140     Result:=rsLanguageJapanese
141   else if CompareText(ID,'zh_CN')=0 then
142     Result:=rsLanguageChinese
143   else if CompareText(ID,'id')=0 then
144     Result:=rsLanguageIndonesian
145   else if CompareText(ID,'af_ZA')=0 then
146     Result:=rsLanguageAfrikaans
147   else if CompareText(ID,'lt')=0 then
148     Result:=rsLanguageLithuanian
149   else if CompareText(ID,'sk')=0 then
150     Result:=rsLanguageSlovak
151   else if CompareText(ID,'tr')=0 then
152     Result:=rsLanguageTurkish
153   else if CompareText(ID,'cs')=0 then
154     Result:=rsLanguageCzech
155   else if CompareText(ID,'hu')=0 then
156     Result:=rsLanguageHungarian
157   else
158     Result:=ID;
159 end;
160 
161 procedure CollectTranslations(const LazarusDir: string);
162 var
163   FileInfo: TSearchRec;
164   ID: String;
165   SearchMask: String;
166 begin
167   // search for all languages/lazarusidestrconsts.xxx.po files
168   if LazarusTranslations=nil then
169     LazarusTranslations:=TLazarusTranslations.Create
170   else
171     LazarusTranslations.Clear;
172   // add automatic and english translation
173   LazarusTranslations.Add('');
174   LazarusTranslations.Add('en');
175   // search existing translations
176   SearchMask:=AppendPathDelim(LazarusDir)+'languages'+PathDelim+'lazaruside.*.po';
177   //debugln('CollectTranslations ',SearchMask);
178   if FindFirstUTF8(SearchMask,faAnyFile,FileInfo)=0
179   then begin
180     repeat
181       if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='')
182       then continue;
183       ID:=copy(FileInfo.Name,length('lazaruside.')+1,
184                length(FileInfo.Name)-length('lazaruside..po'));
185       //debugln('CollectTranslations A ',FileInfo.Name,' ID=',ID);
186       if (ID<>'') and (Pos('.',ID)<1) and (LazarusTranslations.IndexOf(ID)<0)
187       then begin
188         //debugln('CollectTranslations ID=',ID);
189         LazarusTranslations.Add(ID);
190       end;
191     until FindNextUTF8(FileInfo)<>0;
192   end;
193   FindCloseUTF8(FileInfo);
194 end;
195 
ConvertRSTFilesnull196 function ConvertRSTFiles(RSTDirectory, PODirectory: string; POFilename: string): Boolean;
197 type
198   TItem = record
199     NeedUpdate: boolean;
200     OutputFilename: String;
201     RSTFileList: TStringList;
202   end;
203   PItem = ^TItem;
204 var
205   Items: TFPList; // list of PItem
206   RSTFilename: String;
207   Dir: TCTDirectoryCache;
208   Files: TStrings;
209   i: Integer;
210   Item: PItem;
211   j: Integer;
212   OutputFilename, OtherRSTFilename: String;
213 begin
214   Result:=true;
215   if (RSTDirectory='') or (PODirectory='') then exit;// nothing to do
216   RSTDirectory:=AppendPathDelim(TrimFilename(RSTDirectory));
217   PODirectory:=AppendPathDelim(TrimFilename(PODirectory));
218   if (not FilenameIsAbsolute(PODirectory))
219   or (not DirectoryIsWritableCached(PODirectory)) then begin
220     // only update writable directories
221     DebugLn(['ConvertRSTFiles skipping read only directory ',RSTDirectory]);
222     exit(true);
223   end;
224 
225   // find all .rst/.rsj files in package output directory
226   // TODO: lrt files...
227   PODirectory:=AppendPathDelim(PODirectory);
228 
229   Dir:=CodeToolBoss.DirectoryCachePool.GetCache(RSTDirectory,true,true);
230   Files:=nil;
231   Dir.GetFiles(Files,false);
232   if Files=nil then exit(true);
233   Items:=TFPList.Create;
234   try
235     Item:=nil;
236     // collect all rst/po files that needs update
237     for i:=0 to Files.Count-1 do begin
238       RSTFilename:=RSTDirectory+Files[i];
239       if not FilenameExtIn(RSTFilename,['.rst','.rsj','.lrj']) then
240         continue;
241       if POFilename='' then
242         OutputFilename:=PODirectory+ChangeFileExt(Files[i],'.pot')
243       else
244         OutputFilename:=PODirectory+POFilename;
245       //DebugLn(['ConvertRSTFiles RSTFilename=',RSTFilename,' OutputFilename=',OutputFilename]);
246       Item:=nil;
247       for j:=0 to Items.Count-1 do
248         if CompareFilenames(PItem(Items[j])^.OutputFilename,OutputFilename)=0
249         then begin
250           Item:=PItem(Items[j]);
251           break;
252         end;
253       if (Item=nil) then begin
254         New(Item);
255         Item^.NeedUpdate:=false;
256         Item^.RSTFileList:=TStringList.Create;
257         Item^.OutputFilename:=OutputFilename;
258         Items.Add(Item);
259       end else begin
260         // there is already a source file for this .po file
261         //debugln(['ConvertRSTFiles found another source: ',RSTFilename]);
262         // Already checked earlier.
263         Assert(FilenameExtIn(RSTFilename,['.rst','.rsj','.lrj']), 'ConvertRSTFiles: Wrong Ext');
264         // rsj are created by FPC 2.7.1+, rst by older => use only the newest
265         for j:=Item^.RSTFileList.Count-1 downto 0 do begin
266           OtherRSTFilename:=Item^.RSTFileList[j];
267           //debugln(['ConvertRSTFiles old: ',OtherRSTFilename]);
268           if FilenameExtIn(OtherRSTFilename,['.rsj','.rst','.lrj']) then begin
269             if FileAgeCached(RSTFilename)<=FileAgeCached(OtherRSTFilename) then
270             begin
271               // this one is older => skip
272               //debugln(['ConvertRSTFiles ',RSTFilename,' is older => skip']);
273               RSTFilename:='';
274               break;
275             end else begin
276               // this one is newer
277               //debugln(['ConvertRSTFiles ',RSTFilename,' is newer => ignoring old']);
278               Item^.RSTFileList.Delete(j);
279             end;
280           end;
281         end;
282       end;
283       if RSTFilename='' then continue;
284       Item^.RSTFileList.Add(RSTFilename);
285       if (not Item^.NeedUpdate)
286       or (not FileExistsCached(OutputFilename))
287       or (FileAgeCached(RSTFilename)>FileAgeCached(OutputFilename)) then
288         Item^.NeedUpdate:=true;
289     end;
290     // update rst/po files
291     try
292       for i:=0 to Items.Count-1 do begin
293         Item:=PItem(Items[i]);
294         if (not Item^.NeedUpdate) or (Item^.RSTFileList.Count=0) then continue;
295         UpdatePoFileAndTranslations(Item^.RSTFileList, Item^.OutputFilename);
296       end;
297       Result:=true;
298     except
299       on E: Exception do begin
300         DebugLn(['ConvertRSTFiles.UpdateList OutputFilename="',Item^.OutputFilename,'" ',E.Message]);
301         Result := false;
302       end;
303     end;
304   finally
305     for i:=0 to Items.Count-1 do begin
306       Item:=PItem(Items[i]);
307       Item^.RSTFileList.Free;
308       Dispose(Item);
309     end;
310     Items.Free;
311     Files.Free;
312     Dir.Release;
313   end;
314 end;
315 
316 procedure UpdatePoFileAndTranslations(SrcFiles: TStrings;
317   const POFilename: string);
318 begin
319   UpdatePoFileAndTranslations(SrcFiles, POFilename, False, nil, nil);
320 end;
321 
322 procedure UpdatePoFileAndTranslations(SrcFiles: TStrings;
323   const POFilename: string; ForceUpdatePoFiles: Boolean;
324   ExcludedIdentifiers: TStrings; ExcludedOriginals: TStrings);
325 var
326   BasePOFile: TPOFile;
327   TranslatedFiles: TStringList;
328   TranslatedFilename: String;
329 begin
330   BasePOFile:=nil;
331   // Once we exclude identifiers and originals from the base PO file,
332   // they will be automatically removed in the translated files on update.
333   UpdateBasePoFile(SrcFiles,POFilename,@BasePOFile,
334     ExcludedIdentifiers, ExcludedOriginals);
335   if BasePOFile=nil then exit;
336   TranslatedFiles:=nil;
337   try
338     TranslatedFiles:=FindTranslatedPoFiles(POFilename);
339     if TranslatedFiles=nil then exit;
340     for TranslatedFilename in TranslatedFiles do begin
341       if not ForceUpdatePoFiles then
342         if FileAgeCached(TranslatedFilename)>=FileAgeCached(POFilename) then
343           continue;
344       UpdateTranslatedPoFile(BasePOFile,TranslatedFilename);
345     end;
346   finally
347     TranslatedFiles.Free;
348     BasePOFile.Free;
349   end;
350 end;
351 
352 procedure UpdateBasePoFile(SrcFiles: TStrings;
353   const POFilename: string; POFile: PPOFile);
354 begin
355   UpdateBasePoFile(SrcFiles, POFilename, POFile, nil, nil);
356 end;
357 
358 procedure UpdateBasePoFile(SrcFiles: TStrings;
359   const POFilename: string; POFile: PPOFile;
360   ExcludedIdentifiers: TStrings; ExcludedOriginals: TStrings);
361 var
362   BasePOFile: TPOFile;
363   i: Integer;
364   Filename: String;
365   POBuf: TCodeBuffer;
366   FileType: TStringsType;
367   SrcBuf: TCodeBuffer;
368   SrcLines: TStringList;
369   OldChangeStep: Integer;
370 begin
371   POBuf:=CodeToolBoss.LoadFile(POFilename,true,false);
372   SrcLines:=TStringList.Create;
373   BasePOFile := TPOFile.Create;
374   try
375     if POBuf<>nil then
376       BasePOFile.ReadPOText(POBuf.Source);
377     BasePOFile.Tag:=1;
378     // untagging is done only once for BasePoFile
379     BasePOFile.UntagAll;
380 
381     // Update po file with lrj or/and rst/rsj files
382     for i:=0 to SrcFiles.Count-1 do begin
383       Filename:=SrcFiles[i];
384       if FilenameExtIs(Filename,'lrj') then
385         FileType:=stLrj
386       else if FilenameExtIs(Filename,'rst') then
387         FileType:=stRst
388       else if FilenameExtIs(Filename,'rsj') then
389         FileType:=stRsj
390       else
391         continue;
392       SrcBuf:=CodeToolBoss.LoadFile(Filename,true,false);
393       if SrcBuf=nil then continue;
394       SrcLines.Text:=SrcBuf.Source;
395       BasePOFile.UpdateStrings(SrcLines,FileType);
396     end;
397     // once all rst/rsj/lrj files are processed, remove all unneeded (missing in them) items
398     BasePOFile.RemoveTaggedItems(0);
399 
400     SrcLines.Clear;
401     if Assigned(ExcludedIdentifiers) then
402       BasePOFile.RemoveIdentifiers(ExcludedIdentifiers);
403     if Assigned(ExcludedOriginals) then
404       BasePOFile.RemoveOriginals(ExcludedOriginals);
405     BasePOFile.SaveToStrings(SrcLines);
406     if POBuf=nil then begin
407       POBuf:=CodeToolBoss.CreateFile(POFilename);
408       if POBuf=nil then exit;
409     end;
410     OldChangeStep:=POBuf.ChangeStep;
411     //debugln(['UpdateBasePoFile ',POFilename,' Modified=',POBuf.Source<>SrcLines.Text]);
412     POBuf.Source:=SrcLines.Text;
413     if (not POBuf.IsVirtual) and (OldChangeStep<>POBuf.ChangeStep) then begin
414       debugln(['UpdateBasePoFile saving ',POBuf.Filename]);
415       POBuf.Save;
416     end;
417   finally
418     SrcLines.Free;
419     if POFile<>nil then
420       POFile^:=BasePOFile
421     else
422       BasePOFile.Free;
423   end;
424 end;
425 
FindTranslatedPoFilesnull426 function FindTranslatedPoFiles(const BasePOFilename: string): TStringList;
427 var
428   Path: String;
429   NameOnly: String;
430   Dir: TCTDirectoryCache;
431   Files: TStrings;
432   Filename: String;
433   CurUnitName: String;
434   CurLang: String;
435 begin
436   Result:=TStringList.Create;
437   Path:=ExtractFilePath(BasePOFilename);
438   NameOnly:=ExtractFileNameOnly(BasePOFilename);
439   Dir:=CodeToolBoss.DirectoryCachePool.GetCache(Path);
440   Files:=TStringList.Create;
441   try
442     Dir.GetFiles(Files,false);
443     for Filename in Files do begin
444       if GetPOFilenameParts(Filename, CurUnitName, CurLang) and (NameOnly=CurUnitName) then
445         Result.Add(Path+Filename);
446     end;
447   finally
448     Files.Free;
449     Dir.Release;
450   end;
451 end;
452 
453 procedure UpdateTranslatedPoFile(const BasePOFile: TPOFile;
454   TranslatedFilename: string);
455 var
456   POBuf: TCodeBuffer;
457   POFile: TPOFile;
458   Lines: TStringList;
459   OldChangeStep: Integer;
460 begin
461   POFile := TPOFile.Create;
462   Lines:=TStringList.Create;
463   try
464     POBuf:=CodeToolBoss.LoadFile(TranslatedFilename,true,false);
465     if POBuf<>nil then
466       POFile.ReadPOText(POBuf.Source);
467     POFile.Tag:=1;
468     POFile.UpdateTranslation(BasePOFile);
469     POFile.SaveToStrings(Lines);
470     OldChangeStep:=POBuf.ChangeStep;
471     //debugln(['UpdateTranslatedPoFile ',POBuf.Filename,' Modified=',POBuf.Source<>Lines.Text]);
472     POBuf.Source:=Lines.Text;
473     if (not POBuf.IsVirtual) and (OldChangeStep<>POBuf.ChangeStep) then begin
474       //debugln(['UpdateTranslatedPoFile saving ',POBuf.Filename]);
475       POBuf.Save;
476     end;
477   finally
478     Lines.Free;
479     POFile.Free;
480   end;
481 end;
482 
483 {-------------------------------------------------------------------------------
484   TranslateResourceStrings
485 
486   Params: none
487   Result: none
488 
489   Translates all resourcestrings of the resource string files:
490     - lazarusidestrconsts.pas
491     - gdbmidebugger.pp
492     - debuggerstrconst.pp
493 -------------------------------------------------------------------------------}
494 procedure TranslateResourceStrings(const LazarusDir, CustomLang: string);
495 const
496   Ext = '.%s.po';
497 var
498   Lang, FallbackLang: String;
499   Dir: String;
500 begin
501   if LazarusTranslations=nil then
502     CollectTranslations(LazarusDir);
503   if CustomLang='' then begin
504     Lang:=SystemLanguageID1;
505     FallbackLang:=SystemLanguageID2;
506   end else begin
507     Lang:=CustomLang;
508     FallbackLang:='';
509   end;
510   //debugln('TranslateResourceStrings A Lang=',Lang,' FallbackLang=',FallbackLang);
511   Dir:=AppendPathDelim(LazarusDir);
512   // IDE
513   TranslateUnitResourceStrings('LazarusIDEStrConsts',
514     Dir+'languages/lazaruside'+Ext,Lang,FallbackLang);
515   // Debugger GUI
516   TranslateUnitResourceStrings('DebuggerStrConst',
517     Dir+'languages/debuggerstrconst'+Ext,Lang,FallbackLang);
518   // LCL
519   TranslateUnitResourceStrings('LCLStrConsts',
520     Dir+'lcl/languages/lclstrconsts'+Ext,Lang,FallbackLang);
521 end;
522 
523 { TLazarusTranslations }
524 
TLazarusTranslations.GetItemsnull525 function TLazarusTranslations.GetItems(Index: integer): TLazarusTranslation;
526 begin
527   Result:=FItems[Index];
528 end;
529 
530 destructor TLazarusTranslations.Destroy;
531 begin
532   Clear;
533   inherited Destroy;
534 end;
535 
536 procedure TLazarusTranslations.Add(const ID: string);
537 var
538   NewTranslation: TLazarusTranslation;
539 begin
540   if IndexOf(ID)>=0 then
541     raise Exception.Create('TLazarusTranslations.Add '
542                           +'ID="'+ID+'" already exists.');
543   NewTranslation:=TLazarusTranslation.Create;
544   NewTranslation.FID:=ID;
545   inc(FCount);
546   ReallocMem(FItems,SizeOf(Pointer)*FCount);
547   FItems[FCount-1]:=NewTranslation;
548 end;
549 
IndexOfnull550 function TLazarusTranslations.IndexOf(const ID: string): integer;
551 begin
552   Result:=FCount-1;
553   while (Result>=0) and (CompareText(ID,FItems[Result].ID)<>0) do
554     dec(Result);
555 end;
556 
557 procedure TLazarusTranslations.Clear;
558 var
559   i: Integer;
560 begin
561   for i:=0 to FCount-1 do FItems[i].Free;
562   FCount:=0;
563   ReallocMem(FItems,0);
564 end;
565 
566 initialization
567   LazarusTranslations:=nil;
568   LazGetLanguageIDs(SystemLanguageID1,SystemLanguageID2);
569 
570 finalization
571   FreeAndNil(LazarusTranslations);
572 
573 end.
574 
575