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