webidl: wasmjob: started pascal interface

packages/fcl-base/src/pascodegen.pp

@@ -76,7 +76,7 @@ Type
     Procedure Comment(Const AComment : String; Curly : Boolean = False);
     Procedure Comment(Const AComment : Array of String);
     Procedure Comment(Const AComment : TStrings);
-    Procedure ClassHeader(Const AClassName: String); virtual;
+    Procedure ClassComment(Const AClassName: String); virtual;
     Procedure SimpleMethodBody(Lines: Array of string); virtual;
     procedure SaveToStream(const AStream: TStream);
     Procedure SaveToFile(Const AFileName : string);
@@ -390,7 +390,7 @@ begin
     Result:=Upcase(S[1])+Copy(S,2,Length(S)-1);
 end;
 
-procedure TPascalCodeGenerator.ClassHeader(const AClassName: String);
+procedure TPascalCodeGenerator.ClassComment(const AClassName: String);
 
 begin
   AddLn('');

packages/webidl/src/webidltopas.pp

@@ -92,9 +92,6 @@ type
     function GetDefPos(Def: TIDLBaseObject; WithoutFile: boolean = false): string; virtual;
     function GetPasDataPos(D: TPasData; WithoutFile: boolean = false): string; virtual;
     procedure EnsureUniqueNames(ML: TIDLDefinitionList); virtual;
-    function WriteFunctionImplicitTypes(aList: TIDLDefinitionList): Integer; virtual;
-    function WriteAttributeImplicitTypes(aList: TIDLDefinitionList): Integer; virtual;
-    function WriteDictionaryMemberImplicitTypes(aList: TIDLDefinitionList): Integer; virtual;
     function AddSequenceDef(ST: TIDLSequenceTypeDefDefinition): Boolean; virtual;
     function GetName(ADef: TIDLDefinition): String; virtual;
     function GetTypeName(Const aTypeName: String; ForTypeDef: Boolean=False): String; overload; virtual;
@@ -110,6 +107,10 @@ type
     function GetArguments(aList: TIDLDefinitionList; ForceBrackets: Boolean): String; virtual;
     function HaveConsts(aList: TIDLDefinitionList): Boolean; virtual;
     // Code generation routines. Return the number of actually written defs.
+    function WriteFunctionImplicitTypes(aList: TIDLDefinitionList): Integer; virtual;
+    function WriteAttributeImplicitTypes(aList: TIDLDefinitionList): Integer; virtual;
+    function WriteOtherImplicitTypes(Intf: TIDLInterfaceDefinition; aMemberList: TIDLDefinitionList): Integer; virtual;
+    function WriteDictionaryMemberImplicitTypes(aList: TIDLDefinitionList): Integer; virtual;
     function WriteCallBackDefs(aList: TIDLDefinitionList): Integer; virtual;
     function WriteDictionaryDefs(aList: TIDLDefinitionList): Integer; virtual;
     function WriteForwardClassDefs(aList: TIDLDefinitionList): Integer; virtual;
@@ -263,6 +264,82 @@ begin
       Exit(True);
 end;
 
+function TBaseWebIDLToPas.WriteFunctionImplicitTypes(aList: TIDLDefinitionList): Integer;
+
+Var
+  D,D2,D3: TIDLDefinition;
+  FD: TIDLFunctionDefinition absolute D;
+  DA: TIDLArgumentDefinition absolute D2;
+  UT: TIDLUnionTypeDefDefinition;
+
+begin
+  Result:=0;
+  for D in aList do
+    if D is TIDLFunctionDefinition then
+      if Not (foCallBack in FD.Options) then
+        begin
+        if (FD.ReturnType is TIDLSequenceTypeDefDefinition) then
+          if AddSequenceDef(FD.ReturnType as TIDLSequenceTypeDefDefinition) then
+            Inc(Result);
+        For D2 in FD.Arguments do
+          if (DA.ArgumentType is TIDLSequenceTypeDefDefinition) then
+            begin
+            if AddSequenceDef(DA.ArgumentType as TIDLSequenceTypeDefDefinition) then
+              Inc(Result);
+            end
+          else
+            begin
+            UT:=CheckUnionTypeDefinition(DA.ArgumentType);
+            if Assigned(UT) then
+              For D3 in UT.Union do
+                if (D3 is TIDLSequenceTypeDefDefinition) then
+                  if AddSequenceDef(D3 as TIDLSequenceTypeDefDefinition) then
+                    Inc(Result);
+            end;
+        end;
+  if Result>0 then
+    AddLn('');
+end;
+
+function TBaseWebIDLToPas.WriteAttributeImplicitTypes(aList: TIDLDefinitionList
+  ): Integer;
+Var
+  D: TIDLDefinition;
+  FA: TIDLAttributeDefinition absolute D;
+
+begin
+  Result:=0;
+  for D in aList do
+    if D is TIDLAttributeDefinition then
+      if (FA.AttributeType is TIDLSequenceTypeDefDefinition) then
+        if AddSequenceDef(FA.AttributeType as TIDLSequenceTypeDefDefinition) then
+          Inc(Result);
+end;
+
+function TBaseWebIDLToPas.WriteOtherImplicitTypes(
+  Intf: TIDLInterfaceDefinition; aMemberList: TIDLDefinitionList): Integer;
+begin
+  Result:=0;
+  if Intf=nil then ;
+  if aMemberList=nil then ;
+end;
+
+function TBaseWebIDLToPas.WriteDictionaryMemberImplicitTypes(
+  aList: TIDLDefinitionList): Integer;
+
+Var
+  D: TIDLDefinition;
+  FD: TIDLDictionaryMemberDefinition absolute D;
+
+begin
+  Result:=0;
+  for D in aList do
+    if D is TIDLDictionaryMemberDefinition then
+      if (FD.MemberType is TIDLSequenceTypeDefDefinition) then
+        if AddSequenceDef(FD.MemberType as TIDLSequenceTypeDefDefinition) then
+          Inc(Result);
+end;
+
 function TBaseWebIDLToPas.WritePrivateReadOnlyFields(aList: TIDLDefinitionList): Integer;
 begin
   Result:=0;
@@ -400,74 +477,6 @@ begin
     end;
 end;
 
-function TBaseWebIDLToPas.WriteFunctionImplicitTypes(aList: TIDLDefinitionList): Integer;
-
-Var
-  D,D2,D3: TIDLDefinition;
-  FD: TIDLFunctionDefinition absolute D;
-  DA: TIDLArgumentDefinition absolute D2;
-  UT: TIDLUnionTypeDefDefinition;
-
-begin
-  Result:=0;
-  for D in aList do
-    if D is TIDLFunctionDefinition then
-      if Not (foCallBack in FD.Options) then
-        begin
-        if (FD.ReturnType is TIDLSequenceTypeDefDefinition) then
-          if AddSequenceDef(FD.ReturnType as TIDLSequenceTypeDefDefinition) then
-            Inc(Result);
-        For D2 in FD.Arguments do
-          if (DA.ArgumentType is TIDLSequenceTypeDefDefinition) then
-            begin
-            if AddSequenceDef(DA.ArgumentType as TIDLSequenceTypeDefDefinition) then
-              Inc(Result);
-            end
-          else
-            begin
-            UT:=CheckUnionTypeDefinition(DA.ArgumentType);
-            if Assigned(UT) then
-              For D3 in UT.Union do
-                if (D3 is TIDLSequenceTypeDefDefinition) then
-                  if AddSequenceDef(D3 as TIDLSequenceTypeDefDefinition) then
-                    Inc(Result);
-            end;
-        end;
-  if Result>0 then
-    AddLn('');
-end;
-
-function TBaseWebIDLToPas.WriteAttributeImplicitTypes(aList: TIDLDefinitionList
-  ): Integer;
-Var
-  D: TIDLDefinition;
-  FA: TIDLAttributeDefinition absolute D;
-
-begin
-  Result:=0;
-  for D in aList do
-    if D is TIDLAttributeDefinition then
-      if (FA.AttributeType is TIDLSequenceTypeDefDefinition) then
-        if AddSequenceDef(FA.AttributeType as TIDLSequenceTypeDefDefinition) then
-          Inc(Result);
-end;
-
-function TBaseWebIDLToPas.WriteDictionaryMemberImplicitTypes(
-  aList: TIDLDefinitionList): Integer;
-
-Var
-  D: TIDLDefinition;
-  FD: TIDLDictionaryMemberDefinition absolute D;
-
-begin
-  Result:=0;
-  for D in aList do
-    if D is TIDLDictionaryMemberDefinition then
-      if (FD.MemberType is TIDLSequenceTypeDefDefinition) then
-        if AddSequenceDef(FD.MemberType as TIDLSequenceTypeDefDefinition) then
-          Inc(Result);
-end;
-
 procedure TBaseWebIDLToPas.EnsureUniqueNames(ML: TIDLDefinitionList);
 
 Var
@@ -538,7 +547,7 @@ end;
 function TBaseWebIDLToPas.WriteInterfaceDef(Intf: TIDLInterfaceDefinition): Boolean;
 
 Var
-  CN,PN: String;
+  aClassName,aParentName: String;
   Decl: String;
   ML: TIDLDefinitionList;
 
@@ -548,20 +557,21 @@ begin
   try
     Intf.GetFullMemberList(ML);
     EnsureUniqueNames(ML);
-    CN:=GetName(Intf);
+    aClassName:=GetName(Intf);
     // class comment
-    ClassHeader(CN);
+    ClassComment(aClassName);
     // sub types
     WriteFunctionImplicitTypes(ML);
     WriteAttributeImplicitTypes(ML);
+    WriteOtherImplicitTypes(Intf,ML);
     // class and ancestor
-    Decl:=CN+' = '+GetInterfaceDefHead(Intf);
+    Decl:=aClassName+' = '+GetInterfaceDefHead(Intf);
     if Assigned(Intf.ParentInterface) then
-      PN:=GetName(Intf.ParentInterface)
+      aParentName:=GetName(Intf.ParentInterface)
     else
-      PN:=GetTypeName(Intf.ParentName);
-    if PN<>'' then
-      Decl:=Decl+Format(' (%s)',[PN]);
+      aParentName:=GetTypeName(Intf.ParentName);
+    if aParentName<>'' then
+      Decl:=Decl+' ('+aParentName+')';
     AddLn(Decl);
     // private section
     AddLn('Private');
@@ -614,7 +624,7 @@ begin
     CurParent:=DictionaryClassParent;
     if CurParent='' then
       CurParent:='TJSObject';
-    ClassHeader(CurClassName);
+    ClassComment(CurClassName);
     WriteDictionaryMemberImplicitTypes(DefList);
     if (coDictionaryAsClass in BaseOptions) then
       Addln('%s = class(%s)',[CurClassName,CurParent])
@@ -730,6 +740,7 @@ begin
     'USVString',
     'ByteString': TN:='UnicodeString';
 
+    'record',
     'object': TN:=GetClassName('Object');
     'Error',
     'DOMException': TN:=GetClassName('Error');
@@ -763,27 +774,9 @@ begin
 end;
 
 function TBaseWebIDLToPas.WriteField(aAttr: TIDLAttributeDefinition): Boolean;
-
-Var
-  Def,TN,N: String;
-
 begin
-  Result:=True;
-  N:=GetName(aAttr);
-  if aAttr.AttributeType=nil then
-    begin
-    AddLn('skipping field without type: "'+N+'"');
-    exit;
-    end;
-  TN:=GetTypeName(aAttr.AttributeType);
-  if TN='record' then
-    TN:='TJSObject';
-  if SameText(N,TN) then
-    N:='_'+N;
-  Def:=Format('%s: %s;',[N,TN]);
-  if (N<>aAttr.Name) then
-    Def:=Def+Format('external name ''%s'';',[aAttr.Name]);
-  AddLn(Def);
+  Result:=false;
+  if aAttr=nil then ;
 end;
 
 function TBaseWebIDLToPas.WriteForwardClassDef(D: TIDLStructuredDefinition): Boolean;

packages/webidl/src/webidltopas2js.pp

@@ -55,6 +55,7 @@ type
     function WriteProperties(aList: TIDLDefinitionList): Integer; override;
     // Definitions. Return true if a definition was written.
     function WriteConst(aConst: TIDLConstDefinition): Boolean; override;
+    function WriteField(aAttr: TIDLAttributeDefinition): Boolean; override;
     function WritePrivateReadOnlyField(aAttr: TIDLAttributeDefinition): Boolean; virtual;
     function WriteReadonlyProperty(aAttr: TIDLAttributeDefinition): Boolean; virtual;
   Public
@@ -195,6 +196,29 @@ begin
     Result:=inherited WriteConst(aConst);
 end;
 
+function TWebIDLToPas2js.WriteField(aAttr: TIDLAttributeDefinition): Boolean;
+Var
+  Def,TN,N: String;
+
+begin
+  Result:=True;
+  N:=GetName(aAttr);
+  if aAttr.AttributeType=nil then
+    begin
+    AddLn('skipping field without type: "'+N+'"');
+    exit;
+    end;
+  TN:=GetTypeName(aAttr.AttributeType);
+  if TN='record' then
+    TN:='TJSObject';
+  if SameText(N,TN) then
+    N:='_'+N;
+  Def:=Format('%s: %s;',[N,TN]);
+  if (N<>aAttr.Name) then
+    Def:=Def+Format('external name ''%s'';',[aAttr.Name]);
+  AddLn(Def);
+end;
+
 function TWebIDLToPas2js.WritePrivateReadOnlyField(
   aAttr: TIDLAttributeDefinition): Boolean;
 begin

packages/webidl/src/webidltowasmjob.pp

@@ -2,7 +2,7 @@
     This file is part of the Free Component Library
 
     WEBIDL to pascal code converter
-    Copyright (c) 2021 by Michael Van Canneyt [email protected]
+    Copyright (c) 2022 by Michael Van Canneyt [email protected]
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -50,16 +50,26 @@ const
     'TJOB_JSValueMethod'
     );
 type
+  TPasDataWasmJob = class(TPasData)
+  public
+    GetterBody: String;
+    SetterBody: String;
+  end;
 
   { TWebIDLToPasWasmJob }
 
   TWebIDLToPasWasmJob = class(TBaseWebIDLToPas)
+  private
+    FPasInterfacePrefix: String;
   Protected
     function BaseUnits: String; override;
     // Auxiliary routines
     procedure GetOptions(L: TStrings; Full: boolean); override;
     function GetTypeName(const aTypeName: String; ForTypeDef: Boolean=False
       ): String; override;
+    function ClassToPasIntfName(const CN: string): string; virtual;
+    function WriteOtherImplicitTypes(Intf: TIDLInterfaceDefinition; aMemberList: TIDLDefinitionList): Integer;
+      override;
     // Code generation routines. Return the number of actually written defs.
     function WritePrivateGetters(aList: TIDLDefinitionList): Integer; override;
     function WritePrivateSetters(aList: TIDLDefinitionList): Integer; override;
@@ -74,6 +84,7 @@ type
     Property BaseOptions;
     Property ClassPrefix;
     Property ClassSuffix;
+    Property PasInterfacePrefix: String read FPasInterfacePrefix write FPasInterfacePrefix;
     Property DictionaryClassParent;
     Property FieldPrefix;
     Property GetterPrefix;
@@ -114,6 +125,47 @@ begin
   end;
 end;
 
+function TWebIDLToPasWasmJob.ClassToPasIntfName(const CN: string): string;
+begin
+  Result:=CN;
+  if LeftStr(Result,length(ClassPrefix))=ClassPrefix then
+    System.Delete(Result,1,length(ClassPrefix));
+  Result:=PasInterfacePrefix+Result;
+end;
+
+function TWebIDLToPasWasmJob.WriteOtherImplicitTypes(
+  Intf: TIDLInterfaceDefinition; aMemberList: TIDLDefinitionList): Integer;
+var
+  aPasIntfName, Decl, ParentName: String;
+begin
+  Result:=1;
+
+  aPasIntfName:=GetName(Intf);
+  aPasIntfName:=ClassToPasIntfName(aPasIntfName);
+
+  // pascal interface and ancestor
+  Decl:=aPasIntfName+' = interface';
+  if Assigned(Intf.ParentInterface) then
+    ParentName:=GetName(Intf.ParentInterface)
+  else
+    ParentName:=GetTypeName(Intf.ParentName);
+  if ParentName<>'' then
+    begin
+    ParentName:=ClassToPasIntfName(ParentName);
+    Decl:=Decl+Format(' (%s)',[ParentName]);
+    end;
+  AddLn(Decl);
+
+  Indent;
+  WritePrivateGetters(aMemberList);
+  WritePrivateSetters(aMemberList);
+  WriteMethodDefs(aMemberList);
+  WriteProperties(aMemberList);
+  Undent;
+  AddLn('end;');
+  AddLn('');
+end;
+
 function TWebIDLToPasWasmJob.WritePrivateGetters(aList: TIDLDefinitionList
   ): Integer;
 var
@@ -154,14 +206,19 @@ function TWebIDLToPasWasmJob.WritePrivateGetter(Attr: TIDLAttributeDefinition
   ): boolean;
 var
   FuncName, TypeName, aClassName, Code, ReadFuncName: String;
+  Data: TPasDataWasmJob;
 begin
   Result:=true;
   if Attr.AttributeType=nil then
     exit;
+  Data:=Attr.Data as TPasDataWasmJob;
+
   FuncName:=GetterPrefix+GetName(Attr);
   TypeName:=GetTypeName(Attr.AttributeType);
   AddLn('Function '+FuncName+': '+TypeName+';');
 
+  if Data.GetterBody<>'' then exit;
+
   aClassName:=GetName(Attr.Parent);
 
   case TypeName of
@@ -187,6 +244,7 @@ begin
   Code:=Code+'  Result:='+ReadFuncName+'('''+Attr.Name+''');'+sLineBreak;
   Code:=Code+'end;'+sLineBreak;
 
+  Data.GetterBody:=Code;
   IncludeImplementationCode.Add(Code);
 end;
 
@@ -194,17 +252,21 @@ function TWebIDLToPasWasmJob.WritePrivateSetter(Attr: TIDLAttributeDefinition
   ): boolean;
 var
   FuncName, TypeName, aClassName, WriteFuncName, Code: String;
+  Data: TPasDataWasmJob;
 begin
   if aoReadOnly in Attr.Options then
     exit(false);
   if Attr.AttributeType=nil then
     exit;
+  Data:=Attr.Data as TPasDataWasmJob;
 
   Result:=true;
   FuncName:=SetterPrefix+GetName(Attr);
   TypeName:=GetTypeName(Attr.AttributeType);
   AddLn('Procedure '+FuncName+'(const aValue: '+TypeName+');');
 
+  if Data.SetterBody<>'' then exit;
+
   aClassName:=GetName(Attr.Parent);
 
   case TypeName of
@@ -230,6 +292,7 @@ begin
   Code:=Code+'  '+WriteFuncName+'('''+Attr.Name+''',aValue);'+sLineBreak;
   Code:=Code+'end;'+sLineBreak;
 
+  Data.SetterBody:=Code;
   IncludeImplementationCode.Add(Code);
 end;
 
@@ -255,6 +318,8 @@ end;
 constructor TWebIDLToPasWasmJob.Create(ThOwner: TComponent);
 begin
   inherited Create(ThOwner);
+  PasDataClass:=TPasDataWasmJob;
+  FPasInterfacePrefix:='IJS';
 end;
 
 end.