paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-08 19:38:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

EditorMacroScript: Refactor and use "Register" procedure

Browse Source 
git-svn-id: trunk@42195 -
This commit is contained in:
martin 2013-07-24 11:11:39 +00:00
parent e96caf8f0b
commit 68351f16ff
4 changed files with 197 additions and 145 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

205
components/macroscript/emscriptclasses.pas
View File

@ -12,20 +12,49 @@ interface
{$ENDIF}
uses
Classes, SysUtils, SynEdit, SynEditTypes, LazLoggerBase, Clipbrd, Dialogs, Controls,
uPSCompiler, uPSRuntime, uPSUtils;
Classes, SysUtils, SynEdit, SynEditTypes, SynEditKeyCmds, LazLoggerBase, IDECommands,
Clipbrd, Dialogs, Controls, uPSCompiler, uPSRuntime, uPSUtils, uPSDebugger, uPSR_std,
uPSC_std;
type
TEMScriptBadParamException = Exception;
{ TEMSTPSExec }
TEMSTPSExec = class(TPSDebugExec)
public
SynEdit: TCustomSynEdit;
CLassImp: TPSRuntimeClassImporter;
constructor Create;
destructor Destroy; override;
procedure AddECFuncToExecEnum(const s: String); // ec... commands
procedure AddFuncToExec;
procedure AddTestFuncToExec;
end;
{ TEMSPSPascalCompiler }
TEMSPSPascalCompiler = class(TPSPascalCompiler)
public
procedure AddECFuncToCompEnum(const s: String);
constructor Create;
end;
procedure CompRegisterBasics(AComp: TPSPascalCompiler);
procedure ExecRegisterBasics(AExec: TPSExec);
procedure ExecRegisterBasics(AExec: TEMSTPSExec);
procedure CompRegisterTSynEdit(AComp: TPSPascalCompiler);
procedure ExecRegisterTSynEdit(cl: TPSRuntimeClassImporter);
procedure ExecRegisterTSynEdit(AExec: TEMSTPSExec);
procedure CompRegisterTClipboard(AComp: TPSPascalCompiler);
procedure ExecRegisterTClipboard(cl: TPSRuntimeClassImporter; AExec: TPSExec);
procedure ExecRegisterTClipboard(AExec: TEMSTPSExec);
procedure CompRegisterSelfTests(AComp: TPSPascalCompiler);
procedure ExecRegisterSelfTests(AExec: TEMSTPSExec);
implementation
@ -33,6 +62,133 @@ implementation
type TPoint2 = record x,y,a,b,c: Longint; end;
{$ENDIF}
{ TEMSPSPascalCompiler }
function CompilerOnUses(Sender: TPSPascalCompiler; const Name: TbtString): Boolean;
begin
if Name = 'SYSTEM' then
begin
SIRegisterTObject(Sender);
//SIRegister_Std(Sender);
if Sender is TEMSPSPascalCompiler then begin
GetEditorCommandValues(@TEMSPSPascalCompiler(Sender).AddECFuncToCompEnum);
GetIDEEditorCommandValues(@TEMSPSPascalCompiler(Sender).AddECFuncToCompEnum);
CompRegisterBasics(TEMSPSPascalCompiler(Sender));
CompRegisterTSynEdit(TEMSPSPascalCompiler(Sender));
Sender.AddFunction('function Caller: TSynEdit;');
CompRegisterTClipboard(TEMSPSPascalCompiler(Sender));
end;
Result := True;
end else
Result := False;
end;
function TestCompilerOnUses(Sender: TPSPascalCompiler; const Name: TbtString): Boolean;
begin
Result := CompilerOnUses(Sender, Name);
if Result then
CompRegisterSelfTests(TEMSPSPascalCompiler(Sender));
end;
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;
constructor TEMSPSPascalCompiler.Create;
begin
inherited Create;
OnUses := @CompilerOnUses;
BooleanShortCircuit := True;
end;
{ TEMSTPSExec }
function HandleGetCaller({%H-}Caller: TPSExec; p: TPSExternalProcRec; {%H-}Global, Stack: TPSStack): Boolean;
var
e: TEMSTPSExec;
begin
e := TEMSTPSExec(p.Ext1);
Stack.SetClass(-1, e.SynEdit);
Result := True;
end;
function HandleEcCommandFoo({%H-}Caller: TPSExec; p: TPSExternalProcRec; {%H-}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.CommandProcessor(i, '', @pt);
end;
ecChar:
e.SynEdit.CommandProcessor(i, Stack.GetAnsiString(-1), nil);
else
e.SynEdit.CommandProcessor(i, '', nil);
end;
Result := True;
end;
constructor TEMSTPSExec.Create;
begin
inherited Create;
CLassImp := TPSRuntimeClassImporter.Create;
RIRegisterTObject(CLassImp);
// ## RIRegister_Std(CL);
AddFuncToExec;
RegisterClassLibraryRuntime(Self, CLassImp);
end;
destructor TEMSTPSExec.Destroy;
begin
inherited Destroy;
FreeAndNil(CLassImp);
end;
procedure TEMSTPSExec.AddECFuncToExecEnum(const s: String);
var
i: longint;
begin
i := 0;
if not IdentToEditorCommand(s, i) then exit;
RegisterFunctionName(UpperCase(s), @HandleEcCommandFoo, self, Pointer(PtrUInt(i)));
end;
procedure TEMSTPSExec.AddFuncToExec;
begin
GetEditorCommandValues(@AddECFuncToExecEnum);
GetIDEEditorCommandValues(@AddECFuncToExecEnum);
ExecRegisterBasics(Self);
ExecRegisterTSynEdit(Self);
RegisterFunctionName('CALLER', @HandleGetCaller, Self, nil);
ExecRegisterTClipboard(Self);
end;
procedure TEMSTPSExec.AddTestFuncToExec;
begin
ExecRegisterSelfTests(Self);
end;
{%region RegisterBasics}
Function EMS_MessageDlg(Msg: string; DlgType :TMsgDlgType; Buttons :TMsgDlgButtons; HelpCtx: Longint): Integer;
begin
Result := MessageDlg(Msg, DlgType, Buttons, HelpCtx);
@ -141,7 +297,7 @@ begin
AComp.AddDelphiFunction(Decltest_ord_mt);
end;
function ExecBasicHandler(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
function ExecBasicHandler({%H-}Caller: TPSExec; p: TPSExternalProcRec; {%H-}Global, Stack: TPSStack): Boolean;
function GetSetFromStack(Idx: Integer): Cardinal;
var
val: PPSVariant;
@ -252,7 +408,7 @@ begin
end;
end;
procedure ExecRegisterBasics(AExec: TPSExec);
procedure ExecRegisterBasics(AExec: TEMSTPSExec);
begin
{$IFnDEF PasMacroNoNativeCalls}
AExec.RegisterDelphiFunction(FuncPoint, 'POINT', cdRegister);
@ -285,9 +441,11 @@ begin
{$ENDIF}
end;
{ SynEdit }
{%region SynEdit}
{%endregion RegisterBasics}
{%region RegisterTSynEdit}
{%region SynEdit class wrappers}
// Caret
procedure TSynEdit_CaretXY_W(Self: TSynEdit; P: TPoint); begin Self.CaretXY := P; end;
@ -462,7 +620,7 @@ begin
Result := PhysicalLineLength(Line, Index);
end;
{%endregion}
{%endregion}
procedure CompRegisterTSynEdit(AComp: TPSPascalCompiler);
begin
@ -534,9 +692,9 @@ begin
end;
end;
procedure ExecRegisterTSynEdit(cl: TPSRuntimeClassImporter);
procedure ExecRegisterTSynEdit(AExec: TEMSTPSExec);
begin
with Cl.Add(TSynEdit) do
with AExec.CLassImp.Add(TSynEdit) do
begin
// Caret
RegisterPropertyHelper(@TSynEdit_CaretXY_R, @TSynEdit_CaretXY_W, 'CARETXY');
@ -587,7 +745,9 @@ begin
end;
end;
(* ClipBoard *)
{%endregion RegisterTSynEdit}
{%region RegisterTClipboard}
function HandleGetClipboard({%H-}Caller: TPSExec; {%H-}p: TPSExternalProcRec; {%H-}Global, Stack: TPSStack): Boolean;
//var
@ -613,9 +773,9 @@ begin
AComp.AddFunction('function Clipboard: TClipboard;');
end;
procedure ExecRegisterTClipboard(cl: TPSRuntimeClassImporter; AExec: TPSExec);
procedure ExecRegisterTClipboard(AExec: TEMSTPSExec);
begin
with Cl.Add(TClipboard) do
with AExec.CLassImp.Add(TClipboard) do
begin
RegisterPropertyHelper(@TClipboard_AsText_R, @TClipboard_AsText_W, 'ASTEXT');
end;
@ -623,5 +783,20 @@ begin
AExec.RegisterFunctionName('CLIPBOARD', @HandleGetClipboard, AExec, nil);
end;
{%endregion RegisterTClipboard}
{%region RegisterSelfTests}
procedure CompRegisterSelfTests(AComp: TPSPascalCompiler);
begin
end;
procedure ExecRegisterSelfTests(AExec: TEMSTPSExec);
begin
end;
{%endregion RegisterSelfTests}
end.

126
components/macroscript/emscriptmacro.pas
View File

@ -5,9 +5,8 @@ unit EMScriptMacro;
interface
uses
Classes, SysUtils, SrcEditorIntf, IDECommands, IDEMsgIntf, Controls, SynEdit,
SynEditKeyCmds, EMScriptClasses, Laz2_XMLCfg, LazLoggerBase, uPSCompiler, uPSRuntime,
uPSUtils, uPSC_std, uPSR_std, uPSDebugger;
Classes, SysUtils, SrcEditorIntf, IDEMsgIntf, Controls, SynEdit, EMScriptClasses, Laz2_XMLCfg, uPSRuntime,
uPSUtils, LazLoggerBase;
type
@ -37,7 +36,7 @@ type
procedure Compile;
procedure FixBeginEnd;
public
constructor Create(aOwner: TComponent); override;
constructor Create({%H-}aOwner: TComponent); override;
destructor Destroy; override;
procedure AssignEventsFrom(AMacroRecorder: TEditorMacro); override;
@ -54,142 +53,24 @@ type
end;
{ TEMSTPSExec }
TEMSTPSExec = class(TPSDebugExec)
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({%H-}Caller: TPSExec; p: TPSExternalProcRec; {%H-}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.CommandProcessor(i, '', @pt);
end;
ecChar:
e.SynEdit.CommandProcessor(i, Stack.GetAnsiString(-1), nil);
else
e.SynEdit.CommandProcessor(i, '', nil);
end;
Result := True;
end;
function HandleGetCaller({%H-}Caller: TPSExec; p: TPSExternalProcRec; {%H-}Global, Stack: TPSStack): Boolean;
var
e: TEMSTPSExec;
begin
e := TEMSTPSExec(p.Ext1);
Stack.SetClass(-1, e.SynEdit);
Result := True;
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 begin
GetEditorCommandValues(@TEMSPSPascalCompiler(Sender).AddECFuncToCompEnum);
GetIDEEditorCommandValues(@TEMSPSPascalCompiler(Sender).AddECFuncToCompEnum);
end;
CompRegisterBasics(TheCompiler);
CompRegisterTSynEdit(TheCompiler);
Sender.AddFunction('function Caller: TSynEdit;');
CompRegisterTClipboard(TheCompiler);
Result := True;
end else
Result := False;
end;
procedure AddECFuncToExec;
begin
GetEditorCommandValues(@TheExec.AddECFuncToExecEnum);
GetIDEEditorCommandValues(@TheExec.AddECFuncToExecEnum);
ExecRegisterBasics(TheExec);
ExecRegisterTSynEdit(TheCLassImp);
TheExec.RegisterFunctionName('CALLER', @HandleGetCaller, TheExec, nil);
ExecRegisterTClipboard(TheCLassImp, TheExec);
end;
{ Create global objects }
procedure CreateCompiler;
begin
TheCompiler := TEMSPSPascalCompiler.Create;
TheCompiler.OnUses := @CompilerOnUses;
TheCompiler.BooleanShortCircuit := True;
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;
@ -413,7 +294,6 @@ initialization
finalization
FreeAndNil(TheExec);
FreeAndNil(TheCLassImp);
FreeAndNil(TheCompiler);
end.

5
components/macroscript/registerems.pas
View File

@ -13,11 +13,8 @@ implementation
procedure Register;
begin
end;
initialization
// Register is to late
EditorMacroPlayerClass := TEMSEditorMacro;
end;
end.

6
ide/main.pp
View File

@ -1271,9 +1271,6 @@ begin
SetupIDEMsgQuickFixItems;
EditorOpts.Load;
EditorMacroListViewer.LoadGlobalInfo;
// Defered till created
//EditorMacroListViewer.OnKeyMapReloaded := @SourceEditorManager.ReloadEditorOptions;
ExternalTools.LoadShortCuts(EditorOpts.KeyMap);
@ -1426,6 +1423,9 @@ begin
// load installed packages
PkgBoss.LoadInstalledPackages;
EditorMacroListViewer.LoadGlobalInfo; // Must be after packages are loaded/registered.
FormEditor1.RegisterFrame;
{$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TMainIDE.Create INSTALLED COMPONENTS');{$ENDIF}