paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 14:29:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Allow to set event handlers

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-07-29 14:13:37 +02:00
parent afd7d9965a
commit 47e4eaf392
1 changed files with 52 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
packages/webidl/src/webidltowasmjob.pp
View File

@ -87,6 +87,7 @@ type
NativeType: TPascalNativeType; NativeType: TPascalNativeType;
NativeTypeName, NativeTypeName,
ResolvedTypeName, ResolvedTypeName,
CallBackName,
FuncName: TIDLString; FuncName: TIDLString;
end; end;
@ -127,6 +128,8 @@ type
function BaseUnits: String; override; function BaseUnits: String; override;
function DottedBaseUnits: String; override; function DottedBaseUnits: String; override;
function IsStub : Boolean; virtual; function IsStub : Boolean; virtual;
function IsKeyWord(const S: String): Boolean; override;
// Auxiliary routines // Auxiliary routines
function DefaultForNativeType(aNativeType: TPascalNativeType; aReturnTypeName: String): String; function DefaultForNativeType(aNativeType: TPascalNativeType; aReturnTypeName: String): String;
function GetAliasPascalType(D: TIDLDefinition; out PascalTypeName : string): TPascalNativeType; override; function GetAliasPascalType(D: TIDLDefinition; out PascalTypeName : string): TPascalNativeType; override;
@ -254,6 +257,13 @@ begin
Result:=False; Result:=False;
end; end;
function TWebIDLToPasWasmJob.IsKeyWord(const S: String): Boolean;
begin
Result:=inherited IsKeyWord(S);
if not Result then
Result:=SameText(s,'create');
end;
function TWebIDLToPasWasmJob.GetAliasPascalType(D: TIDLDefinition; out PascalTypeName: string): TPascalNativeType; function TWebIDLToPasWasmJob.GetAliasPascalType(D: TIDLDefinition; out PascalTypeName: string): TPascalNativeType;
var var
@ -1198,6 +1208,7 @@ begin
end; end;
Undent; Undent;
AddLn('end;'); AddLn('end;');
AddLn('');
finally finally
ArgNames.Free; ArgNames.Free;
end; end;
@ -1244,8 +1255,6 @@ begin
if FGeneratingInterface and (([foConstructor, foStatic] * aDef.Options)<>[]) then if FGeneratingInterface and (([foConstructor, foStatic] * aDef.Options)<>[]) then
exit; exit;
Suff:=''; Suff:='';
if (ADef.Name='createImageBitmap') then
Writeln('Name');
GetMethodInfo(aParent,aDef,MethodInfo); GetMethodInfo(aParent,aDef,MethodInfo);
Overloads:=GetOverloads(ADef); Overloads:=GetOverloads(ADef);
try try
@ -1541,6 +1550,7 @@ begin
AddLn(GetFunc); AddLn(GetFunc);
undent; undent;
AddLn('end;'); AddLn('end;');
AddLn('');
finally finally
ArgNames.Free; ArgNames.Free;
end; end;
@ -1661,8 +1671,11 @@ begin
Call:=GetReadPropertyCall(Info,aProp.Name); Call:=GetReadPropertyCall(Info,aProp.Name);
Addln('function '+aClassName+'.'+info.FuncName+': '+Info.NativeTypeName+';'); Addln('function '+aClassName+'.'+info.FuncName+': '+Info.NativeTypeName+';');
Addln('begin'); Addln('begin');
Addln(' Result:='+Call+';'); Indent;
Addln('Result:='+Call+';');
Undent;
Addln('end;'); Addln('end;');
AddLn('');
end; end;
function TWebIDLToPasWasmJob.WritePrivateGetter(aParent: TIDLStructuredDefinition; aProp: TIDLPropertyDefinition): boolean; function TWebIDLToPasWasmJob.WritePrivateGetter(aParent: TIDLStructuredDefinition; aProp: TIDLPropertyDefinition): boolean;
@ -1715,7 +1728,9 @@ begin
else if aType is TIDLDictionaryDefinition then else if aType is TIDLDictionaryDefinition then
aAccessInfo.NativeTypeName:=GetPasIntfName(aType) aAccessInfo.NativeTypeName:=GetPasIntfName(aType)
else if aType is TIDLFunctionDefinition then else if aType is TIDLFunctionDefinition then
// exit // not supported yet aAccessInfo.ResolvedTypeName:=GetPasName(aType)
else if aType is TIDLCallbackDefinition then
aAccessInfo.CallBackName:='JobCall'+GetPasName(TIDLCallbackDefinition(aType).FunctionDef) // callback
else if aType is TIDLEnumDefinition then else if aType is TIDLEnumDefinition then
aAccessInfo.ResolvedTypeName:='UnicodeString'; aAccessInfo.ResolvedTypeName:='UnicodeString';
Result:=True; Result:=True;
@ -1770,13 +1785,36 @@ begin
aClassName:=GetPasName(aParent); aClassName:=GetPasName(aParent);
if not GetPrivateSetterInfo(aProp,Info) then if not GetPrivateSetterInfo(aProp,Info) then
exit; exit;
Call:=GetWritePropertyCall(Info, aProp.Name);
Addln('procedure %s.%s(const aValue : %s);',[aClassName,info.FuncName,Info.NativeTypeName]); Addln('procedure %s.%s(const aValue : %s);',[aClassName,info.FuncName,Info.NativeTypeName]);
Addln('begin'); if Info.PropType is TIDLCallbackDefinition then
indent; begin
Addln(Call+';'); Addln('var');
Indent;
AddLn('m : TJOB_Method;');
Undent;
Addln('begin');
indent;
Addln('m:=TJOB_Method.create(TMethod(aValue),@%s);',[Info.CallBackName]);
Addln('try');
indent;
Addln('InvokeJSNoResult(''%s'',[m],jiSet);',[aProp.Name]);
undent;
Addln('finally');
indent;
Addln('m.free');
undent;
Addln('end;');
end
else
begin
Call:=GetWritePropertyCall(Info, aProp.Name);
Addln('begin');
indent;
Addln(Call+';');
end;
undent; undent;
Addln('end;'); Addln('end;');
Addln('');
end; end;
@ -2245,10 +2283,11 @@ begin
Indent; Indent;
For IDl in aDict.Members do For IDl in aDict.Members do
if IDL is TIDLDictionaryMemberDefinition then if IDL is TIDLDictionaryMemberDefinition then
begin if convertDef(Idl) then
aName:=GetPasName(MD); begin
AddLn('Self.%s:=aDict.%s;',[aName,aName]); aName:=GetPasName(MD);
end; AddLn('Self.%s:=aDict.%s;',[aName,aName]);
end;
Undent; Undent;
AddLn('end;'); AddLn('end;');
AddLn(''); AddLn('');
@ -2283,6 +2322,7 @@ begin
AddLn('Result:=%s.JOBCast(Intf);',[aClassName]); AddLn('Result:=%s.JOBCast(Intf);',[aClassName]);
Undent; Undent;
AddLn('end;'); AddLn('end;');
AddLn('');
end; end;