paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 04:18:48 +02:00
Code Issues Packages Projects Releases Wiki Activity

PoChecker: implement some strategies to find languagefiles for pochecker application (Stand Alone version only).

Browse Source 
git-svn-id: trunk@46562 -
This commit is contained in:
bart 2014-10-15 14:47:49 +00:00
parent c8ff5d66b9
commit e3d93cbfbd
2 changed files with 156 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

102
components/pochecker/pocheckermain.pp
View File

@ -80,13 +80,15 @@ type
procedure AddToMasterPoList(Fn: String);
procedure AddToMasterPoList(S: TStrings);
procedure SetSelectedMasterFiles(S: TStrings);
procedure LoadConfig;
procedure ApplyConfig;
procedure SaveConfig;
function LangFilterIndexToLangID(Index: Integer): TLangID;
function LangIdToLangFilterIndex(LangID: TLangID): Integer;
procedure PopulateLangFilter;
{$IFDEF POCHECKERSTANDALONE}
procedure GetTranslations;
function GetTranslationsSearchPath: String;
procedure FindTranslationFiles(const SearchPath, Lang: String; out PoCheckPo, LclPo: String);
{$ENDIF}
procedure ApplyTranslations;
published
@ -132,6 +134,8 @@ end;
procedure TPoCheckerForm.FormCreate(Sender: TObject);
begin
FPoCheckerSettings := TPoCheckerSettings.Create;
FPoCheckerSettings.LoadConfig;
//debugln('TPoCheckerForm.FormCreate A:');
{$IFDEF POCHECKERSTANDALONE}
//Initializing translation
@ -142,7 +146,7 @@ begin
ClearStatusBar;
NoErrLabel.Visible := False;
PopulateLangFilter;
LoadConfig;
ApplyConfig;
LangFilter.Invalidate; //Items[0] may have been changed
end;
@ -674,14 +678,12 @@ begin
end;
procedure TPoCheckerForm.LoadConfig;
procedure TPoCheckerForm.ApplyConfig;
var
ARect: TRect;
Abbr: String;
ID: TLangID;
begin
FPoCheckerSettings := TPoCheckerSettings.Create;
FPoCheckerSettings.LoadConfig;
ARect := FPoCheckerSettings.MainFormGeometry;
if not IsDefaultRect(ARect) and IsValidRect(ARect) then
begin
@ -800,9 +802,75 @@ begin
end;
{$IFDEF POCHECKERSTANDALONE}
function TPoCheckerForm.GetTranslationsSearchPath: String;
var
EnvVar, CfgLocal, CfgGlobal, AppPath: String;
begin
Result := FPoCheckerSettings.LangPath;
EnvVar := GetEnvironmentVariableUtf8('pochecker-langpath');
if (EnvVar <> '') then
Result := Result + PathSeparator + EnvVar;
Result := Result + PathSeparator + '.';
//Make some educated guesses
//default Lazarus setup, launching the app from project output dir
Result := Result + PathSeparator + '..' + PathDelim + 'languages';
Result := Result + PathSeparator + SetDirSeparators('../../../lcl/languages');
//or from where .lpi resides
Result := Result + PathSeparator + '.' + PathDelim + 'languages';
Result := Result + PathSeparator + SetDirSeparators('../../lcl/languages');
//Look in standard config dirs
CfgLocal := AppendPathDelim(GetLocalConfigPath);
CfgGlobal := AppendPathDelim(GetGlobalConfigPath);
Result := Result + PathSeparator + CfgLocal + PathSeparator + CfgLocal + 'languages';
Result := Result + PathSeparator + CfgGlobal + PathSeparator + CfgGlobal + 'languages';
{$if defined(windows) and not defined(wince)}
AppPath := ExtractFilePath(ParamStr(0));
Result := Result + PathSeparator + AppPath + PathSeparator + AppPath + 'languages';
{$endif}
end;
procedure TPoCheckerForm.FindTranslationFiles(const SearchPath, Lang: String; out PoCheckPo, LclPo: String);
var
SL: TStringList;
i: Integer;
LclPoFnOnly, PoCheckPoFnOnly, Path: String;
begin
PoCheckPo := '';
LclPo := '';
PoCheckPoFnOnly := Format('pocheckerconsts.%s.po',[Lang]);
LclPoFnOnly := Format('lclstrconsts.%s.po',[Lang]);
//debugln('PoCheckPoFnOnly = "',PoCheckPoFnOnly,'"');
//debugln('LclPoFnOnly" = ',LclPoFnOnly,'"');
SL := TStringList.Create;
try
SL.StrictDelimiter := True;
SL.Delimiter := PathSeparator;
SL.DelimitedText := SearchPath;
for i := 0 to SL.Count - 1 do
begin
Path := SL.Strings[i];
if (Path <> '') then
begin
//debugln('Path = ',ExpandFileNameUtf8(Path));
if (Path <> '') then
Path := AppendPathDelim(Path);
if (LclPo = '') and FileExistsUtf8(Path + PoCheckPoFnOnly) then
PoCheckPo := Path + PoCheckPoFnOnly;
if (LclPo = '') and FileExistsUtf8(Path + LclPoFnOnly) then
LclPo := Path + LclPoFnOnly;
end;
if (LclPo <> '') and (LclPo <> '') then
Break;
end;
finally
SL.Free;
end;
end;
procedure TPoCheckerForm.GetTranslations;
var
Lang, T, AppPath: string;
Lang, T, SearchPath, PoCheckerPo, LclPo: string;
begin
Lang := GetEnvironmentVariableUTF8('LANG');
T := '';
@ -810,19 +878,15 @@ begin
LCLGetLanguageIDs(Lang, T);
if Lang <> '' then
begin
{$ifdef windows}
AppPath := ExtractFilePath(ParamStr(0));
{$else}
AppPath := '';
{$endif}
Lang := copy(Lang, 1, 2);
Translations.TranslateUnitResourceStrings('PoCheckerConsts',
AppPath + '..' + DirectorySeparator + 'languages' + DirectorySeparator +
'pocheckerconsts.' + Lang + '.po');
//requires the user copies the LCLStrConsts translations there!
Translations.TranslateUnitResourceStrings('LCLStrConsts',
AppPath + '..' + DirectorySeparator + 'languages' + DirectorySeparator +
'lclstrconsts.' + Lang + '.po');
//debugln('TPoCheckerForm.GetTranslations: Lang = ',Lang);
if not ((Lang = 'af_ZA') or (Lang = 'pt_BR') or (Lang = 'zh_CN')) then
Lang := copy(Lang, 1, 2);
SearchPath := GetTranslationsSearchPath;
FindTranslationFiles(SearchPath, Lang, PoCheckerPo, LclPo);
//debugln('PoCheckerPo = "',PoCheckerPo,'"');
//debugln('LclPo = "',LclPo,'"');
Translations.TranslateUnitResourceStrings('PoCheckerConsts', PoCheckerPo);
Translations.TranslateUnitResourceStrings('LCLStrConsts', LclPo);
end;
end;
{$ENDIF}

75
components/pochecker/pocheckersettings.pp
View File

@ -24,6 +24,7 @@ type
FFilename: String;
FGraphFormWindowState: TWindowState;
FLangFilterLanguageAbbr: String;
FLangPath: String;
FMainFormWindowState: TWindowState;
FOpenDialogFilename: String;
FResultsFormWindowState: TWindowState;
@ -44,6 +45,7 @@ type
function LoadSelectDirectoryFilename: String;
function LoadOpenDialogFilename: String;
function LoadLangFilterLanguageAbbr: String;
function LoadLangPath: String;
procedure LoadMasterPoList(List: TStrings);
procedure LoadMasterPoSelList(List: TStrings);
procedure SaveTestTypes;
@ -53,6 +55,7 @@ type
procedure SaveSelectDirectoryFilename;
procedure SaveOpenDialogFilename;
procedure SaveLangFilterLanguageAbbr;
procedure SaveLangPath;
procedure SaveMasterPoList;
procedure SaveMasterPoSelList;
procedure RemoveUnwantedPaths;
@ -81,6 +84,7 @@ type
property ResultsFormWindowState: TWindowState read FResultsFormWindowState write FResultsFormWindowState;
property GraphFormWindowState: TWindowState read FGraphFormWindowState write FGraphFormWindowState;
property LangFilterLanguageAbbr: String read FLangFilterLanguageAbbr write FLangFilterLanguageAbbr;
property LangPath: String read FLangPath write FLangPath;
end;
function DbgS(PoTestTypes: TPoTestTypes): String; overload;
@ -88,6 +92,8 @@ function DbgS(PoTestOpts: TPoTestOptions): String; overload;
function FitToRect(const ARect, FitIn: TRect): TRect;
function IsDefaultRect(ARect: TRect): Boolean;
function IsValidRect(ARect: TRect): Boolean;
function GetGlobalConfigPath: String;
function GetLocalConfigPath: String;
implementation
@ -153,6 +159,7 @@ const
pSelectDirectoryFilename = 'SelectDirectoryFilename/';
pOpenDialogFilename = 'OpenDialogFilename/';
pLangFilter = 'LanguageFilter/';
pLangPath = 'LanguageFiles/';
pTestTypes = 'TestTypes/';
pTestOptions = 'TestOptions/';
pWindowsGeometry = 'General/WindowsGeometry/';
@ -203,7 +210,22 @@ begin
Result := '';
end;
function GetAndCreateConfigPath: String;
function GetGlobalConfigPath: String;
var
OldOnGetApplicationName: TGetAppNameEvent;
OldOnGetVendorName: TGetVendorNameEvent;
begin
Result := '';
OldOnGetApplicationName := OnGetApplicationName;
OldOnGetVendorName := OnGetVendorName;
OnGetApplicationName := @AppName;
OnGetVendorName := @Vendor;
Result := GetAppConfigDirUtf8(True);
OnGetApplicationName := OldOnGetApplicationName;
OnGetVendorName := OldOnGetVendorName;
end;
function GetLocalConfigPath: String;
var
OldOnGetApplicationName: TGetAppNameEvent;
OldOnGetVendorName: TGetVendorNameEvent;
@ -219,10 +241,15 @@ begin
OldOnGetVendorName := OnGetVendorName;
OnGetApplicationName := @AppName;
OnGetVendorName := @Vendor;
Result := GetAppConfigDirUtf8(False);
OnGetApplicationName := OldOnGetApplicationName;
OnGetVendorName := OldOnGetVendorName;
Result := GetAppConfigDirUtf8(False);
end;
end;
function GetAndCreateConfigPath: String;
begin
Result := GetLocalConfigPath;
if not ForceDirectoriesUTF8(Result) then
Debugln('GetAndCreateConfigPath: unable to create "',Result,'"');
end;
@ -316,6 +343,43 @@ begin
Result := FConfig.GetValue(pLangFilter + 'Value', '');
end;
function TPoCheckerSettings.LoadLangPath: String;
var
SL: TStringList;
i: Integer;
S: String;
begin
{$IFDEF POCHECKERSTANDALONE}
//allow override on commandline
if Application.HasOption('langpath') then
begin
Result := '';
SL := TStringList.Create;
try
SL.Delimiter := PathSeparator;
SL.StrictDelimiter := True;
SL.DelimitedText := Application.GetOptionValue('langpath');
for i := 0 to SL.Count - 1 do
begin
S := SL.Strings[i];
if (S <> '') then
begin
Result := Result + ExpandFileNameUtf8(S) + PathSeparator;
end;
end;
if (Result <> '') and (Result[Length(Result)] = PathSeparator) then
System.Delete(Result, Length(Result), 1);
finally
SL.Free;
end;
end
else
Result := FConfig.GetValue(pLangPath+'Value','');
{$ELSE}
Result := '';
{$eNDIF}
end;
procedure TPoCheckerSettings.LoadMasterPoList(List: TStrings);
var
@ -428,6 +492,11 @@ begin
FConfig.SetDeleteValue(pLangFilter + 'Value', FLangFilterLanguageAbbr, '');
end;
procedure TPoCheckerSettings.SaveLangPath;
begin
FConfig.SetDeleteValue(pLangPath + 'Value', FLangPath, '');
end;
procedure TPoCheckerSettings.RemoveUnwantedPaths;
const
pLoadSettings = 'General/LoadSettings/';
@ -518,6 +587,7 @@ begin
FOpenDialogFilename := LoadOpenDialogFilename;
FExternalEditorName := LoadExternalEditorName;
FLangFilterLanguageAbbr := LoadLangFilterLanguageAbbr;
FLangPath := LoadLangPath;
LoadWindowsGeometry;
LoadMasterPoList(FMasterPoList);
LoadMasterPoSelList(FMasterPoSelList);
@ -541,6 +611,7 @@ begin
SaveSelectDirectoryFilename;
SaveOpenDialogFilename;
SaveLangFilterLanguageAbbr;
SaveLangPath;
SaveWindowsGeometry;
SaveMasterPoList;
SaveMasterPoSelList;