lazarus/components/pochecker/pocheckersettings.pp

unit PoCheckerSettings;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  Forms,
  LazFileUtils, LazLoggerBase, LazConfigStorage, LazUTF8,
  {$ifdef POCHECKERSTANDALONE}
  PoCheckerXMLConfig,
  {$else}
  BaseIDEIntf,
  {$endif}
  PoFamilies;

type

  { TPoCheckerSettings }

  TPoCheckerSettings = class
  private
    FConfig: TConfigStorage;
    FExternalEditorName: String;
    FFilename: String;
    FGraphFormWindowState: TWindowState;
    FLangFilterLanguageAbbr: String;
    FLangPath: String;
    FMainFormWindowState: TWindowState;
    FResultsFormWindowState: TWindowState;
    FSelectDirectoryFilename: String;
    FTestTypes: TPoTestTypes;
    FMasterPoList: TStringListUTF8Fast;
    FMasterPoSelList: TStringList;
    FMainFormGeometry: TRect;
    FGraphFormGeometry: TRect;
    FResultsFormGeometry: TRect;
    FDisableAntialiasing: Boolean;
    function GetDisableAntialiasing: Boolean;
    function GetMasterPoList: TStrings;
    function GetMasterPoSelList: TStrings;
    function LoadTestTypes: TPoTestTypes;
    procedure LoadWindowsGeometry;
    procedure LoadDisableAntiAliasing;
    function LoadExternalEditorName: String;
    function LoadSelectDirectoryFilename: String;
    function LoadLangFilterLanguageAbbr: String;
    function LoadLangPath: String;
    procedure LoadMasterPoList(List: TStrings);
    procedure LoadMasterPoSelList(List: TStrings);
    procedure SaveTestTypes;
    procedure SaveWindowsGeometry;
    procedure SaveDisableAntialiasing;
    procedure SaveExternalEditorName;
    procedure SaveSelectDirectoryFilename;
    procedure SaveLangFilterLanguageAbbr;
    procedure SaveLangPath;
    procedure SaveMasterPoList;
    procedure SaveMasterPoSelList;
    procedure RemoveUnwantedPaths;
    procedure SetMasterPoList(AValue: TStrings);
    procedure SetMasterPoSelList(AValue: TStrings);
    procedure ResetAllProperties;
  public
    constructor Create;
    destructor Destroy; override;

    procedure LoadConfig;
    procedure SaveConfig;

    property Filename: String read FFilename;
    property TestTypes: TPoTestTypes read FTestTypes write FTestTypes;
    property ExternalEditorName: String read FExternalEditorName write FExternalEditorName;
    property MasterPoList: TStrings read GetMasterPoList write SetMasterPoList;
    property MasterPoSelList: TStrings read GetMasterPoSelList write SetMasterPoSelList;
    property SelectDirectoryFilename: String read FSelectDirectoryFilename write FSelectDirectoryFilename;
    property MainFormGeometry: TRect read FMainFormGeometry write FMainFormGeometry;
    property ResultsFormGeometry: TRect read FResultsFormGeometry write FResultsFormGeometry;
    property DisableAntialiasing: Boolean read GetDisableAntialiasing;
    property GraphFormGeometry: TRect read FGraphFormGeometry write FGraphFormGeometry;
    property MainFormWindowState: TWindowState read FMainFormWindowState write FMainFormWindowState;
    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;
function FitToRect(const ARect, FitIn: TRect): TRect;
function IsDefaultRect(ARect: TRect): Boolean;
function IsValidRect(ARect: TRect): Boolean;
{$ifdef pocheckerstandalone}
function GetGlobalConfigPath: String;
function GetLocalConfigPath: String;
{$endif}

implementation

const
  DEFAULT_DISABLE_ANTIALIASING = true;

function FitToRect(const ARect, FitIn: TRect): TRect;
begin
  Result := ARect;
  if (Result.Right - Result.Left) > (FitIn.Right - FitIn.Left) then
    Result.Right := Result.Left + (FitIn.Right - FitIn.Left);
  if (Result.Bottom - Result.Top) > (FitIn.Bottom - FitIn.Top) then
    Result.Bottom := Result.Top + (FitIn.Bottom - FitIn.Top);
  if Result.Left < FitIn.Left then
  begin
    Result.Right := Result.Right + (FitIn.Left - Result.Left);
    Result.Left := FitIn.Left;
  end;
  if Result.Right > FitIn.Right then
  begin
    Result.Left := Result.Left - (Result.Right - FitIn.Right);
    Result.Right := Result.Right - (Result.Right - FitIn.Right);
  end;
  if Result.Top < FitIn.Top then
  begin
    Result.Bottom := Result.Bottom + (FitIn.Top - Result.Top);
    Result.Top := FitIn.Top;
  end;
  if Result.Bottom > FitIn.Bottom then
  begin
    Result.Top := Result.Top - (Result.Bottom - FitIn.Bottom);
    Result.Bottom := Result.Bottom - (Result.Bottom - FitIn.Bottom);
  end;

  //if Result.Right > FitIn.Right then Result.Right := FitIn.Right;
  //if Result.Bottom > FitIn.Bottom then Result.Bottom := FitIn.Bottom;
end;

function IsDefaultRect(ARect: TRect): Boolean;
begin
  Result := (ARect.Left = -1) and (ARect.Top = -1) and
            (ARect.Right = -1) and (Arect.Bottom = -1);
end;

function IsValidRect(ARect: TRect): Boolean;
begin
  Result := (ARect.Right > ARect.Left) and
            (ARect.Bottom > ARect.Top);
end;

const
  TestTypeNames: array[TPoTestType] of String = (
    'CheckNumberOfItems',
    'CheckForIncompatibleFormatArguments',
    'CheckMissingIdentifiers',
    'CheckForMismatchesInUntranslatedStrings'
    );

  pSelectDirectoryFilename = 'SelectDirectoryFilename/';
  pLangFilter = 'LanguageFilter/';
  pLangPath = 'LanguageFiles/';
  pTestTypes = 'TestTypes/';
  pWindowsGeometry = 'General/WindowsGeometry/';
  pMasterPoFiles = 'MasterPoFiles/';
  pMasterPoSelection = 'MasterPoSelection/';
  {$IFDEF POCHECKERSTANDALONE}
  pExternalEditor = 'ExternalEditor/';
  {$ENDIF}

var
  DefaultRect: TRect;

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;


{ TPoCheckerSettings }
{$ifdef pocheckerstandalone}
function AppName: String;
begin
  Result := 'pochecker';
end;

function Vendor: String;
begin
  Result := '';
end;

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;
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;
    Result := GetAppConfigDirUtf8(False);
    OnGetApplicationName := OldOnGetApplicationName;
    OnGetVendorName := OldOnGetVendorName;
  end;
end;

function GetAndCreateConfigPath: String;
begin
  Result := GetLocalConfigPath;
  if not ForceDirectoriesUTF8(Result) then
    Debugln('GetAndCreateConfigPath: unable to create "',Result,'"');
end;

{$endif}


function TPoCheckerSettings.GetMasterPoList: TStrings;
begin
  Result := FMasterPoList;
end;

function TPoCheckerSettings.GetMasterPoSelList: TStrings;
begin
  Result := FMasterPoSelList;
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;

procedure TPoCheckerSettings.LoadWindowsGeometry;
function IntToWindowState(WSInt: Integer): TWindowState;
begin
  if (WSInt in [Ord(Low(TWindowState))..Ord(High(TWindowState))]) then
    Result := TWindowState(WSInt)
  else
    Result := wsNormal;
end;
begin
  FConfig.GetValue(pWindowsGeometry+'MainForm/Value',FMainFormGeometry,DefaultRect);
  FMainFormWindowState := IntToWindowState(FConfig.GetValue(pWindowsGeometry+'MainForm/WindowState/Value', Ord(wsNormal)));
  FConfig.GetValue(pWindowsGeometry+'ResultsForm/Value',FResultsFormGeometry,DefaultRect);
  FResultsFormWindowState := IntToWindowState(FConfig.GetValue(pWindowsGeometry+'ResultsForm/WindowState/Value', Ord(wsNormal)));
  FConfig.GetValue(pWindowsGeometry+'GraphForm/Value',FGraphFormGeometry,DefaultRect);
  FGraphFormWindowState := IntToWindowState(FConfig.GetValue(pWindowsGeometry+'GraphForm/WindowState/Value', Ord(wsNormal)));
end;

function TPoCheckerSettings.GetDisableAntialiasing: Boolean;
var
  cfg: TConfigStorage;
  ver: Integer;
begin
  {$IFDEF POCHECKERSTANDALONE}
  Result := FDisableAntialiasing;
  {$ELSE}
  cfg := GetIDEConfigStorage('editoroptions.xml', True);
  ver := cfg.GetValue('EditorOptions/Version', 0);
  Result := cfg.GetValue('EditorOptions/Display/DisableAntialiasing', ver < 7);
  FDisableAntiAliasing := Result;
  cfg.Free;
  {$ENDIF}
end;

procedure TPoCheckerSettings.LoadDisableAntialiasing;
begin
  {$IFDEF POCHECKERSTANDALONE}
  FDisableAntialiasing := FConfig.GetValue('General/Display/ResultsForm/DisableAntialiasing',
      DEFAULT_DISABLE_ANTIALIASING);
  {$ENDIF}
end;

function TPoCheckerSettings.LoadExternalEditorName: String;
begin
  {$IFDEF POCHECKERSTANDALONE}
  //allow override on commandline
  if Application.HasOption('editor') then
    Result := Application.GetOptionValue('editor')
  else
    Result := FConfig.GetValue(pExternalEditor+'Value','');
  {$ELSE}
  Result := '';
  {$eNDIF}
end;

function TPoCheckerSettings.LoadSelectDirectoryFilename: String;
begin
  Result := FConfig.GetValue(pSelectDirectoryFilename+'Value','');
end;

function TPoCheckerSettings.LoadLangFilterLanguageAbbr: String;
begin
  Result := FConfig.GetValue(pLangFilter + 'Value', '');
end;

function TPoCheckerSettings.LoadLangPath: String;
{$IFDEF POCHECKERSTANDALONE}
var
  SL: TStringList;
  i: Integer;
  S: String;
{$ENDIF}
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
  Cnt, i: Integer;
  Fn: String;
begin
  List.Clear;
  Cnt := Fconfig.GetValue(pMasterpoFiles+'Count',0);
  //debugln('TPoCheckerSettings.LoadMasterPoList: Cnt = ',DbgS(Cnt));
  for i := 0 to Cnt - 1 do
  begin
    Fn := FConfig.GetValue(pMasterpoFiles+Format('Item_%d/Value',[i]),'');
    if (Fn <> '') then List.Add(Fn);
  end;
end;

procedure TPoCheckerSettings.LoadMasterPoSelList(List: TStrings);
var
  Cnt, i: Integer;
  Fn: String;
begin
  List.Clear;
  Cnt := Fconfig.GetValue(pMasterpoSelection+'Count',0);
  //debugln('TPoCheckerSettings.LoadMasterPoSelList: Cnt = ',DbgS(Cnt));
  for i := 0 to Cnt - 1 do
  begin
    Fn := FConfig.GetValue(pMasterpoSelection+Format('Item_%d/Value',[i]),'');
    if (Fn <> '') then List.Add(Fn);
  end;
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.SaveWindowsGeometry;
begin
  FConfig.SetDeleteValue(pWindowsGeometry+'MainForm/Value',FMainFormGeometry,DefaultRect);
  FConfig.SetDeleteValue(pWindowsGeometry+'MainForm/WindowState/Value',Ord(FMainFormWindowState), Ord(wsNormal));
  FConfig.SetDeleteValue(pWindowsGeometry+'ResultsForm/Value',FResultsFormGeometry,DefaultRect);
  FConfig.SetDeleteValue(pWindowsGeometry+'ResultsForm/WindowState/Value',Ord(FResultsFormWindowState), Ord(wsNormal));
  FConfig.SetDeleteValue(pWindowsGeometry+'GraphForm/Value',FGraphFormGeometry,DefaultRect);
  FConfig.SetDeleteValue(pWindowsGeometry+'GraphForm/WindowState/Value',Ord(FGraphFormWindowState), Ord(wsNormal));
end;

procedure TPoCheckerSettings.SaveDisableAntialiasing;
begin
  {$IFDEF POCHECKERSTANDALONE}
  // Don't use SetDeleteValue to keep the syntax in the file because there is
  // no gui to modify DisableAntialiasing at the moment.
  FConfig.SetValue('General/Display/ResultsForm/DisableAntialiasing', FDisableAntialiasing);
  {$ENDIF}
end;

procedure TPoCheckerSettings.SaveExternalEditorName;
begin
  {$IFDEF POCHECKERSTANDALONE}
  FConfig.SetDeleteValue(pExternalEditor+'Value',FExternalEditorName,'');
  {$ENDIF}
end;

procedure TPoCheckerSettings.SaveSelectDirectoryFilename;
begin
  FConfig.SetDeleteValue(pSelectDirectoryFilename+'Value',FSelectDirectoryFilename,'');
end;

procedure TPoCheckerSettings.SaveMasterPoList;
var
  Cnt, i: Integer;
begin
  FConfig.DeletePath(pMasterPoFiles);
  Cnt := FMasterPoList.Count;
  FConfig.SetDeleteValue(pMasterPoFiles+'Count',Cnt,0);
  for i := 0 to Cnt - 1 do
    FConfig.SetDeleteValue(pMasterPoFiles+Format('Item_%d/Value',[i]),FMasterPoList[i],'');
end;

procedure TPoCheckerSettings.SaveMasterPoSelList;
var
  Cnt, i: Integer;
begin
  FConfig.DeletePath(pMasterPoSelection);
  Cnt := FMasterPoSelList.Count;
  FConfig.SetDeleteValue(pMasterPoSelection+'Count',Cnt,0);
  for i := 0 to Cnt - 1 do
    FConfig.SetDeleteValue(pMasterPoSelection+Format('Item_%d/Value',[i]),FMasterPoSelList[i],'');
end;


procedure TPoCheckerSettings.SaveLangFilterLanguageAbbr;
begin
  FConfig.SetDeleteValue(pLangFilter + 'Value', FLangFilterLanguageAbbr, '');
end;

procedure TPoCheckerSettings.SaveLangPath;
begin
  FConfig.SetDeleteValue(pLangPath + 'Value', FLangPath, '');
end;

procedure TPoCheckerSettings.RemoveUnwantedPaths;
const
  pLoadSettings = 'General/LoadSettings/';
  pChildPoFiles = 'ChildPoFiles/';
  pLastSelected = 'LastSelected/';
begin
  FConfig.DeletePath(pLoadSettings);
  FConfig.DeletePath(pChildPoFiles);
  FConfig.DeletePath(pLastSelected);
end;


procedure TPoCheckerSettings.SetMasterPoList(AValue: TStrings);
begin
  FMasterPoList.Assign(AValue);
end;

procedure TPoCheckerSettings.SetMasterPoSelList(AValue: TStrings);
begin
  FMasterPoSelList.Assign(AValue);
end;



procedure TPoCheckerSettings.ResetAllProperties;
begin
  FTestTypes := [];
  FMainFormGeometry := DefaultRect;
  FGraphFormGeometry := DefaultRect;
  FResultsFormGeometry := DefaultRect;
  FMainFormWindowState := wsNormal;
  FResultsFormWindowState := wsNormal;
  FGraphFormWindowState := wsNormal;
  FDisableAntialiasing := DEFAULT_DISABLE_ANTIALIASING;
  FExternalEditorName := '';
  FSelectDirectoryFilename := '';
  FLangFilterLanguageAbbr := '';
  FMasterPoList.Free;
  FMasterPoSelList.Free;
  FMasterPoList := TStringListUTF8Fast.Create;
  FMasterPoSelList := TStringList.Create;
  FMasterPoList.Sorted := True;
  FMasterPoList.Duplicates := dupIgnore;
end;


constructor TPoCheckerSettings.Create;
begin
  try
    ResetAllProperties;
    {$ifdef POCHECKERSTANDALONE}
    FFilename := GetAndCreateConfigPath;
    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
  FConfig.Free;
  FMasterPoList.Free;
  FMasterPoSelList.Free;
  inherited Destroy;
end;

procedure TPoCheckerSettings.LoadConfig;
begin
  try
    FTestTypes := LoadTestTypes;
    FSelectDirectoryFilename := LoadSelectDirectoryFilename;
    FExternalEditorName := LoadExternalEditorName;
    FLangFilterLanguageAbbr := LoadLangFilterLanguageAbbr;
    FLangPath := LoadLangPath;
    LoadWindowsGeometry;
    LoadDisableAntialiasing;
    LoadMasterPoList(FMasterPoList);
    LoadMasterPoSelList(FMasterPoSelList);
  except
    ResetAllProperties;
    debugln('TPoCheckerSettings.LoadConfig: Error loading config.');
  end;
end;

procedure TPoCheckerSettings.SaveConfig;
begin
  try
    FConfig.SetDeleteValue('Version','1.0','');
    RemoveUnwantedPaths;
    SaveTestTypes;
    SaveExternalEditorName;
    SaveSelectDirectoryFilename;
    SaveLangFilterLanguageAbbr;
    SaveLangPath;
    SaveWindowsGeometry;
    SaveDisableAntialiasing;
    SaveMasterPoList;
    SaveMasterPoSelList;
    FConfig.WriteToDisk;
  except
    debugln('TPoCheckerSettings.SaveConfig: Error saving config.');
  end;
end;

Initialization
  DefaultRect := Rect(-1, -1, -1, -1);
end.