From 12755f715ccf4ab0690a257caaefb5de1e754223 Mon Sep 17 00:00:00 2001 From: bart <9132501-flyingsheep@users.noreply.gitlab.com> Date: Sun, 21 Sep 2014 14:48:38 +0000 Subject: [PATCH] PoChecker: starts implementing TPoCheckerSettings. git-svn-id: trunk@46273 - --- .gitattributes | 2 + components/pochecker/Proj/pochecker.lpi | 10 +- components/pochecker/Proj/pochecker.lpr | 2 +- components/pochecker/pochecker.lpk | 10 +- components/pochecker/pochecker.pas | 2 +- components/pochecker/pocheckermain.pp | 73 ++++-- components/pochecker/pocheckersettings.pp | 292 +++++++++++++++++++++ components/pochecker/pocheckerxmlconfig.pp | 186 +++++++++++++ 8 files changed, 557 insertions(+), 20 deletions(-) create mode 100644 components/pochecker/pocheckersettings.pp create mode 100644 components/pochecker/pocheckerxmlconfig.pp diff --git a/.gitattributes b/.gitattributes index b0dc3552b8..1758fb8f3f 100644 --- a/.gitattributes +++ b/.gitattributes @@ -2926,6 +2926,8 @@ components/pochecker/pochecker.pas svneol=native#text/plain components/pochecker/pocheckerconsts.pas svneol=native#text/pascal components/pochecker/pocheckermain.lfm svneol=native#text/plain components/pochecker/pocheckermain.pp svneol=native#text/plain +components/pochecker/pocheckersettings.pp svneol=native#text/pascal +components/pochecker/pocheckerxmlconfig.pp svneol=native#text/pascal components/pochecker/pofamilies.pp svneol=native#text/plain components/pochecker/resultdlg.lfm svneol=native#text/plain components/pochecker/resultdlg.pp svneol=native#text/plain diff --git a/components/pochecker/Proj/pochecker.lpi b/components/pochecker/Proj/pochecker.lpi index 4247f577b4..b32545b302 100644 --- a/components/pochecker/Proj/pochecker.lpi +++ b/components/pochecker/Proj/pochecker.lpi @@ -69,7 +69,7 @@ - + @@ -77,6 +77,7 @@ + @@ -89,10 +90,12 @@ + + @@ -110,6 +113,11 @@ + + + + + diff --git a/components/pochecker/Proj/pochecker.lpr b/components/pochecker/Proj/pochecker.lpr index a09c1aac1b..13c2660546 100644 --- a/components/pochecker/Proj/pochecker.lpr +++ b/components/pochecker/Proj/pochecker.lpr @@ -8,7 +8,7 @@ uses {$ENDIF}{$ENDIF} Interfaces, // this includes the LCL widgetset Forms, pocheckermain, pofamilies, resultdlg, simplepofiles, pocheckerconsts, - graphstat; + graphstat, pocheckersettings; {$R *.res} diff --git a/components/pochecker/pochecker.lpk b/components/pochecker/pochecker.lpk index f55434db01..b81bca29d5 100644 --- a/components/pochecker/pochecker.lpk +++ b/components/pochecker/pochecker.lpk @@ -16,7 +16,7 @@ - + @@ -54,6 +54,14 @@ + + + + + + + + diff --git a/components/pochecker/pochecker.pas b/components/pochecker/pochecker.pas index 18ff5f47d4..9beb313d9a 100644 --- a/components/pochecker/pochecker.pas +++ b/components/pochecker/pochecker.pas @@ -8,7 +8,7 @@ interface uses ResultDlg, PoFamilies, pocheckermain, SimplePoFiles, pocheckerconsts, - GraphStat, LazarusPackageIntf; + GraphStat, PoCheckerSettings, PoCheckerXMLConfig, LazarusPackageIntf; implementation diff --git a/components/pochecker/pocheckermain.pp b/components/pochecker/pocheckermain.pp index f96c4bfbe1..df95b130b0 100644 --- a/components/pochecker/pocheckermain.pp +++ b/components/pochecker/pocheckermain.pp @@ -31,13 +31,30 @@ uses {$ELSE} IDEIntf, MenuIntf, {$ENDIF} - SimplePoFiles, PoFamilies, ResultDlg, pocheckerconsts; + SimplePoFiles, PoFamilies, ResultDlg, pocheckerconsts, PoCheckerSettings; type { TPoCheckerForm } TPoCheckerForm = class(TForm) + private + PoFamily: TPoFamily; + FChosenMasterName: string; + FChosenChildName: string; + FPoCheckerSettings: TPoCheckerSettings; + procedure OnTestStart(const ATestName, APoFileName: string); + procedure OnTestEnd(const ATestName: string; const ErrorCount: integer); + procedure FillTestListBox; + function GetTestTypesFromListBox: TPoTestTypes; + function GetTestOptions: TPoTestOptions; + procedure SetTestTypeCheckBoxes(TestTypes: TPoTestTypes); + procedure SetTestOptionCheckBoxes(TestOptions: TPoTestOptions); + procedure ShowError(const Msg: string); + function TrySelectFile: boolean; + procedure RunSelectedTests; + procedure ClearAndDisableStatusPanel; + published IgnoreFuzzyCheckBox: TCheckBox; UnselectAllBtn: TButton; SelectAllBtn: TButton; @@ -62,21 +79,6 @@ type procedure SelectAllBtnClick(Sender: TObject); procedure SelectBasicBtnClick(Sender: TObject); procedure UnselectAllBtnClick(Sender: TObject); - private - PoFamily: TPoFamily; - FChosenMasterName: string; - FChosenChildName: string; - procedure OnTestStart(const ATestName, APoFileName: string); - procedure OnTestEnd(const ATestName: string; const ErrorCount: integer); - procedure FillTestListBox; - function GetTestTypesFromListBox: TPoTestTypes; - function GetTestOptions: TPoTestOptions; - procedure ShowError(const Msg: string); - function TrySelectFile: boolean; - procedure RunSelectedTests; - procedure ClearAndDisableStatusPanel; - public - end; var @@ -104,6 +106,7 @@ var Lang, T: string; {$ENDIF} begin + //debugln('TPoCheckerForm.FormCreate A:'); {$IFDEF POCHECKERSTANDALONE} //Initializing translation Lang := GetEnvironmentVariableUTF8('LANG'); @@ -137,6 +140,15 @@ begin SelectAllBtn.Caption := sSelectAllTests; SelectBasicBtn.Caption := sSelectBasicTests; UnselectAllBtn.Caption := sUnselectAllTests; + FPoCheckerSettings := TPoCheckerSettings.Create; + FPoCheckerSettings.LoadConfig; + //DebugLn(' TestOptions after loading = '); + //DebugLn(' ',DbgS(FPoCheckerSettings.TestOptions)); + //debugln(' TPoCheckerForm.FormCreate: TestTypes after loading = '); + //DebugLn(' ',DbgS(FPoCheckerSettings.TestTypes)); + SetTestTypeCheckBoxes(FPoCheckerSettings.TestTypes); + SetTestOptionCheckBoxes(FPoCheckerSettings.TestOptions); + end; @@ -144,6 +156,14 @@ procedure TPoCheckerForm.FormDestroy(Sender: TObject); begin if Assigned(PoFamily) then PoFamily.Free; + if Assigned(FPoCheckerSettings) then + begin + FPoCheckerSettings.SaveSettingsOnExit := True; //ToDo: create a checkbox for this + FPoCheckerSettings.TestTypes := GetTestTypesFromListBox; + FPoCheckerSettings.TestOptions := GetTestOptions; + FPoCheckerSettings.SaveConfig; + FPoCheckerSettings.Free; + end; end; @@ -262,6 +282,27 @@ begin Result := Result + [ptoIgnoreFuzzyStrings]; end; +procedure TPoCheckerForm.SetTestTypeCheckBoxes(TestTypes: TPoTestTypes); +var + Typ: TPoTestType; + Index: integer; +begin + for Typ := Low(TPoTestType) to High(TPoTestType) do + begin + Index := Ord(Typ); + if (Index < TestListBox.Count) then + begin + TestListBox.Checked[Index] := (Typ in TestTypes) + end; + end; +end; + +procedure TPoCheckerForm.SetTestOptionCheckBoxes(TestOptions: TPoTestOptions); +begin + FindAllPOsCheckBox.Checked := (ptoFindAllChildren in TestOptions); + IgnoreFuzzyCheckBox.Checked := (ptoIgnoreFuzzyStrings in TestOptions); +end; + procedure TPoCheckerForm.ShowError(const Msg: string); begin diff --git a/components/pochecker/pocheckersettings.pp b/components/pochecker/pocheckersettings.pp new file mode 100644 index 0000000000..f18f1fefc9 --- /dev/null +++ b/components/pochecker/pocheckersettings.pp @@ -0,0 +1,292 @@ +unit PoCheckerSettings; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LazConfigStorage, + {$ifdef POCHECKERSTANDALONE} + PoCheckerXMLConfig, Forms, + {$else} + BaseIDEIntf, + {$endif} + PoFamilies, LCLProc, LazFileUtils; + +type + + { TPoCheckerSettings } + + TPoCheckerSettings = class + private + FConfig: TConfigStorage; + FFilename: String; + FTestTypes: TPoTestTypes; + FTestOptions: TPoTestOptions; + FLoadSettings: Boolean; + FSaveSettingsOnExit: Boolean; + FMasterPoList: TStrings; + FChildrenPoList: TStrings; + function LoadTestTypes: TPoTestTypes; + function LoadTestOptions: TPoTestOptions; + procedure LoadMasterPoList(List: TStrings); + procedure LoadChildrenPoList(List: TStrings); + procedure SaveTestTypes; + procedure SaveTestOptions; + procedure SaveMasterPoList; + procedure SaveChildrenPoList; + + public + constructor Create; + destructor Destroy; override; + + procedure LoadConfig; + procedure SaveConfig; + + property Filename: String read FFilename; + property SaveSettingsOnExit: Boolean read FSaveSettingsOnExit write FSaveSettingsOnExit; + property TestTypes: TPoTestTypes read FTestTypes write FTestTypes; + property TestOptions: TPoTestOptions read FTestOptions write FTestOptions; + property MasterPoList: TStrings read FMasterPoList write FMasterPoList; + property ChildrenPoList: TStrings read FChildrenPoList write FChildrenPoList; + end; + +function DbgS(PoTestTypes: TPoTestTypes): String; overload; +function DbgS(PoTestOpts: TPoTestOptions): String; overload; + +implementation + +{ TPoCheckerSettings } +{$ifdef pocheckerstandalone} +function AppName: String; +begin + Result := 'pochecker'; +end; + +function Vendor: String; +begin + Result := ''; +end; + +function GetConfigPath: String; +var + OldOnGetApplicationName: TGetAppNameEvent; + OldOnGetVendorName: TGetVendorNameEvent; +begin + Result := ''; + if Application.HasOption('primary-config-path') then + Result := ExpandFileNameUtf8(Application.GetOptionValue('primary-config-path')) + else if Application.HasOption('pcp') then + Result := ExpandFileNameUtf8(Application.GetOptionValue('pcp')) + else + begin + OldOnGetApplicationName := OnGetApplicationName; + OldOnGetVendorName := OnGetVendorName; + OnGetApplicationName := @AppName; + OnGetVendorName := @Vendor; + OnGetApplicationName := OldOnGetApplicationName; + OnGetVendorName := OldOnGetVendorName; + Result := GetAppConfigDirUtf8(False); + end; +end; + +{$endif} + +const + TestTypeNames: array[TPoTestType] of String = ( + 'CheckNumberOfItems', + 'CheckForIncompatibleFormatArguments', + 'CheckMissingIdentifiers', + 'CheckForMismatchesInUntranslatedStrings', + 'CheckForDuplicateUntranslatedValues', + 'CheckStatistics' + ); + TestoptionNames: array[TPoTestOption] of String = ( + 'FindAllChildren', + 'IgnoreFuzzyStrings' + ); + + pLoadSettings = 'General/LoadSettings/'; + pTestTypes = 'TestTypes/'; + pTestOptions = 'TestOptions/'; + pMasterPoFiles = 'MasterPoFiles'; + pChildrenPoFiles = 'ChildrenPoFiles'; + +function DbgS(PoTestTypes: TPoTestTypes): String; overload; +var + Typ: TPoTestType; +begin + Result := '['; + for Typ := Low(TPotestType) to High(TPoTesttype) do + begin + if (Typ in PoTestTypes) then Result := Result + TestTypeNames[Typ]; + end; + if (Result[Length(Result)] = ',') then System.Delete(Result,Length(Result),1); + Result := Result + ']'; +end; + +function DbgS(PoTestOpts: TPoTestOptions): String; overload; +var + Opt: TPoTestOption; +begin + Result := '['; + for Opt := Low(TPotestOption) to High(TPoTestOption) do + begin + if (Opt in PoTestOpts) then Result := Result + TestOptionNames[opt]; + end; + if (Result[Length(Result)] = ',') then System.Delete(Result,Length(Result),1); + Result := Result + ']'; +end; + +function TPoCheckerSettings.LoadTestTypes: TPoTestTypes; +var + tt: TPoTestType; + Name: String; + B: Boolean; +begin + Result := []; + for tt := Low(TPoTestType) to High(TPoTestType) do + begin + Name := TestTypeNames[tt]; + B := FConfig.GetValue(pTestTypes + Name + '/Value',False); + if B then Result := Result + [tt]; + end; +end; + +function TPoCheckerSettings.LoadTestOptions: TPoTestOptions; +var + opt: TPoTestOption; + Name: String; + B: Boolean; +begin + Result := []; + for opt := Low(TPoTestOption) to High(TPoTestOption) do + begin + Name := TestOptionNames[opt]; + B := FConfig.GetValue(pTestOptions + Name + '/Value',False); + if B then Result := Result + [opt]; + end; +end; + +procedure TPoCheckerSettings.LoadMasterPoList(List: TStrings); +begin + if not Assigned(List) then Exit; + List.Clear; +end; + +procedure TPoCheckerSettings.LoadChildrenPoList(List: TStrings); +begin + if not Assigned(List) then Exit; + List.Clear; +end; + +procedure TPoCheckerSettings.SaveTestTypes; +var + tt: TPoTestType; + Name: String; +begin + for tt := Low(TPoTestTypes) to High(TPoTestTypes) do + begin + Name := TestTypeNames[tt]; + FConfig.SetDeleteValue(pTestTypes + Name + '/Value',(tt in FTestTypes),False); + end; +end; + +procedure TPoCheckerSettings.SaveTestOptions; +var + topt: TPoTestOption; + Name: String; +begin + for topt := Low(TPoTestOptions) to High(TPoTestoptions) do + begin + Name := TestOptionNames[topt]; + FConfig.SetDeleteValue(pTestOptions + Name + '/Value',(topt in FTestOptions),False); + end; +end; + +procedure TPoCheckerSettings.SaveMasterPoList; +begin + FConfig.DeletePath(pMasterPoFiles); +end; + +procedure TPoCheckerSettings.SaveChildrenPoList; +begin + FConfig.DeletePath(pChildrenPoFiles); +end; + +constructor TPoCheckerSettings.Create; +begin + try + FTestTypes := []; + FTestOptions := []; + {$ifdef POCHECKERSTANDALONE} + FFilename := GetConfigPath; + if (FFilename <> '') then FFilename := AppendPathDelim(FFilename); + FFilename := FFilename + 'pochecker.xml'; + debugln('TPoCheckerSettings.Create: Filename = '); + debugln('"',Filename,'"'); + + //FFilename := 'pochecker.xml'; + + FConfig := TXMLOptionsStorage.Create(FFilename, True); + {$else} + FFilename := 'pochecker.xml'; + FConfig := GetIDEConfigStorage(FFilename, True); + {$endif} + DebugLn('TPoCheckerSettings.Create: FConfig = ',DbgSName(FConfig)); + except + Debugln('PoCheckerSettings.Create: failed to create ConfigStorage:'); + Debugln(' - Filename = ',FFilename); + FConfig := nil; + end; +end; + +destructor TPoCheckerSettings.Destroy; +begin + if Assigned(FConfig) then FConfig.Free; + inherited Destroy; +end; + +procedure TPoCheckerSettings.LoadConfig; +begin + try + FLoadSettings := FConfig.GetValue(pLoadSettings+'Value',False); + if FLoadSettings then + begin + FTestTypes := LoadTestTypes; + FTestOptions := LoadTestOptions; + LoadMasterPoList(FMasterPoList); + LoadChildrenPoList(FChildrenPoList); + end; + except + FTestTypes := []; + FTestOptions := []; + debugln('TPoCheckerSettings.LoadConfig: Error loading config.'); + end; +end; + +procedure TPoCheckerSettings.SaveConfig; +begin + try + FConfig.SetDeleteValue('Version','1.0',''); + FConfig.SetValue(pLoadSettings+'Value',FSaveSettingsOnExit); + if FSaveSettingsOnExit then + begin + SaveTestTypes; + SaveTestOptions; + SaveMasterPoList; + SaveChildrenPoList; + end + else + begin + FConfig.DeletePath(pMasterPoFiles); + FConfig.DeletePath(pChildrenPoFiles); + end; + FConfig.WriteToDisk; + except + debugln('TPoCheckerSettings.SaveConfig: Error saving config.'); + end; +end; + +end. + diff --git a/components/pochecker/pocheckerxmlconfig.pp b/components/pochecker/pocheckerxmlconfig.pp new file mode 100644 index 0000000000..e247bfa142 --- /dev/null +++ b/components/pochecker/pocheckerxmlconfig.pp @@ -0,0 +1,186 @@ +{ + /*************************************************************************** + PoCheckerXMLConfig.pp + ----------------------------- + + ***************************************************************************/ + + *************************************************************************** + * * + * This source is free software; you can redistribute it and/or modify * + * it under the terms of the GNU General Public License as published by * + * the Free Software Foundation; either version 2 of the License, or * + * (at your option) any later version. * + * * + * This code is distributed in the hope that it will be useful, but * + * WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * + * General Public License for more details. * + * * + * A copy of the GNU General Public License is available on the World * + * Wide Web at . You can also * + * obtain it by writing to the Free Software Foundation, * + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * + * * + *************************************************************************** +} + +// This souce is copied from the IDEOptionDefs unit +// It provides the standalone version of PoChecker with the +// same ConfigStorage interface as the embedded tool + +unit PoCheckerXMLConfig; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LazConfigStorage, Laz2_XMLCfg; + + +type + { TXMLOptionsStorage } + + TXMLOptionsStorage = class(TConfigStorage) + private + FFreeXMLConfig: boolean; + FXMLConfig: TXMLConfig; + protected + function GetFullPathValue(const APath, ADefault: String): String; override; + function GetFullPathValue(const APath: String; ADefault: Integer): Integer; override; + function GetFullPathValue(const APath: String; ADefault: Boolean): Boolean; override; + procedure SetFullPathValue(const APath, AValue: String); override; + procedure SetDeleteFullPathValue(const APath, AValue, DefValue: String); override; + procedure SetFullPathValue(const APath: String; AValue: Integer); override; + procedure SetDeleteFullPathValue(const APath: String; AValue, DefValue: Integer); override; + procedure SetFullPathValue(const APath: String; AValue: Boolean); override; + procedure SetDeleteFullPathValue(const APath: String; AValue, DefValue: Boolean); override; + procedure DeleteFullPath(const APath: string); override; + procedure DeleteFullPathValue(const APath: string); override; + public + constructor Create(const Filename: string; LoadFromDisk: Boolean); override; + constructor Create(TheXMLConfig: TXMLConfig); + constructor Create(TheXMLConfig: TXMLConfig; const StartPath: string); + destructor Destroy; override; + procedure Clear; override; + property XMLConfig: TXMLConfig read FXMLConfig; + property FreeXMLConfig: boolean read FFreeXMLConfig write FFreeXMLConfig; + procedure WriteToDisk; override; + function GetFilename: string; override; + end; + +implementation + + +{ TXMLOptionsStorage } + +function TXMLOptionsStorage.GetFullPathValue(const APath, ADefault: String): String; +begin + Result:=XMLConfig.GetValue(APath, ADefault); +end; + +function TXMLOptionsStorage.GetFullPathValue(const APath: String; + ADefault: Integer): Integer; +begin + Result:=XMLConfig.GetValue(APath, ADefault); +end; + +function TXMLOptionsStorage.GetFullPathValue(const APath: String; + ADefault: Boolean): Boolean; +begin + Result:=XMLConfig.GetValue(APath, ADefault); +end; + +procedure TXMLOptionsStorage.SetFullPathValue(const APath, AValue: String); +begin + XMLConfig.SetValue(APath, AValue); +end; + +procedure TXMLOptionsStorage.SetDeleteFullPathValue(const APath, AValue, + DefValue: String); +begin + XMLConfig.SetDeleteValue(APath, AValue, DefValue); +end; + +procedure TXMLOptionsStorage.SetFullPathValue(const APath: String; + AValue: Integer); +begin + XMLConfig.SetValue(APath, AValue); +end; + +procedure TXMLOptionsStorage.SetDeleteFullPathValue(const APath: String; + AValue, DefValue: Integer); +begin + XMLConfig.SetDeleteValue(APath, AValue, DefValue); +end; + +procedure TXMLOptionsStorage.SetFullPathValue(const APath: String; + AValue: Boolean); +begin + XMLConfig.SetValue(APath, AValue); +end; + +procedure TXMLOptionsStorage.SetDeleteFullPathValue(const APath: String; + AValue, DefValue: Boolean); +begin + XMLConfig.SetDeleteValue(APath, AValue, DefValue); +end; + +procedure TXMLOptionsStorage.DeleteFullPath(const APath: string); +begin + XMLConfig.DeletePath(APath); +end; + +procedure TXMLOptionsStorage.DeleteFullPathValue(const APath: string); +begin + XMLConfig.DeleteValue(APath); +end; + +constructor TXMLOptionsStorage.Create(const Filename: string; + LoadFromDisk: Boolean); +begin + if LoadFromDisk then + FXMLConfig:=TXMLConfig.Create(Filename) + else + FXMLConfig:=TXMLConfig.CreateClean(Filename); + FFreeXMLConfig:=true; +end; + +constructor TXMLOptionsStorage.Create(TheXMLConfig: TXMLConfig); +begin + FXMLConfig:=TheXMLConfig; + if FXMLConfig=nil then + raise Exception.Create(''); +end; + +constructor TXMLOptionsStorage.Create(TheXMLConfig: TXMLConfig; + const StartPath: string); +begin + Create(TheXMLConfig); + AppendBasePath(StartPath); +end; + +destructor TXMLOptionsStorage.Destroy; +begin + if FreeXMLConfig then FreeAndNil(FXMLConfig); + inherited Destroy; +end; + +procedure TXMLOptionsStorage.Clear; +begin + FXMLConfig.Clear; +end; + +procedure TXMLOptionsStorage.WriteToDisk; +begin + FXMLConfig.Flush; +end; + +function TXMLOptionsStorage.GetFilename: string; +begin + Result:=FXMLConfig.Filename; +end; + +end. +