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