Editor Macro Script: run selftests

git-svn-id: trunk@42329 -

.gitattributes

@@ -2405,7 +2405,10 @@ components/macroscript/editormacroscript.lpk svneol=native#text/pascal
 components/macroscript/editormacroscript.pas svneol=native#text/pascal
 components/macroscript/emscriptclasses.pas svneol=native#text/pascal
 components/macroscript/emscriptmacro.pas svneol=native#text/pascal
+components/macroscript/emsideoptions.lfm svneol=native#text/pascal
+components/macroscript/emsideoptions.pas svneol=native#text/pascal
 components/macroscript/emsselftest.pas svneol=native#text/pascal
+components/macroscript/emsstrings.pas svneol=native#text/pascal
 components/macroscript/registerems.pas svneol=native#text/pascal
 components/macroscript/test/TestMacroScript.lpi svneol=native#text/plain
 components/macroscript/test/TestMacroScript.lpr svneol=native#text/plain

components/macroscript/editormacroscript.lpk

@@ -23,7 +23,7 @@ This package requires: PascalScript from REM Objects (http://www.remobjects.com/
 
 Extends the Editors macro recorder and player. Macros can be written in pascal script. They also have access to additional properties and methods."/>
     <License Value="GPL"/>
-    <Files Count="4">
+    <Files Count="6">
       <Item1>
         <Filename Value="registerems.pas"/>
         <HasRegisterProc Value="True"/>
@@ -41,6 +41,14 @@ Extends the Editors macro recorder and player. Macros can be written in pascal s
         <Filename Value="emsselftest.pas"/>
         <UnitName Value="emsselftest"/>
       </Item4>
+      <Item5>
+        <Filename Value="emsideoptions.pas"/>
+        <UnitName Value="emsideoptions"/>
+      </Item5>
+      <Item6>
+        <Filename Value="emsstrings.pas"/>
+        <UnitName Value="emsstrings"/>
+      </Item6>
     </Files>
     <Type Value="RunAndDesignTime"/>
     <RequiredPkgs Count="4">

components/macroscript/editormacroscript.pas

@@ -7,7 +7,8 @@ unit EditorMacroScript;
 interface
 
 uses
-  RegisterEMS, EMScriptMacro, EMScriptClasses, EMSSelfTest, LazarusPackageIntf;
+  RegisterEMS, EMScriptMacro, EMScriptClasses, EMSSelfTest, EMSIdeOptions, 
+  EMSStrings, LazarusPackageIntf;
 
 implementation
 

components/macroscript/emscriptmacro.pas

@@ -5,9 +5,9 @@ unit EMScriptMacro;
 interface
 
 uses
-  Classes, SysUtils, SrcEditorIntf, IDEMsgIntf, Controls, SynEdit,
+  Classes, SysUtils, SrcEditorIntf, IDEMsgIntf, LazIDEIntf, IDEOptionsIntf,
-  EMScriptClasses, Laz2_XMLCfg, uPSRuntime, uPSUtils,
+  Controls, SynEdit, EMScriptClasses, EMSStrings, Laz2_XMLCfg, uPSRuntime,
-  LazLoggerBase;
+  uPSUtils, LazLoggerBase, LazFileUtils;
 
 type
 
@@ -64,12 +64,52 @@ type
     property PrivateExec: TEMSTPSExec read FPrivateExec write FPrivateExec;
   end;
 
+  { TEMSConfig }
+
+  TEMSConfig = class(TAbstractIDEEnvironmentOptions)
+  private
+    FSelfTestActive: Boolean;
+    FSelfTestFailed: Integer; // stores EMSVersion that failed
+  protected
+    function GetXmlConf: TRttiXMLConfig;
+  public
+    constructor Create;
+    procedure Init;
+    procedure Load;
+    procedure Save;
+
+    class function GetGroupCaption: string; override;
+    class function GetInstance: TAbstractIDEOptions; override;
+  published
+    property SelfTestActive: Boolean read FSelfTestActive write FSelfTestActive;
+    property SelfTestFailed: Integer read FSelfTestFailed write FSelfTestFailed;
+  end;
+
+function GetEMSConf: TEMSConfig;
+
+const
+  EMSVersion = 1;
 
 implementation
 
 var
   GlobalCompiler: TEMSPSPascalCompiler;
   GlobalExec: TEMSTPSExec;
+  ConfFile: TEMSConfig = nil;
+  ConfFileName: String = '';
+
+const
+  DefaultConfFileName = 'editormacroscript.cfg';
+
+function GetConfFileName: String;
+begin
+  Result := ConfFileName;
+  if Result <> '' then
+    exit;
+  ConfFileName := AppendPathDelim(LazarusIDE.GetPrimaryConfigPath) + DefaultConfFileName;
+  LazarusIDE.CopySecondaryConfigFile(DefaultConfFileName);
+  Result := ConfFileName;
+end;
 
 { Create global objects }
 
@@ -83,6 +123,81 @@ begin
   GlobalExec := TEMSTPSExec.Create;
 end;
 
+function GetEMSConf: TEMSConfig;
+begin
+  Result := ConfFile;
+  if Result <> nil then
+    exit;
+
+  ConfFile := TEMSConfig.Create;
+  Result := ConfFile;
+end;
+
+{ TEMSConfig }
+
+function TEMSConfig.GetXmlConf: TRttiXMLConfig;
+var
+  fn: String;
+begin
+  fn := GetConfFileName;
+  if (not FileExistsUTF8(fn)) then
+    Result := TRttiXMLConfig.CreateClean(fn)
+  else
+    Result := TRttiXMLConfig.Create(fn);
+end;
+
+constructor TEMSConfig.Create;
+begin
+  Init;
+end;
+
+procedure TEMSConfig.Init;
+begin
+  FSelfTestActive := False;
+  SelfTestFailed := 0;
+end;
+
+procedure TEMSConfig.Load;
+var
+  def: TEMSConfig;
+  cfg: TRttiXMLConfig;
+begin
+  cfg := GetXmlConf;
+  def := TEMSConfig.Create;
+  try
+    cfg.ReadObject('EMS/Settings/', Self, def);
+  finally
+    cfg.Free;
+    def.Free;
+  end;
+end;
+
+procedure TEMSConfig.Save;
+var
+  def: TEMSConfig;
+  cfg: TRttiXMLConfig;
+begin
+  cfg := GetXmlConf;
+  def := TEMSConfig.Create;
+  try
+    cfg.WriteObject('EMS/Settings/', Self, def);
+    cfg.Flush;
+  finally
+    cfg.Free;
+    def.Free;
+  end;
+end;
+
+class function TEMSConfig.GetGroupCaption: string;
+begin
+  Result := EMSEditorMacroTitle;
+end;
+
+class function TEMSConfig.GetInstance: TAbstractIDEOptions;
+begin
+  Result := GetEMSConf;
+end;
+
 { TEMSEditorMacro }
 
 function TEMSEditorMacro.GetCompiler: TEMSPSPascalCompiler;
@@ -335,6 +450,7 @@ initialization
 finalization
   FreeAndNil(GlobalExec);
   FreeAndNil(GlobalCompiler);
+  FreeAndNil(ConfFile);
 
 end.
 

components/macroscript/emsideoptions.lfm

@@ -0,0 +1,36 @@
+object EMSIdeOptionsFrame: TEMSIdeOptionsFrame
+  Cursor = crDrag
+  Left = 0
+  Height = 240
+  Top = 0
+  Width = 320
+  ClientHeight = 240
+  ClientWidth = 320
+  TabOrder = 0
+  DesignLeft = 656
+  DesignTop = 156
+  object lblStatus: TLabel
+    Left = 6
+    Height = 17
+    Top = 6
+    Width = 308
+    Align = alTop
+    BorderSpacing.Around = 6
+    Caption = 'lblStatus'
+    ParentColor = False
+    WordWrap = True
+  end
+  object btnActivate: TButton
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = lblStatus
+    AnchorSideTop.Side = asrBottom
+    Left = 6
+    Height = 25
+    Top = 29
+    Width = 75
+    BorderSpacing.Around = 6
+    Caption = 'btnActivate'
+    OnClick = btnActivateClick
+    TabOrder = 0
+  end
+end

components/macroscript/emsideoptions.pas

@@ -0,0 +1,93 @@
+unit EMSIdeOptions;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, Forms, Controls, StdCtrls, IDEOptionsIntf,
+  SrcEditorIntf, EMScriptMacro, EMSStrings;
+
+type
+
+  { TEMSIdeOptionsFrame }
+
+  TEMSIdeOptionsFrame = class(TAbstractIDEOptionsEditor)
+    btnActivate: TButton;
+    lblStatus: TLabel;
+    procedure btnActivateClick(Sender: TObject);
+  private
+    { private declarations }
+  public
+    { public declarations }
+    function GetTitle: String; override;
+    procedure Setup(ADialog: TAbstractOptionsEditorDialog); override;
+    procedure ReadSettings(AOptions: TAbstractIDEOptions); override;
+    procedure WriteSettings(AOptions: TAbstractIDEOptions); override;
+    class function SupportedOptionsClass: TAbstractIDEOptionsClass; override;
+  end;
+
+implementation
+
+{$R *.lfm}
+
+{ EMSIdeOptionsFrame }
+
+procedure TEMSIdeOptionsFrame.btnActivateClick(Sender: TObject);
+var
+  cfg: TEMSConfig;
+begin
+  cfg := GetEMSConf;
+  cfg.SelfTestFailed := 0;
+  cfg.SelfTestActive := False;
+  cfg.Save;
+  ReadSettings(nil);
+end;
+
+function TEMSIdeOptionsFrame.GetTitle: String;
+begin
+  Result := EMSStatusTitle;
+end;
+
+procedure TEMSIdeOptionsFrame.Setup(ADialog: TAbstractOptionsEditorDialog);
+begin
+  btnActivate.Caption := EMSBtnTestAgain;
+end;
+
+procedure TEMSIdeOptionsFrame.ReadSettings(AOptions: TAbstractIDEOptions);
+var
+  cfg: TEMSConfig;
+begin
+  cfg := GetEMSConf;
+
+  if cfg.SelfTestFailed >= EMSVersion then begin
+    lblStatus.Caption := EMSNotActive;
+    btnActivate.Enabled := True;
+  end
+  else
+
+  if EditorMacroPlayerClass = TEMSEditorMacro then begin
+    lblStatus.Caption := EMSActive;
+    btnActivate.Enabled := False;
+  end
+
+  else
+  begin
+    lblStatus.Caption := EMSPending;
+    btnActivate.Enabled := False;
+  end;
+
+end;
+
+procedure TEMSIdeOptionsFrame.WriteSettings(AOptions: TAbstractIDEOptions);
+begin
+  //
+end;
+
+class function TEMSIdeOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;
+begin
+  Result := TEMSConfig;
+end;
+
+end.
+

components/macroscript/emsselftest.pas

@@ -40,6 +40,9 @@ type
 
   function DoSelfTest: Boolean;
 
+var
+  SelfTestErrorMsg: String;
+
 implementation
 
 {%region RegisterSelfTests}
@@ -528,7 +531,8 @@ var
   end;
 
 begin
-  Result := True;
+  Result := False;
+  SelfTestErrorMsg := '';
   try
     try
     m := TEMSelfTestEditorMacro.Create(nil);
@@ -762,13 +766,17 @@ begin
             'Test XYZ XYZde 123'
             );
 
+      Result := True;
     finally
       FreeAndNil(m);
       FreeAndNil(syn);
     end;
   except
+    on E: Exception do begin
+        SelfTestErrorMsg := E.Message;
         Result := False;
       end;
+  end;
 end;
 
 end.

components/macroscript/emsstrings.pas

@@ -0,0 +1,26 @@
+unit EMSStrings;
+
+{$mode objfpc}{$H+}
+
+interface
+
+resourcestring
+  EmsSelfTestErrCaption = 'Error in EditorMacroScript';
+  EmsSelfTestFailed = 'The package EditorMacroScript (pascalscript macros)' +
+    ' has detected a problem and was de-activated. %0:s' +
+    'The package failed its selftest with the message:%0:s "%1:s"';
+  EmsSelfTestFailedLastTime = 'The package EditorMacroScript (pascalscript macros)' +
+    ' has detected a problem and was de-activated. %0:s' +
+    'The package selftest was not completed during the last start of the IDE"';
+  EMSStatusTitle = 'Status';
+  EMSEditorMacroTitle = 'Editor Macro Script';
+  EMSBtnTestAgain = 'Test again';
+  EMSNotActive = 'Scripting not active. Selftest failed';
+  EMSActive = 'Scripting active';
+  EMSPending = 'Scripting not active. Selftest will run next time the IDE is '
+    +'started';
+
+implementation
+
+end.
+

components/macroscript/registerems.pas

@@ -5,14 +5,60 @@ unit RegisterEMS;
 interface
 
 uses
-  Classes, SysUtils, SrcEditorIntf, EMScriptMacro;
+  Classes, SysUtils, SrcEditorIntf, IDEOptionsIntf, EMScriptMacro, EMSSelfTest,
+  EMSIdeOptions, EMSStrings, Dialogs;
 
 procedure Register;
 
 implementation
 
 procedure Register;
+var
+  conf: TEMSConfig;
+  ok: Boolean;
+  OptionsGroup: Integer;
 begin
+  OptionsGroup := GetFreeIDEOptionsGroupIndex(GroupEditor);
+  RegisterIDEOptionsGroup(OptionsGroup, TEMSConfig);
+  RegisterIDEOptionsEditor(OptionsGroup, TEMSIdeOptionsFrame, 1);
+
+
+  conf := GetEMSConf;
+  conf.Load;
+  if conf.SelfTestActive then begin
+    conf.SelfTestFailed := EMSVersion;
+    conf.SelfTestActive := False;
+    conf.Save;
+    MessageDlg(EmsSelfTestErrCaption,
+               format(EmsSelfTestFailedLastTime, [LineEnding]),
+               mtError, [mbOK], 0);
+  end;
+  if conf.SelfTestFailed >= EMSVersion then begin
+    exit;
+  end;
+
+  conf.SelfTestActive := True;
+  conf.Save;
+
+  ok := False;
+  try
+    ok := DoSelfTest;
+  except
+  end;
+
+  if not ok then begin
+    conf.SelfTestFailed := EMSVersion;
+    conf.SelfTestActive := False;
+    conf.Save;
+    MessageDlg(EmsSelfTestErrCaption,
+               format(EmsSelfTestFailed, [LineEnding, SelfTestErrorMsg]),
+               mtError, [mbOK], 0);
+    exit;
+  end;
+
+  conf.SelfTestActive := False;
+  conf.Save;
+
   EditorMacroPlayerClass := TEMSEditorMacro;
 end;
 

components/macroscript/test/TestMacroScript.lpi

@@ -9,7 +9,6 @@
       <Title Value="TestMacroScript"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
-      <Icon Value="0"/>
     </General>
     <i18n>
       <EnableI18N LFM="False"/>