First working concept.

This commit is contained in:
Merlijn Wajer 2010-03-16 00:31:03 +01:00
parent ec2e00a057
commit 0f25bc7d06
4 changed files with 86 additions and 46 deletions

16
Extensions/test.pas Normal file
View File

@ -0,0 +1,16 @@
program new;
{ Creating TForm crashed for me, but probably because I'm on Linux x86_64 }
procedure init;
//var
// a: TForm;
begin
createf;
// a := TForm.Create(nil);
// a.ShowModal;
// a.Free;
end;
begin
end.

View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, virtualextension,
uPSComponent,uPSCompiler, uPSRuntime, uPSPreProcessor;
uPSComponent,uPSCompiler, uPSRuntime, uPSPreProcessor,forms;
@ -18,6 +18,7 @@ type
private
PSInstance: TPSScript;
FEnabled: Boolean;
Script: TStringList;
private
function InitScript: Boolean;
@ -29,6 +30,7 @@ type
protected
procedure RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
procedure RegisterPSRComponents(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
procedure RegisterMyMethods(Sender: TPSScript);
end;
@ -40,63 +42,53 @@ uses
uPSR_extctrls //Runtime-libs;
;
procedure TSimbaPSEventExtension.OutputMessages;
procedure createf;
var
l: Longint;
b: Boolean;
a: TForm;
begin
b := False;
for l := 0 to PSInstance.CompilerMessageCount - 1 do
begin
if (not b) and (PSInstance.CompilerMessages[l] is TIFPSPascalCompilerError) then
begin
b := True;
{if OnError <> nil then
with PSInstance.CompilerMessages[l] do
HandleError(Row, Col, Pos, MessageToString,errCompile, ModuleName)
else }
writeln(PSInstance.CompilerErrorToStr(l) + ' at line ' + inttostr(PSInstance.CompilerMessages[l].Row));
end else
Writeln(PSInstance.CompilerErrorToStr(l) + ' at line ' + inttostr(PSInstance.CompilerMessages[l].Row));
a:=TForm.Create(nil);
a.ShowModal;
a.Free;
end;
end;
function TSimbaPSEventExtension.HookExists(HookName: String): Boolean;
begin
end;
function TSimbaPSEventExtension.ExecuteHook(HookName: String): Integer;
begin
end;
constructor TSimbaPSEventExtension.Create(FileName: String);
var
fStr:TFileStream;
Script: String;
strs: TStrings;
begin
// FIXME
//inherited;
inherited create;
try
Script := TStringList.Create;
fStr := TFileStream.Create(FileName, fmOpenRead);
SetLength(Script, fStr.Size);
fStr.Read(Script[1],fStr.Size);
Script.LoadFromStream(fStr);
fStr.Free;
except
raise Exception.CreateFmt('File %s could not be read', [FileName]);
end;
try
fStr.Free;
finally
end;
Strs := TStringList.Create;
Strs.Add(Script);
FEnabled := False;
{ Create script, and see if the extension is valid. (If it compiles) }
PSInstance := TPSScript.Create(nil);
PSInstance.Script := Strs;
PSInstance.Script := Self.Script;
PSInstance.OnCompImport:=@RegisterPSCComponents;
PSInstance.OnExecImport:=@RegisterPSRComponents;
PSInstance.OnCompile:=@RegisterMyMethods;
Writeln(Format('%s: Script: %s', [FileName, Script]));
Writeln(Format('%s: Script: %s', [FileName, Self.Script.Text]));
try
FEnabled := PSInstance.Compile;
@ -114,10 +106,8 @@ begin
if FEnabled then
writeln('It exists')
else
writeln('It does not exist');
// writeln(PSInstance.ExecuteFunction([], 'test'));
writeln('It does not exist - or something went wrong while executing it.');
// writeln(PSInstance.ExecuteFunction([], 'test'));
end;
function TSimbaPSEventExtension.InitScript: Boolean;
@ -134,6 +124,12 @@ begin
exit(true);
end;
procedure TSimbaPSEventExtension.RegisterMyMethods(Sender: TPSScript);
begin
Sender.AddFunction(@createf, 'procedure createf;');
end;
procedure TSimbaPSEventExtension.RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
begin
SIRegister_Std(x);
@ -167,14 +163,32 @@ begin
inherited;
end;
function TSimbaPSEventExtension.HookExists(HookName: String): Boolean;
begin
procedure TSimbaPSEventExtension.OutputMessages;
var
l: Longint;
b: Boolean;
begin
b := False;
for l := 0 to PSInstance.CompilerMessageCount - 1 do
begin
if (not b) and (PSInstance.CompilerMessages[l] is TIFPSPascalCompilerError) then
begin
b := True;
with PSInstance.CompilerMessages[l] do
writeln(MessageToString);
{if OnError <> nil then
with PSInstance.CompilerMessages[l] do
HandleError(Row, Col, Pos, MessageToString,errCompile, ModuleName)
else }
writeln(PSInstance.CompilerErrorToStr(l) + ' at line ' + inttostr(PSInstance.CompilerMessages[l].Row));
end else
Writeln(PSInstance.CompilerErrorToStr(l) + ' at line ' + inttostr(PSInstance.CompilerMessages[l].Row));
end;
end;
function TSimbaPSEventExtension.ExecuteHook(HookName: String): Integer;
begin
end;
end.

View File

@ -41,7 +41,8 @@ uses
SynExportHTML, SynEditKeyCmds, SynEditHighlighter,
SynEditMarkupHighAll, LMessages, Buttons,
stringutil,mufasatypesutil,mufasabase,
about, framefunctionlist, ocr, updateform, simbasettings;
about, framefunctionlist, ocr, updateform, simbasettings,
eventextension;
const
SimbaVersion = 585;
@ -2006,8 +2007,18 @@ begin
end;
procedure TForm1.ButtonTrayClick(Sender: TObject);
var
Ext: TSimbaPSEventExtension;
{ FIXME: Turning it into a test button again... }
begin
Form1.Hide;
{Form1.Hide; }
try
Ext := TSimbaPSEventExtension.Create(MainDir + DS + 'Extensions' + DS + 'test.pas');
Ext.Free;
except
Writeln('Something went wrong with the Extensions.');
end;
end;
procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean

View File

@ -10,7 +10,6 @@ uses
type
TVirtualSimbaExtension = class(TObject)
public
{ Must be implemented }
function HookExists(HookName: String): Boolean; virtual; abstract;