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

git-svn-id: trunk@46562 -

components/pochecker/pocheckermain.pp

@@ -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}
+    //debugln('TPoCheckerForm.GetTranslations: Lang = ',Lang);
-    AppPath := ExtractFilePath(ParamStr(0));
+    if not ((Lang = 'af_ZA') or (Lang = 'pt_BR') or (Lang = 'zh_CN')) then
-    {$else}
-    AppPath := '';
-    {$endif}
       Lang := copy(Lang, 1, 2);
-    Translations.TranslateUnitResourceStrings('PoCheckerConsts',
+    SearchPath := GetTranslationsSearchPath;
-      AppPath + '..' + DirectorySeparator + 'languages' + DirectorySeparator +
+    FindTranslationFiles(SearchPath, Lang, PoCheckerPo, LclPo);
-      'pocheckerconsts.' + Lang + '.po');
+    //debugln('PoCheckerPo = "',PoCheckerPo,'"');
-    //requires the user copies the LCLStrConsts translations there!
+    //debugln('LclPo = "',LclPo,'"');
-    Translations.TranslateUnitResourceStrings('LCLStrConsts',
+    Translations.TranslateUnitResourceStrings('PoCheckerConsts', PoCheckerPo);
-      AppPath + '..' + DirectorySeparator + 'languages' + DirectorySeparator +
+    Translations.TranslateUnitResourceStrings('LCLStrConsts', LclPo);
-      'lclstrconsts.' + Lang + '.po');
   end;
 end;
 {$ENDIF}

components/pochecker/pocheckersettings.pp

@@ -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;