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, Ext, OtherExt: 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       Ext:=LowerCase(ExtractFileExt(RSTFilename));
240       if (Ext<>'.rst') and (Ext<>'.rsj') and (Ext<>'.lrj') then
241         continue;
242       if POFilename='' then
243         OutputFilename:=PODirectory+ChangeFileExt(Files[i],'.po')
244       else
245         OutputFilename:=PODirectory+POFilename;
246       //DebugLn(['ConvertRSTFiles RSTFilename=',RSTFilename,' OutputFilename=',OutputFilename]);
247       Item:=nil;
248       for j:=0 to Items.Count-1 do
249         if CompareFilenames(PItem(Items[j])^.OutputFilename,OutputFilename)=0
250         then begin
251           Item:=PItem(Items[j]);
252           break;
253         end;
254       if (Item=nil) then begin
255         New(Item);
256         Item^.NeedUpdate:=false;
257         Item^.RSTFileList:=TStringList.Create;
258         Item^.OutputFilename:=OutputFilename;
259         Items.Add(Item);
260       end else begin
261         // there is already a source file for this .po file
262         //debugln(['ConvertRSTFiles found another source: ',RSTFilename]);
263         if (Ext='.rsj') or (Ext='.rst') or (Ext='.lrj') then begin
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             OtherExt:=LowerCase(ExtractFileExt(OtherRSTFilename));
269             if (OtherExt='.rsj') or (OtherExt='.rst') or (OtherExt='.lrj') then begin
270               if FileAgeCached(RSTFilename)<=FileAgeCached(OtherRSTFilename) then
271               begin
272                 // this one is older => skip
273                 //debugln(['ConvertRSTFiles ',RSTFilename,' is older => skip']);
274                 RSTFilename:='';
275                 break;
276               end else begin
277                 // this one is newer
278                 //debugln(['ConvertRSTFiles ',RSTFilename,' is newer => ignoring old']);
279                 Item^.RSTFileList.Delete(j);
280               end;
281             end;
282           end;
283         end;
284       end;
285       if RSTFilename='' then continue;
286       Item^.RSTFileList.Add(RSTFilename);
287       if (not Item^.NeedUpdate)
288       or (not FileExistsCached(OutputFilename))
289       or (FileAgeCached(RSTFilename)>FileAgeCached(OutputFilename)) then
290         Item^.NeedUpdate:=true;
291     end;
292     // update rst/po files
293     try
294       for i:=0 to Items.Count-1 do begin
295         Item:=PItem(Items[i]);
296         if (not Item^.NeedUpdate) or (Item^.RSTFileList.Count=0) then continue;
297         UpdatePoFileAndTranslations(Item^.RSTFileList, Item^.OutputFilename);
298       end;
299       Result:=true;
300     except
301       on E: Exception do begin
302         DebugLn(['ConvertRSTFiles.UpdateList OutputFilename="',Item^.OutputFilename,'" ',E.Message]);
303         Result := false;
304       end;
305     end;
306   finally
307     for i:=0 to Items.Count-1 do begin
308       Item:=PItem(Items[i]);
309       Item^.RSTFileList.Free;
310       Dispose(Item);
311     end;
312     Items.Free;
313     Files.Free;
314     Dir.Release;
315   end;
316 end;
317 
318 procedure UpdatePoFileAndTranslations(SrcFiles: TStrings;
319   const POFilename: string);
320 begin
321   UpdatePoFileAndTranslations(SrcFiles, POFilename, False, nil, nil);
322 end;
323 
324 procedure UpdatePoFileAndTranslations(SrcFiles: TStrings;
325   const POFilename: string; ForceUpdatePoFiles: Boolean;
326   ExcludedIdentifiers: TStrings; ExcludedOriginals: TStrings);
327 var
328   BasePOFile: TPOFile;
329   TranslatedFiles: TStringList;
330   TranslatedFilename: String;
331 begin
332   BasePOFile:=nil;
333   // Once we exclude identifiers and originals from the base PO file,
334   // they will be automatically removed in the translated files on update.
335   UpdateBasePoFile(SrcFiles,POFilename,@BasePOFile,
336     ExcludedIdentifiers, ExcludedOriginals);
337   if BasePOFile=nil then exit;
338   TranslatedFiles:=nil;
339   try
340     TranslatedFiles:=FindTranslatedPoFiles(POFilename);
341     if TranslatedFiles=nil then exit;
342     for TranslatedFilename in TranslatedFiles do begin
343       if not ForceUpdatePoFiles then
344         if FileAgeCached(TranslatedFilename)>=FileAgeCached(POFilename) then
345           continue;
346       UpdateTranslatedPoFile(BasePOFile,TranslatedFilename);
347     end;
348   finally
349     TranslatedFiles.Free;
350     BasePOFile.Free;
351   end;
352 end;
353 
354 procedure UpdateBasePoFile(SrcFiles: TStrings;
355   const POFilename: string; POFile: PPOFile);
356 begin
357   UpdateBasePoFile(SrcFiles, POFilename, POFile, nil, nil);
358 end;
359 
360 procedure UpdateBasePoFile(SrcFiles: TStrings;
361   const POFilename: string; POFile: PPOFile;
362   ExcludedIdentifiers: TStrings; ExcludedOriginals: TStrings);
363 var
364   BasePOFile: TPOFile;
365   i: Integer;
366   Filename: String;
367   POBuf: TCodeBuffer;
368   FileType: TStringsType;
369   SrcBuf: TCodeBuffer;
370   SrcLines: TStringList;
371   OldChangeStep: Integer;
372 begin
373   POBuf:=CodeToolBoss.LoadFile(POFilename,true,false);
374   SrcLines:=TStringList.Create;
375   BasePOFile := TPOFile.Create;
376   try
377     if POBuf<>nil then
378       BasePOFile.ReadPOText(POBuf.Source);
379     BasePOFile.Tag:=1;
380     // untagging is done only once for BasePoFile
381     BasePOFile.UntagAll;
382 
383     // Update po file with lrj or/and rst/rsj files
384     for i:=0 to SrcFiles.Count-1 do begin
385       Filename:=SrcFiles[i];
386       if CompareFileExt(Filename,'.lrj',false)=0 then
387         FileType:=stLrj
388       else if CompareFileExt(Filename,'.rst',false)=0 then
389         FileType:=stRst
390       else if CompareFileExt(Filename,'.rsj',false)=0 then
391         FileType:=stRsj
392       else
393         continue;
394       SrcBuf:=CodeToolBoss.LoadFile(Filename,true,false);
395       if SrcBuf=nil then continue;
396       SrcLines.Text:=SrcBuf.Source;
397       BasePOFile.UpdateStrings(SrcLines,FileType);
398     end;
399     // once all rst/rsj/lrj files are processed, remove all unneeded (missing in them) items
400     BasePOFile.RemoveTaggedItems(0);
401 
402     SrcLines.Clear;
403     if Assigned(ExcludedIdentifiers) then
404       BasePOFile.RemoveIdentifiers(ExcludedIdentifiers);
405     if Assigned(ExcludedOriginals) then
406       BasePOFile.RemoveOriginals(ExcludedOriginals);
407     BasePOFile.SaveToStrings(SrcLines);
408     if POBuf=nil then begin
409       POBuf:=CodeToolBoss.CreateFile(POFilename);
410       if POBuf=nil then exit;
411     end;
412     OldChangeStep:=POBuf.ChangeStep;
413     //debugln(['UpdateBasePoFile ',POFilename,' Modified=',POBuf.Source<>SrcLines.Text]);
414     POBuf.Source:=SrcLines.Text;
415     if (not POBuf.IsVirtual) and (OldChangeStep<>POBuf.ChangeStep) then begin
416       debugln(['UpdateBasePoFile saving ',POBuf.Filename]);
417       POBuf.Save;
418     end;
419   finally
420     SrcLines.Free;
421     if POFile<>nil then
422       POFile^:=BasePOFile
423     else
424       BasePOFile.Free;
425   end;
426 end;
427 
FindTranslatedPoFilesnull428 function FindTranslatedPoFiles(const BasePOFilename: string): TStringList;
429 var
430   Path: String;
431   Name: String;
432   NameOnly: String;
433   Dir: TCTDirectoryCache;
434   Files: TStrings;
435   Filename: String;
436 begin
437   Result:=TStringList.Create;
438   Path:=ExtractFilePath(BasePOFilename);
439   Name:=ExtractFileName(BasePOFilename);
440   NameOnly:=ExtractFileNameOnly(Name);
441   Dir:=CodeToolBoss.DirectoryCachePool.GetCache(Path);
442   Files:=TStringList.Create;
443   try
444     Dir.GetFiles(Files,false);
445     for Filename in Files do begin
446       if CompareFilenames(Filename,Name)=0 then continue;
447       if CompareFileExt(Filename,'.po',false)<>0 then continue;
448       //skip files which names don't have form 'nameonly.foo.po', e.g. 'nameonlyfoo.po'
449       if (CompareFilenames(LeftStr(Filename,length(NameOnly)+1),NameOnly+'.')<>0)
450       then
451         continue;
452       Result.Add(Path+Filename);
453     end;
454   finally
455     Files.Free;
456     Dir.Release;
457   end;
458 end;
459 
460 procedure UpdateTranslatedPoFile(const BasePOFile: TPOFile;
461   TranslatedFilename: string);
462 var
463   POBuf: TCodeBuffer;
464   POFile: TPOFile;
465   Lines: TStringList;
466   OldChangeStep: Integer;
467 begin
468   POFile := TPOFile.Create;
469   Lines:=TStringList.Create;
470   try
471     POBuf:=CodeToolBoss.LoadFile(TranslatedFilename,true,false);
472     if POBuf<>nil then
473       POFile.ReadPOText(POBuf.Source);
474     POFile.Tag:=1;
475     POFile.UpdateTranslation(BasePOFile);
476     POFile.SaveToStrings(Lines);
477     OldChangeStep:=POBuf.ChangeStep;
478     //debugln(['UpdateTranslatedPoFile ',POBuf.Filename,' Modified=',POBuf.Source<>Lines.Text]);
479     POBuf.Source:=Lines.Text;
480     if (not POBuf.IsVirtual) and (OldChangeStep<>POBuf.ChangeStep) then begin
481       //debugln(['UpdateTranslatedPoFile saving ',POBuf.Filename]);
482       POBuf.Save;
483     end;
484   finally
485     Lines.Free;
486     POFile.Free;
487   end;
488 end;
489 
490 {-------------------------------------------------------------------------------
491   TranslateResourceStrings
492 
493   Params: none
494   Result: none
495 
496   Translates all resourcestrings of the resource string files:
497     - lazarusidestrconsts.pas
498     - gdbmidebugger.pp
499     - debuggerstrconst.pp
500 -------------------------------------------------------------------------------}
501 procedure TranslateResourceStrings(const LazarusDir, CustomLang: string);
502 const
503   Ext = '.%s.po';
504 var
505   Lang, FallbackLang: String;
506   Dir: String;
507 begin
508   if LazarusTranslations=nil then
509     CollectTranslations(LazarusDir);
510   if CustomLang='' then begin
511     Lang:=SystemLanguageID1;
512     FallbackLang:=SystemLanguageID2;
513   end else begin
514     Lang:=CustomLang;
515     FallbackLang:='';
516   end;
517   //debugln('TranslateResourceStrings A Lang=',Lang,' FallbackLang=',FallbackLang);
518   Dir:=AppendPathDelim(LazarusDir);
519   // IDE
520   TranslateUnitResourceStrings('LazarusIDEStrConsts',
521     Dir+'languages/lazaruside'+Ext,Lang,FallbackLang);
522   // Debugger GUI
523   TranslateUnitResourceStrings('DebuggerStrConst',
524     Dir+'languages/debuggerstrconst'+Ext,Lang,FallbackLang);
525   // LCL
526   TranslateUnitResourceStrings('LCLStrConsts',
527     Dir+'lcl/languages/lclstrconsts'+Ext,Lang,FallbackLang);
528 end;
529 
530 { TLazarusTranslations }
531 
GetItemsnull532 function TLazarusTranslations.GetItems(Index: integer): TLazarusTranslation;
533 begin
534   Result:=FItems[Index];
535 end;
536 
537 destructor TLazarusTranslations.Destroy;
538 begin
539   Clear;
540   inherited Destroy;
541 end;
542 
543 procedure TLazarusTranslations.Add(const ID: string);
544 var
545   NewTranslation: TLazarusTranslation;
546 begin
547   if IndexOf(ID)>=0 then
548     raise Exception.Create('TLazarusTranslations.Add '
549                           +'ID="'+ID+'" already exists.');
550   NewTranslation:=TLazarusTranslation.Create;
551   NewTranslation.FID:=ID;
552   inc(FCount);
553   ReallocMem(FItems,SizeOf(Pointer)*FCount);
554   FItems[FCount-1]:=NewTranslation;
555 end;
556 
IndexOfnull557 function TLazarusTranslations.IndexOf(const ID: string): integer;
558 begin
559   Result:=FCount-1;
560   while (Result>=0) and (CompareText(ID,FItems[Result].ID)<>0) do
561     dec(Result);
562 end;
563 
564 procedure TLazarusTranslations.Clear;
565 var
566   i: Integer;
567 begin
568   for i:=0 to FCount-1 do FItems[i].Free;
569   FCount:=0;
570   ReallocMem(FItems,0);
571 end;
572 
573 initialization
574   LazarusTranslations:=nil;
575   LazGetLanguageIDs(SystemLanguageID1,SystemLanguageID2);
576 
577 finalization
578   FreeAndNil(LazarusTranslations);
579 
580 end.
581 
582