paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 10:36:01 +02:00
Code Issues Packages Projects Releases Wiki Activity

EditorMacros: create PascalScript based macros

Browse Source 
git-svn-id: trunk@38393 -
This commit is contained in:
martin 2012-08-26 22:09:35 +00:00
parent c34825f8a2
commit d0d2b1b546
7 changed files with 689 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
.gitattributes vendored
View File

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

58
components/macroscript/editormacroscript.lpk Normal file
View File

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

21
components/macroscript/editormacroscript.pas Normal file
View File

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

193
components/macroscript/emscriptclasses.pas Normal file
View File

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

387
components/macroscript/emscriptmacro.pas Normal file
View File

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

23
components/macroscript/registerems.pas Normal file
View File

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

1
packager/globallinks/editormacroscript-0.lpl Normal file
View File

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