EditorMacros: create PascalScript based macros

git-svn-id: trunk@38393 -

.gitattributes

@@ -1969,6 +1969,11 @@ components/macfiles/examples/createmacapplication.lpr svneol=native#text/plain
 components/macfiles/macapplicationres.pas svneol=native#text/plain
 components/macfiles/macosfiles.lpk svneol=native#text/plain
 components/macfiles/macosfiles.pas svneol=native#text/plain
+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/registerems.pas svneol=native#text/pascal
 components/memds/Makefile svneol=native#text/plain
 components/memds/Makefile.compiled svneol=native#text/plain
 components/memds/Makefile.fpc svneol=native#text/plain
@@ -6319,6 +6324,7 @@ packager/globallinks/demoidehelp-0.lpl svneol=native#text/plain
 packager/globallinks/designbaseclassdemopkg-0.lpl svneol=native#text/plain
 packager/globallinks/easydockmgr-1.lpl svneol=native#text/plain
 packager/globallinks/easydockmgrdsgn-0.lpl svneol=native#text/plain
+packager/globallinks/editormacroscript-0.lpl svneol=native#text/pascal
 packager/globallinks/editortoolbar-0.4.lpl svneol=native#text/plain
 packager/globallinks/educationlaz-1.0.1.lpl svneol=native#text/plain
 packager/globallinks/exploreidemenu-0.lpl svneol=native#text/plain

components/macroscript/editormacroscript.lpk

@@ -0,0 +1,58 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <Package Version="4">
+    <PathDelim Value="\"/>
+    <Name Value="EditorMacroScript"/>
+    <CompilerOptions>
+      <Version Value="11"/>
+      <PathDelim Value="\"/>
+      <SearchPaths>
+        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+      </SearchPaths>
+      <Other>
+        <CompilerMessages>
+          <MsgFileName Value=""/>
+        </CompilerMessages>
+        <CompilerPath Value="$(CompPath)"/>
+      </Other>
+    </CompilerOptions>
+    <Description Value="IDE-Extension: Adds PascalScript to editor-macros"/>
+    <License Value="GPL"/>
+    <Files Count="3">
+      <Item1>
+        <Filename Value="registerems.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="RegisterEMS"/>
+      </Item1>
+      <Item2>
+        <Filename Value="emscriptmacro.pas"/>
+        <UnitName Value="EMScriptMacro"/>
+      </Item2>
+      <Item3>
+        <Filename Value="emscriptclasses.pas"/>
+        <UnitName Value="emscriptclasses"/>
+      </Item3>
+    </Files>
+    <Type Value="RunAndDesignTime"/>
+    <RequiredPkgs Count="3">
+      <Item1>
+        <PackageName Value="IDEIntf"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="pascalscript"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="FCL"/>
+      </Item3>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <CustomOptions Items="ExternHelp" Version="2">
+      <_ExternHelp Items="Count"/>
+    </CustomOptions>
+  </Package>
+</CONFIG>

components/macroscript/editormacroscript.pas

@@ -0,0 +1,21 @@
+{ This file was automatically created by Lazarus. Do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit EditorMacroScript;
+
+interface
+
+uses
+  RegisterEMS, EMScriptMacro, EMScriptClasses, LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+  RegisterUnit('RegisterEMS', @RegisterEMS.Register);
+end;
+
+initialization
+  RegisterPackage('EditorMacroScript', @Register);
+end.

components/macroscript/emscriptclasses.pas

@@ -0,0 +1,193 @@
+unit EMScriptClasses;
+{
+  Classes that can be accessed from Scripts
+}
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, SynEdit, uPSCompiler, uPSRuntime;
+
+//type
+(*
+  { TSrcEdit }
+
+  TSrcEdit = class
+  private
+    FSynEdit: TCustomSynEdit;
+    function GetCaretX: Integer;
+    function GetCaretXY: TPoint;
+    function GetCaretY: Integer;
+    function GetLine(Y: Integer): String;
+    function GetLineAtCaret: String;
+    function GetLogicalCaretX: Integer;
+    function GetLogicalCaretXY: TPoint;
+    procedure SetCaretX(AValue: Integer);
+    procedure SetCaretXY(AValue: TPoint);
+    procedure SetCaretY(AValue: Integer);
+    procedure SetLogicalCaretX(AValue: Integer);
+    procedure SetLogicalCaretXY(AValue: TPoint);
+  public
+    // Method for macro use
+    property CaretXY: TPoint read GetCaretXY write SetCaretXY;
+    property CaretX: Integer read GetCaretX write SetCaretX;
+    property CaretY: Integer read GetCaretY write SetCaretY;
+    property LogicalCaretXY: TPoint read GetLogicalCaretXY write SetLogicalCaretXY;
+    property LogicalCaretX: Integer read GetLogicalCaretX write SetLogicalCaretX;
+    property Line[Y: Integer]: String read GetLine;
+    property LineAtCaret: String read GetLineAtCaret;
+  public
+    // Method  NOT  for macro use
+    constructor Create(ASynEdit: TCustomSynEdit);
+    property SynEdit: TCustomSynEdit read FSynEdit write FSynEdit;
+  end;
+*)
+
+procedure CompRegisterTSynEdit(Cl: TPSPascalCompiler);
+procedure ExecRegisterTSynEdit(cl: TPSRuntimeClassImporter);
+
+
+implementation
+
+
+
+procedure TSynEdit_CaretXY_W(Self: TSynEdit; const P: TPoint);
+begin   Self.CaretXY := P;   end;
+procedure TSynEdit_CaretXY_R(Self: TSynEdit; var P: TPoint);
+begin   P := Self.CaretXY;   end;
+
+procedure TSynEdit_CaretX_W(Self: TSynEdit; const I: Integer);
+begin   Self.CaretX := I;   end;
+procedure TSynEdit_CaretX_R(Self: TSynEdit; var I: Integer);
+begin   I := Self.CaretX;   end;
+
+procedure TSynEdit_CaretY_W(Self: TSynEdit; const I: Integer);
+begin   Self.CaretY := I;   end;
+procedure TSynEdit_CaretY_R(Self: TSynEdit; var I: Integer);
+begin   I := Self.CaretY;   end;
+
+procedure TSynEdit_LogicalCaretXY_W(Self: TSynEdit; const P: TPoint);
+begin   Self.LogicalCaretXY := P;   end;
+procedure TSynEdit_LogicalCaretXY_R(Self: TSynEdit; var P: TPoint);
+begin   P := Self.LogicalCaretXY;   end;
+
+procedure TSynEdit_LogicalCaretX_W(Self: TSynEdit; const I: Integer);
+begin   Self.LogicalCaretXY := Point(I, Self.CaretY);   end;
+procedure TSynEdit_LogicalCaretX_R(Self: TSynEdit; var I: Integer);
+begin   I := Self.LogicalCaretXY.X;   end;
+
+procedure TSynEdit_Lines_R(Self: TSynEdit; var S: string; I: Longint);
+begin   S := Self.Lines[I];   end;
+
+procedure TSynEdit_LineAtCaret_R(Self: TSynEdit; var S: string);
+begin   S := Self.Lines[Self.CaretY-1];   end;
+
+
+procedure CompRegisterTSynEdit(Cl: TPSPascalCompiler);
+begin
+  with Cl.AddClassN(cl.FindClass('TOBJECT'), 'TSynEdit') do
+  begin
+    RegisterProperty('CaretXY', 'TPoint', iptRW);
+    RegisterProperty('CaretX',  'Integer', iptRW);
+    RegisterProperty('CaretY',  'Integer', iptRW);
+    RegisterProperty('LogicalCaretXY', 'TPoint', iptRW);
+    RegisterProperty('LogicalCaretX',  'Integer', iptRW);
+    RegisterProperty('Lines', 'String Integer', iptR);
+
+    RegisterProperty('LineAtCaret', 'String', iptR);
+  end;
+end;
+
+procedure ExecRegisterTSynEdit(cl: TPSRuntimeClassImporter);
+begin
+  with Cl.Add(TSynEdit) do
+  begin
+    //RegisterConstructor(@TSynEdit.CREATE, 'CREATE');
+
+    RegisterPropertyHelper(@TSynEdit_CaretXY_R, @TSynEdit_CaretXY_W, 'CARETXY');
+    RegisterPropertyHelper(@TSynEdit_CaretX_R,  @TSynEdit_CaretX_W,  'CARETX');
+    RegisterPropertyHelper(@TSynEdit_CaretY_R,  @TSynEdit_CaretY_W,  'CARETY');
+    RegisterPropertyHelper(@TSynEdit_LogicalCaretXY_R, @TSynEdit_LogicalCaretXY_W, 'LOGICALCARETXY');
+    RegisterPropertyHelper(@TSynEdit_LogicalCaretX_R,  @TSynEdit_LogicalCaretX_W,  'LOGICALCARETX');
+    RegisterPropertyHelper(@TSynEdit_Lines_R, nil, 'LINES');
+
+    RegisterPropertyHelper(@TSynEdit_LineAtCaret_R, nil, 'LINEATCARET');
+  end;
+end;
+
+{ TSynEdit }
+(*
+function TSynEdit.GetCaretXY: TPoint;
+begin
+  Result := SynEdit.CaretXY;
+end;
+
+function TSynEdit.GetCaretX: Integer;
+begin
+  Result := SynEdit.CaretX;
+end;
+
+function TSynEdit.GetCaretY: Integer;
+begin
+  Result := SynEdit.CaretY;
+end;
+
+function TSynEdit.GetLine(Y: Integer): String;
+begin
+  if Y >= SynEdit.Lines.Count then begin
+    Result := '';
+    exit;
+  end;
+  Result := SynEdit.Lines[Y - 1];
+end;
+
+function TSynEdit.GetLineAtCaret: String;
+begin
+  Result := GetLine(SynEdit.CaretY);
+end;
+
+function TSynEdit.GetLogicalCaretX: Integer;
+begin
+  Result := SynEdit.LogicalCaretXY.X;
+end;
+
+function TSynEdit.GetLogicalCaretXY: TPoint;
+begin
+  Result := SynEdit.LogicalCaretXY;
+end;
+
+procedure TSynEdit.SetCaretX(AValue: Integer);
+begin
+  SynEdit.CaretX := AValue;
+end;
+
+procedure TSynEdit.SetCaretXY(AValue: TPoint);
+begin
+  SynEdit.CaretXY := AValue;
+end;
+
+procedure TSynEdit.SetCaretY(AValue: Integer);
+begin
+  SynEdit.CaretY := AValue;
+end;
+
+procedure TSynEdit.SetLogicalCaretX(AValue: Integer);
+begin
+  SynEdit.LogicalCaretXY := Point(AValue, SynEdit.CaretY);;
+end;
+
+procedure TSynEdit.SetLogicalCaretXY(AValue: TPoint);
+begin
+  SynEdit.LogicalCaretXY := AValue;
+end;
+
+constructor TSynEdit.Create(ASynEdit: TCustomSynEdit);
+begin
+  FSynEdit := ASynEdit;
+end;
+*)
+
+end.
+

components/macroscript/emscriptmacro.pas

@@ -0,0 +1,387 @@
+unit EMScriptMacro;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, SrcEditorIntf, SynEdit, SynEditKeyCmds, EMScriptClasses, Laz2_XMLCfg,
+  LazLoggerBase, uPSCompiler, uPSRuntime, uPSUtils, uPSC_std, uPSR_std;
+
+type
+
+  { TEMSEditorMacro }
+
+  TEMSEditorMacro = class(TEditorMacro)
+  private
+    FMacroName: String;
+    FSource: String;
+    FState: TEditorMacroState;
+    FHasError: Boolean;
+    FErrorMsg: String;
+    FKeyBinding: TEditorMacroKeyBinding;
+  protected
+    function  GetMacroName: String; override;
+    procedure SetMacroName(AValue: string); override;
+    function  GetState: TEditorMacroState; override;
+    function  GetErrorMsg: String; override;
+    function  GetKeyBinding: TEditorMacroKeyBinding; override;
+
+    procedure DoRecordMacro(aEditor: TCustomSynEdit); override;
+    procedure DoPlaybackMacro(aEditor: TCustomSynEdit); override;
+    procedure DoStop; override;
+    procedure DoPause; override;
+    procedure DoResume; override;
+
+    procedure Compile;
+    procedure FixBeginEnd;
+  public
+    constructor Create(aOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure AssignEventsFrom(AMacroRecorder: TEditorMacro); override;
+
+    procedure Clear; override;
+
+    function  GetAsSource: String; override;
+    procedure SetFromSource(const AText: String); override;
+    procedure WriteToXmlConf(AConf: TXMLConfig; const APath: String); override;
+    procedure ReadFromXmlConf(AConf: TXMLConfig; const APath: String); override;
+
+    function  IsEmpty: Boolean; override;
+    function  IsInvalid: Boolean; override;
+    function  IsRecording(AnEditor: TCustomSynEdit): Boolean; override;
+  end;
+
+
+  { TEMSTPSExec }
+
+  TEMSTPSExec = class(TPSExec)
+  public
+    SynEdit: TCustomSynEdit;
+    procedure AddECFuncToExecEnum(const s: String);
+  end;
+
+  { TEMSPSPascalCompiler }
+
+  TEMSPSPascalCompiler = class(TPSPascalCompiler)
+  public
+    procedure AddECFuncToCompEnum(const s: String);
+  end;
+
+implementation
+
+var
+  TheCompiler: TEMSPSPascalCompiler;
+  TheExec: TEMSTPSExec;
+  TheCLassImp: TPSRuntimeClassImporter;
+
+
+function HandleEcCommandFoo(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
+var
+  i: integer;
+  pt: TPoint;
+  e: TEMSTPSExec;
+begin
+  i := PtrUint(p.Ext2);
+  e := TEMSTPSExec(p.Ext1);
+  case i of
+    ecGotoXY, ecSelGotoXY:
+      begin
+        pt.x := Stack.GetInt(-1);
+        pt.y := Stack.GetInt(-2);
+        e.SynEdit.ExecuteCommand(i, '', @pt);
+      end;
+    ecChar:
+      e.SynEdit.ExecuteCommand(i, Stack.GetAnsiString(-1), nil);
+    else
+      e.SynEdit.ExecuteCommand(i, '', nil);
+  end;
+  Result := True;
+end;
+
+function HandleGetCaller(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
+var
+  e: TEMSTPSExec;
+begin
+  e := TEMSTPSExec(p.Ext1);
+  Stack.SetClass(-1, e.SynEdit);
+end;
+
+function CompilerOnUses(Sender: TPSPascalCompiler; const Name: TbtString): Boolean;
+begin
+  if Name = 'SYSTEM' then
+  begin
+    SIRegisterTObject(Sender);
+    //SIRegister_Std(Sender);
+    if Sender is TEMSPSPascalCompiler then
+      GetEditorCommandValues(@TEMSPSPascalCompiler(Sender).AddECFuncToCompEnum);
+
+    CompRegisterTSynEdit(TheCompiler);
+    Sender.AddFunction('function Caller: TSynEdit;');
+
+    Result := True;
+  end else
+    Result := False;
+end;
+
+procedure AddECFuncToExec;
+begin
+  GetEditorCommandValues(@TheExec.AddECFuncToExecEnum);
+  ExecRegisterTSynEdit(TheCLassImp);
+  TheExec.RegisterFunctionName('CALLER', @HandleGetCaller, TheExec, nil);
+end;
+
+
+{ Create global objects }
+
+procedure CreateCompiler;
+begin
+  TheCompiler := TEMSPSPascalCompiler.Create;
+  TheCompiler.OnUses := @CompilerOnUses;
+end;
+
+procedure CreateExec;
+begin
+  TheExec := TEMSTPSExec.Create;
+  TheCLassImp := TPSRuntimeClassImporter.Create;
+  RIRegisterTObject(TheCLassImp);
+  // ## RIRegister_Std(CL);
+
+  AddECFuncToExec;
+
+  RegisterClassLibraryRuntime(TheExec, TheCLassImp);
+end;
+
+{ TEMSPSPascalCompiler }
+
+procedure TEMSPSPascalCompiler.AddECFuncToCompEnum(const s: String);
+begin
+  if (s = 'ecSynMacroPlay') or (s = 'ecSynMacroRecord') then exit;
+
+  if (s = 'ecGotoXY') or (s = 'ecSelGotoXY') then
+    AddFunction('procedure '+s+'(X, Y: Integer);')
+  else
+  if  (s = 'ecChar') then
+    AddFunction('procedure '+s+'(s: string);')
+    // ecString
+  else
+    AddFunction('procedure '+s+';');
+end;
+
+{ TEMSTPSExec }
+
+procedure TEMSTPSExec.AddECFuncToExecEnum(const s: String);
+var
+  i: longint;
+begin
+  i := 0;
+  if not IdentToEditorCommand(s, i) then exit;
+  TheExec.RegisterFunctionName(UpperCase(s), @HandleEcCommandFoo, self, Pointer(PtrUInt(i)));
+end;
+
+
+{ TEMSEditorMacro }
+
+function TEMSEditorMacro.GetMacroName: String;
+begin
+  Result := FMacroName;
+end;
+
+procedure TEMSEditorMacro.SetMacroName(AValue: string);
+begin
+  FMacroName := AValue;
+  DoChanged;
+end;
+
+function TEMSEditorMacro.GetState: TEditorMacroState;
+begin
+  Result := FState;
+end;
+
+function TEMSEditorMacro.GetErrorMsg: String;
+begin
+  Result := FErrorMsg;
+end;
+
+function TEMSEditorMacro.GetKeyBinding: TEditorMacroKeyBinding;
+begin
+  if FKeyBinding = nil then
+    FKeyBinding := GetDefaultKeyBinding;
+  Result := FKeyBinding;
+end;
+
+procedure TEMSEditorMacro.DoRecordMacro(aEditor: TCustomSynEdit);
+begin
+  // Not supported
+end;
+
+procedure TEMSEditorMacro.DoPlaybackMacro(aEditor: TCustomSynEdit);
+var
+  s: tbtString;
+begin
+  if IsEmpty or IsInvalid then exit;
+
+  FState := emPlaying;
+  if Assigned(OnStateChange) then
+    OnStateChange(Self);
+
+  try
+    Compile;
+    if IsInvalid then exit;
+
+    TheCompiler.GetOutput(s);
+    if not TheExec.LoadData(s) then // Load the data from the Data string.
+      exit;
+
+    TheExec.SynEdit := aEditor;
+    TheExec.RunScript
+
+  finally
+    FState := emStopped;
+    if Assigned(OnStateChange) then
+      OnStateChange(Self);
+  end;
+end;
+
+procedure TEMSEditorMacro.DoStop;
+begin
+
+end;
+
+procedure TEMSEditorMacro.DoPause;
+begin
+  // Not supported
+end;
+
+procedure TEMSEditorMacro.DoResume;
+begin
+  // Not supported
+end;
+
+procedure TEMSEditorMacro.Compile;
+var
+  i: Integer;
+begin
+  FHasError := False;
+  FErrorMsg := '';
+  TheCompiler.Clear;
+
+
+  if not TheCompiler.Compile(FSource) then
+  begin
+    for i := 0 to TheCompiler.MsgCount -1 do
+      FErrorMsg := FErrorMsg + TheCompiler.Msg[i].MessageToString + LineEnding;
+    FHasError := True;
+  end;
+end;
+
+procedure TEMSEditorMacro.FixBeginEnd;
+begin
+  if (not IsEmpty) and (not IsInvalid) then
+  begin
+    if (pos('begin', FSource) < 1) or (pos('end.', FSource) < 1) then
+      FSource := 'begin' + LineEnding + FSource + 'end.'+LineEnding;
+  end;
+end;
+
+constructor TEMSEditorMacro.Create(aOwner: TComponent);
+begin
+  FState := emStopped;
+end;
+
+destructor TEMSEditorMacro.Destroy;
+begin
+  inherited Destroy;
+  FreeAndNil(FKeyBinding);
+end;
+
+procedure TEMSEditorMacro.AssignEventsFrom(AMacroRecorder: TEditorMacro);
+begin
+  FHasError := False;
+  if AMacroRecorder = nil then
+    Clear
+  else
+    FSource := AMacroRecorder.GetAsSource;
+
+  if not(AMacroRecorder is TEMSEditorMacro) then
+    FixBeginEnd;
+  Compile;
+  DoChanged;
+end;
+
+procedure TEMSEditorMacro.Clear;
+begin
+  FSource := '';
+  FHasError := False;
+  DoChanged;
+end;
+
+function TEMSEditorMacro.GetAsSource: String;
+begin
+  Result := FSource;
+end;
+
+procedure TEMSEditorMacro.SetFromSource(const AText: String);
+begin
+  FSource := AText;
+  Compile;
+  DoChanged;
+end;
+
+procedure TEMSEditorMacro.WriteToXmlConf(AConf: TXMLConfig; const APath: String);
+begin
+  AConf.SetValue(APath + 'Name', MacroName);
+  AConf.SetValue(APath + 'Code/Value', GetAsSource);
+
+  if (KeyBinding <> nil) then
+    KeyBinding.WriteToXmlConf(AConf, APath);
+end;
+
+procedure TEMSEditorMacro.ReadFromXmlConf(AConf: TXMLConfig; const APath: String);
+var
+  s: String;
+begin
+  s := AConf.GetValue(APath + 'Code/Value', '');
+  FSource := s;
+  FixBeginEnd;
+  Compile;
+  s := AConf.GetValue(APath + 'Name', '');
+  if s <> '' then MacroName := s;
+
+  if (not FHasError) and (IsEmpty) then begin
+    FHasError := True;
+    FErrorMsg := s;
+  end;
+
+  if (KeyBinding <> nil) then
+    KeyBinding.ReadFromXmlConf(AConf, APath);
+
+  DoChanged;
+end;
+
+function TEMSEditorMacro.IsEmpty: Boolean;
+begin
+  Result := FSource = '';
+end;
+
+function TEMSEditorMacro.IsInvalid: Boolean;
+begin
+  Result := FHasError;
+end;
+
+function TEMSEditorMacro.IsRecording(AnEditor: TCustomSynEdit): Boolean;
+begin
+  Result := False;
+end;
+
+initialization
+  CreateCompiler;
+  CreateExec;
+
+finalization
+  FreeAndNil(TheExec);
+  FreeAndNil(TheCLassImp);
+  FreeAndNil(TheCompiler);
+
+end.
+

components/macroscript/registerems.pas

@@ -0,0 +1,23 @@
+unit RegisterEMS;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, SrcEditorIntf, EMScriptMacro;
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+end;
+
+initialization
+  // Register is to late
+  EditorMacroPlayerClass := TEMSEditorMacro;
+
+end.
+

packager/globallinks/editormacroscript-0.lpl

@@ -0,0 +1 @@
+$(LazarusDir)/components/macroscript/editormacroscript.lpk