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

Editor Macro Pascal: use part bool eval / alternative call handler

Browse Source 
git-svn-id: trunk@41434 -
This commit is contained in:
martin 2013-05-27 16:34:49 +00:00
parent b7294f4245
commit 30d5dbff49
3 changed files with 178 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

151
components/macroscript/emscriptclasses.pas
View File

@ -12,8 +12,11 @@ interface
{$ENDIF}
uses
Classes, SysUtils, SynEdit, SynEditTypes, Clipbrd, Dialogs, Controls, uPSCompiler,
uPSRuntime, uPSUtils;
Classes, SysUtils, SynEdit, SynEditTypes, LazLoggerBase, Clipbrd, Dialogs, Controls,
uPSCompiler, uPSRuntime, uPSUtils;
type
TEMScriptBadParamException = Exception;
procedure CompRegisterBasics(AComp: TPSPascalCompiler);
procedure ExecRegisterBasics(AExec: TPSExec);
@ -76,7 +79,7 @@ begin
end;
const
DeclMessageDlg = 'Function MessageDlg(Msg: string; DlgType :TMsgDlgType; Buttons :TMsgDlgButtons; HelpCtx: Longint): Integer'; //
DeclMessageDlg = 'Function MessageDlg(Msg: string; DlgType :TMsgDlgType; Buttons :TMsgDlgButtons; HelpCtx: Longint): Integer';
DeclMessageDlgPos = 'Function MessageDlgPos(Msg: string; DlgType :TMsgDlgType; Buttons :TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Integer';
DeclMessageDlgPosHelp = 'Function MessageDlgPosHelp(Msg: string; DlgType :TMsgDlgType; Buttons :TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; HelpFileName: string): Integer';
DeclShowMessage = 'Procedure ShowMessage(Msg: string)';
@ -138,21 +141,148 @@ begin
AComp.AddDelphiFunction(Decltest_ord_mt);
end;
function ExecBasicHandler(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
function GetSetFromStack(Idx: Integer): Cardinal;
var
val: PPSVariant;
dat: Pointer;
begin
if Idx < 0 then Idx := Idx + Stack.Count;
val := Stack[Idx];
if val^.FType.BaseType <> btSet then raise TEMScriptBadParamException.Create('Invalid set');
dat := @PPSVariantData(val)^.Data;
Result := tbtu32(dat^);
end;
function GetEnumFromStack(Idx: Integer): Cardinal;
var
val: PPSVariant;
dat: Pointer;
begin
if Idx < 0 then Idx := Idx + Stack.Count;
val := Stack[Idx];
if val^.FType.BaseType <> btEnum then raise TEMScriptBadParamException.Create('Invalid set');
dat := @PPSVariantData(val)^.Data;
Result := tbtu32(dat^);
end;
var
res: PPSVariant;
data: Pointer;
temp: TPSVariantIFC;
s: String;
typerec: TPSTypeRec;
begin
Result := True;
case Longint(p.Ext1) of
0: begin // POINT()
if Stack.Count < 3 then raise TEMScriptBadParamException.Create('Invalid param count for "Point"');;
res := Stack[Stack.Count-1];
typerec := res^.FType;
if typerec.BaseType = btPointer then begin
typerec := PPSVariantPointer(res)^.DestType;
data := PPSVariantPointer(res)^.DataDest;
end
else
data := @(PPSVariantRecord(res)^.data);
if typerec.BaseType <> btRecord then raise TEMScriptBadParamException.Create('Invalid result type for "point(x,y)"');
if typerec.RealSize <> SizeOf(TPoint) then raise TEMScriptBadParamException.Create('Invalid result size for "point(x,y)"');
if data = nil then raise TEMScriptBadParamException.Create('Invalid result data for "point(x,y)"');
TPoint(data^) := Point(Stack.GetInt(-2), Stack.GetInt(-3));
end;
50: begin // MessageDlg(Msg: string; DlgType :TMsgDlgType; Buttons :TMsgDlgButtons; HelpCtx: Longint): Integer';
if Stack.Count < 5 then raise TEMScriptBadParamException.Create('Invalid param count for "MessageDlg"');;
Stack.SetInt(-1,
MessageDlg(Stack.GetAnsiString(-2), TMsgDlgType(Stack.GetUInt(-3)),
TMsgDlgButtons(GetSetFromStack(-4)), Stack.GetInt(-5))
);
end;
51: begin // MessageDlgPos(Msg: string; DlgType :TMsgDlgType; Buttons :TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Integer
if Stack.Count < 7 then raise TEMScriptBadParamException.Create('Invalid param count for "MessageDlgPos"');;
Stack.SetInt(-1,
MessageDlgPos(Stack.GetAnsiString(-2), TMsgDlgType(Stack.GetUInt(-3)),
TMsgDlgButtons(GetSetFromStack(-4)), Stack.GetInt(-5),
Stack.GetInt(-6), Stack.GetInt(-7) )
);
end;
52: begin // MessageDlgPosHelp(Msg: string; DlgType :TMsgDlgType; Buttons :TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; HelpFileName: string): Integer
if Stack.Count < 8 then raise TEMScriptBadParamException.Create('Invalid param count for "MessageDlgPosHelp"');;
Stack.SetInt(-1,
MessageDlgPosHelp(Stack.GetAnsiString(-2), TMsgDlgType(Stack.GetUInt(-3)),
TMsgDlgButtons(GetSetFromStack(-4)), Stack.GetInt(-5),
Stack.GetInt(-6), Stack.GetInt(-7), Stack.GetAnsiString(-8))
);
end;
53: begin // ShowMessage(Msg: string)
if Stack.Count < 1 then raise TEMScriptBadParamException.Create('Invalid param count for "ShowMessage"');;
ShowMessage(Stack.GetAnsiString(-1));
end;
54: begin // ShowMessagePos(Msg: string; X, Y :Integer)
if Stack.Count < 3 then raise TEMScriptBadParamException.Create('Invalid param count for "ShowMessagePos"');;
ShowMessagePos(Stack.GetAnsiString(-1), Stack.GetInt(-2), Stack.GetInt(-3));
end;
55: begin // InputBox(ACaption, APrompt, ADefault: string): string
if Stack.Count < 4 then raise TEMScriptBadParamException.Create('Invalid param count for "InputBox"');;
Stack.SetAnsiString(-1,
InputBox(Stack.GetAnsiString(-2), Stack.GetAnsiString(-3), Stack.GetAnsiString(-4))
);
end;
56: begin // InputQuery(ACaption, APrompt: string; var Value: string): Boolean
if Stack.Count < 4 then raise TEMScriptBadParamException.Create('Invalid param count for "InputQuery"');
temp := NewTPSVariantIFC(Stack[Stack.Count-4], True);
if (temp.aType.BaseType <> btString) then raise TEMScriptBadParamException.Create('Invalid param type for "InputQuery"');
if (temp.Dta = nil) then raise TEMScriptBadParamException.Create('Invalid param data for "InputQuery"');
s := tbtstring(temp.Dta^);
Stack.SetBool(-1,
InputQuery(Stack.GetAnsiString(-2), Stack.GetAnsiString(-3), s)
);
tbtstring(temp.Dta^) := s;
end;
900: begin // test_ord_mb(ABtn: TMsgDlgBtn): Integer;
if Stack.Count < 2 then raise TEMScriptBadParamException.Create('Invalid param count for "test_ord_mb"');
Stack.SetInt(-1, test_ord_mb(TMsgDlgBtn(Stack.GetUInt(-2))) );
end;
901: begin // test_ord_mt(AType: TMsgDlgType): Integer;
if Stack.Count < 2 then raise TEMScriptBadParamException.Create('Invalid param count for "test_ord_mt"');
// Stack[Stack.Count-2]^.FType.ExportName = 'TMSGDLGTYPE'
Stack.SetInt(-1, test_ord_mt(TMsgDlgType(Stack.GetUInt(-2))) );
end;
else
Result := False;
end;
end;
procedure ExecRegisterBasics(AExec: TPSExec);
begin
{$IFnDEF PasMacroNoNativeCalls}
AExec.RegisterDelphiFunction(FuncPoint, 'POINT', cdRegister);
AExec.RegisterDelphiFunction(FuncMessageDlg, 'MessageDlg', cdRegister);
AExec.RegisterDelphiFunction(FuncMessageDlgPos, 'MessageDlgPos', cdRegister);
AExec.RegisterDelphiFunction(FuncMessageDlgPosHelp, 'MessageDlgPosHelp', cdRegister);
AExec.RegisterDelphiFunction(FuncShowMessage, 'ShowMessage', cdRegister);
AExec.RegisterDelphiFunction(FuncShowMessagePos, 'ShowMessagePos', cdRegister);
AExec.RegisterDelphiFunction(FuncInputBox, 'InputBox', cdRegister);
AExec.RegisterDelphiFunction(FuncInputQuery, 'InputQuery', cdRegister);
AExec.RegisterDelphiFunction(FuncMessageDlg, 'MessageDlg', cdRegister);
AExec.RegisterDelphiFunction(FuncMessageDlgPos, 'MessageDlgPos', cdRegister);
AExec.RegisterDelphiFunction(FuncMessageDlgPosHelp, 'MessageDlgPosHelp', cdRegister);
AExec.RegisterDelphiFunction(FuncShowMessage, 'ShowMessage', cdRegister);
AExec.RegisterDelphiFunction(FuncShowMessagePos, 'ShowMessagePos', cdRegister);
AExec.RegisterDelphiFunction(FuncInputBox, 'InputBox', cdRegister);
AExec.RegisterDelphiFunction(FuncInputQuery, 'InputQuery', cdRegister);
// for tests
AExec.RegisterDelphiFunction(Functest_ord_mb, 'test_ord_mb', cdRegister);
AExec.RegisterDelphiFunction(Functest_ord_mt, 'test_ord_mt', cdRegister);
{$ELSE}
AExec.RegisterFunctionName('POINT', @ExecBasicHandler, Pointer(0), nil);
AExec.RegisterFunctionName('MessageDlg', @ExecBasicHandler, Pointer(50), nil);
AExec.RegisterFunctionName('MessageDlgPos', @ExecBasicHandler, Pointer(51), nil);
AExec.RegisterFunctionName('MessageDlgPosHelp', @ExecBasicHandler, Pointer(52), nil);
AExec.RegisterFunctionName('ShowMessage', @ExecBasicHandler, Pointer(53), nil);
AExec.RegisterFunctionName('ShowMessagePos', @ExecBasicHandler, Pointer(54), nil);
AExec.RegisterFunctionName('InputBox', @ExecBasicHandler, Pointer(55), nil);
AExec.RegisterFunctionName('InputQuery', @ExecBasicHandler, Pointer(56), nil);
// for tests
AExec.RegisterFunctionName('test_ord_mb', @ExecBasicHandler, Pointer(900), nil);
AExec.RegisterFunctionName('test_ord_mt', @ExecBasicHandler, Pointer(901), nil);
{$ENDIF}
end;
{ SynEdit }
@ -495,4 +625,3 @@ end;
end.

36
components/macroscript/emscriptmacro.pas
View File

@ -5,9 +5,9 @@ unit EMScriptMacro;
interface
uses
Classes, SysUtils, SrcEditorIntf, IDECommands, Controls, SynEdit, SynEditKeyCmds,
EMScriptClasses, Laz2_XMLCfg, LazLoggerBase, uPSCompiler, uPSRuntime, uPSUtils, uPSC_std,
uPSR_std;
Classes, SysUtils, SrcEditorIntf, IDECommands, IDEMsgIntf, Controls, SynEdit,
SynEditKeyCmds, EMScriptClasses, Laz2_XMLCfg, LazLoggerBase, uPSCompiler, uPSRuntime,
uPSUtils, uPSC_std, uPSR_std, uPSDebugger;
type
@ -56,7 +56,7 @@ type
{ TEMSTPSExec }
TEMSTPSExec = class(TPSExec)
TEMSTPSExec = class(TPSDebugExec)
public
SynEdit: TCustomSynEdit;
procedure AddECFuncToExecEnum(const s: String);
@ -147,6 +147,7 @@ procedure CreateCompiler;
begin
TheCompiler := TEMSPSPascalCompiler.Create;
TheCompiler.OnUses := @CompilerOnUses;
TheCompiler.BooleanShortCircuit := True;
end;
procedure CreateExec;
@ -226,7 +227,9 @@ end;
procedure TEMSEditorMacro.DoPlaybackMacro(aEditor: TWinControl);
var
s: tbtString;
s, s2: tbtString;
ExObj: TObject;
i, x, y: Cardinal;
begin
if IsEmpty or IsInvalid then exit;
@ -241,9 +244,30 @@ begin
TheCompiler.GetOutput({%H-}s);
if not TheExec.LoadData(s) then // Load the data from the Data string.
exit;
TheCompiler.GetDebugOutput({%H-}s2);
TheExec.LoadDebugData(s2);
TheExec.SynEdit := aEditor as TCustomSynEdit;
TheExec.RunScript
try
TheExec.RunScript;
except
on e: Exception do
IDEMessagesWindow.AddMsg(Format('%s: %s', [e.ClassName, e.Message]), '', -1);
end;
if TheExec.ExceptionCode <> erNoError then begin
ExObj := TheExec.ExceptionObject;
if ExObj <> nil then
s := ExObj.ClassName
else
s := '<nil>';
s2 := '';
i := 0;
x := 0;
y := 0;
TheExec.TranslatePositionEx(TheExec.ExceptionProcNo, TheExec.ExceptionPos, i, x, y, s2);
if IDEMessagesWindow <> nil then
IDEMessagesWindow.AddMsg(Format('%s: "%s" at %d/%d', [s, TheExec.ExceptionString, x,y]), '', -1);
end;
finally
FState := emStopped;

8
components/macroscript/test/testscriptprocs.pas
View File

@ -635,6 +635,14 @@ begin
'end.',
'do NOT replace me');
DoTestSimple('InputQuery Cancel', '',
'var s: string; begin '+ LineEnding +
's := '''';' + LineEnding +
'if InputQuery(''Need Input'', ''enter 123 / press OK'', s)' + LineEnding +
'then Caller.InsertTextAtCaret(s, scamEnd);' + LineEnding +
'end.',
'123');
finally
FTestMacro.Free;