paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 22:48:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Added copyright headers, make sure webbluetooth spec can be converted

Browse Source 
git-svn-id: trunk@39294 -
This commit is contained in:
michael 2018-06-23 16:31:37 +00:00
parent bfc5d63fde
commit 609c2385d6
4 changed files with 163 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
packages/webidl/src/webidldefs.pp
View File

@ -1,3 +1,17 @@
{
This file is part of the Free Component Library
WEBIDL definition containers
Copyright (c) 2018 by Michael Van Canneyt michael@freepascal.org
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
unit webidldefs;
{$mode objfpc}{$H+}
@ -393,8 +407,9 @@ Type
end;
{ TIDLImplementsDefinition }
TIDLImplementsOrIncludesDefinition = Class(TIDLDefinition);
TIDLImplementsDefinition = Class(TIDLDefinition)
TIDLImplementsDefinition = Class(TIDLImplementsOrIncludesDefinition)
private
FImplementedInterface: UTF8String;
Public
@ -405,7 +420,7 @@ Type
{ TIDLIncludesDefinition }
TIDLIncludesDefinition = Class(TIDLDefinition)
TIDLIncludesDefinition = Class(TIDLImplementsOrIncludesDefinition)
private
FIncludedInterface : UTF8String;
Public

78
packages/webidl/src/webidlparser.pp
View File

@ -1,3 +1,17 @@
{
This file is part of the Free Component Library
WEBIDL source parser
Copyright (c) 2018 by Michael Van Canneyt michael@freepascal.org
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
unit webidlparser;
{$mode objfpc}{$H+}
@ -93,8 +107,9 @@ Type
function ParseEnum(aParent : TIDLBaseObject): TIDLEnumDefinition; virtual;
function ParseTypeDef(aParent : TIDLBaseObject): TIDLTypeDefDefinition; virtual;
function ParsePartial(aParent : TIDLBaseObject): TIDLStructuredDefinition; virtual;
function ParseImplements(aParent : TIDLBaseObject): TIDLImplementsDefinition; virtual;
function ParseIncludes(aParent : TIDLBaseObject): TIDLIncludesDefinition; virtual;
function ParseImplementsOrIncludes(aParent: TIDLBaseObject): TIDLImplementsOrIncludesDefinition; virtual;
function ParseImplements(Const aName : UTF8String; aParent : TIDLBaseObject): TIDLImplementsDefinition; virtual;
function ParseIncludes(Const aName : UTF8String; aParent : TIDLBaseObject): TIDLIncludesDefinition; virtual;
function ParseDefinition(aParent : TIDLBaseObject): TIDLDefinition; virtual;
procedure ParseDefinitions(aParent : TIDLBaseObject); virtual;
Public
@ -718,7 +733,7 @@ begin
end
else
begin
F:=ParseFunction(aParent);
F:=ParseOperation(aParent);
F.Options:=F.Options+[foStatic];
Result:=F;
end;
@ -879,6 +894,26 @@ begin
Result.IsPartial:=True;
end;
function TWebIDLParser.ParseImplementsOrIncludes(aParent: TIDLBaseObject): TIDLImplementsOrIncludesDefinition;
Var
aName : UTF8String;
begin
if version=v1 then
Result:=ParseImplements('',aParent)
else
begin
aName:=CurrentTokenString;
ExpectTokens([tkImplements,tkIncludes]);
case CurrentToken of
tkIncludes: Result:=ParseIncludes(aName,aParent);
tkImplements: Result:=ParseImplements(aName,aParent);
end;
end;
end;
function TWebIDLParser.ParseEnum(aParent : TIDLBaseObject): TIDLEnumDefinition;
(* On entry, we're on enum. On exit, we're on the } character *)
@ -1055,7 +1090,7 @@ function TWebIDLParser.ParseType(aParent : TIDLBaseObject; FetchFirst : Boolean
Const
SimplePrefixTokens = [tkUnsigned,tkLong,tkUnrestricted];
ComplexPrefixTokens = [tkSequence,tkPromise,tkBracketOpen,tkRecord];
ComplexPrefixTokens = [tkSequence,tkPromise,tkBracketOpen,tkRecord,tkFrozenArray];
PrefixTokens = ComplexPrefixTokens+SimplePrefixTokens;
PrimitiveTokens = [tkBoolean,tkByte,tkOctet,tkFloat,tkDouble,tkShort,tkAny,tkObject];
IdentifierTokens = [tkIdentifier,tkByteString,tkUSVString,tkDOMString];
@ -1092,6 +1127,7 @@ begin
begin
Case tk of
tkRecord : Result:=ParseRecordTypeDef(aParent);
tkFrozenArray,
tkSequence : Result:=ParseSequenceTypeDef(aParent);
tkPromise : Result:=ParsePromiseTypeDef(aParent);
tkBracketOpen : Result:=ParseUnionTypeDef(aParent);
@ -1131,13 +1167,23 @@ begin
end;
end;
function TWebIDLParser.ParseImplements(aParent : TIDLBaseObject): TIDLImplementsDefinition;
(* On entry, we're on the identifier. On Exit, we're on the last identifier *)
function TWebIDLParser.ParseImplements(const aName: UTF8String;
aParent: TIDLBaseObject): TIDLImplementsDefinition;
(* On entry, we're on the identifier for V1, we're. On Exit, we're on the last identifier *)
Var
N : UTF8String;
begin
Result:=TIDLImplementsDefinition(Context.Add(aParent,TIDLImplementsDefinition,CurrentTokenString));
try
if Version=V1 then
begin
N:=CurrentTokenString;
ExpectToken(tkImplements);
end
else
N:=aName;
Result:=TIDLImplementsDefinition(Context.Add(aParent,TIDLImplementsDefinition,N));
try
ExpectToken(tkIdentifier);
Result.ImplementedInterface:=CurrentTokenString;
except
@ -1145,14 +1191,14 @@ begin
end;
end;
function TWebIDLParser.ParseIncludes(aParent: TIDLBaseObject): TIDLIncludesDefinition;
function TWebIDLParser.ParseIncludes(const aName: UTF8String;
aParent: TIDLBaseObject): TIDLIncludesDefinition;
(* On entry, we're on the identifier. On Exit, we're on the last identifier *)
begin
Result:=TIDLIncludesDefinition(Context.Add(aParent,TIDLIncludesDefinition,CurrentTokenString));
Result:=TIDLIncludesDefinition(Context.Add(aParent,TIDLIncludesDefinition,aName));
try
ExpectToken(tkIncludes);
ExpectToken(tkIdentifier);
Result.IncludedInterface:=CurrentTokenString;
except
@ -1185,10 +1231,7 @@ begin
tkEnum : Result:=ParseEnum(aParent);
tkTypeDef : Result:=ParseTypeDef(aParent);
tkIdentifier :
if version=v1 then
Result:=ParseImplements(aParent)
else
Result:=ParseIncludes(aParent);
Result:=ParseImplementsOrIncludes(aParent);
tkEOF : exit;
else
Error(SErrUnExpectedToken,[CurrentTokenString]);
@ -1303,9 +1346,8 @@ begin
if (D is TIDLInterfaceDefinition) and (ID.IsPartial) then
begin
OD:=FindInterface(ID.Name);
If (OD=Nil) then
Raise EWebIDLParser.CreateFmt(SErrInterfaceNotFound,[ID.Name]);
OD.Partials.Add(ID);
If (OD<>Nil) then
OD.Partials.Add(ID);
end;
end;

8
packages/webidl/src/webidlscanner.pp
View File

@ -82,6 +82,7 @@ type
tkTypedef,
tkUnrestricted,
tkPromise,
tkFrozenArray,
tkByteString,
tkDOMString,
tkUSVString,
@ -108,8 +109,8 @@ type
EWebIDLScanner = class(EParserError);
Const
V2Tokens = [tkMixin,tkIncludes,tkMapLike,tkRecord,tkSetLike];
V1Tokens = [tkImplements];
V2Tokens = [tkMixin,tkIncludes,tkMapLike,tkRecord,tkSetLike,tkFrozenArray];
V1Tokens = [];
VersionNonTokens : Array[TWebIDLVersion] of TIDLTokens = (V2Tokens,V1Tokens);
Type
@ -212,6 +213,7 @@ const
'typedef',
'unrestricted',
'Promise',
'FrozenArray',
'ByteString',
'DOMString',
'USVString',
@ -577,7 +579,7 @@ end;
function TWebIDLScanner.DetermineToken2 : TIDLToken;
Const
InfTokens = [tkNan,tkInfinity,tkNegInfinity,tkByteString,tkUSVString,tkDOMString,tkPromise];
InfTokens = [tkNan,tkInfinity,tkNegInfinity,tkByteString,tkUSVString,tkDOMString,tkPromise,tkFrozenArray];
begin
For Result in InfTokens do

103
packages/webidl/src/webidltopas.pp
View File

@ -1,3 +1,17 @@
{
This file is part of the Free Component Library
WEBIDL to pascal code converter
Copyright (c) 2018 by Michael Van Canneyt michael@freepascal.org
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
unit webidltopas;
{$mode objfpc}{$H+}
@ -60,6 +74,9 @@ Type
Function AllocatePasName(D: TIDLDefinition; ParentName: String='') : TPasData;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;virtual;
function GetTypeName(aTypeDef: TIDLTypeDefDefinition; ForTypeDef: Boolean=False): String;virtual;
@ -341,25 +358,25 @@ begin
Inc(Result);
end;
function TWebIDLToPas.AddSequenceDef(ST: TIDLSequenceTypeDefDefinition
): Boolean;
var
TN : String;
begin
TN:=GetTypeName(ST);
Result:=FAutoTypes.IndexOf(TN)=-1;
if Result then
begin
FAutoTypes.Add(TN);
DoLog('Automatically adding %s sequence definition.',[TN]);
AddLn('%s = Array of %s;',[TN,GetTypeName(ST.ElementType)]);
ST.Data:=CreatePasName(TN);
end;
end;
function TWebIDLToPas.WriteFunctionImplicitTypes(aList: TIDLDefinitionList): Integer;
Procedure AddSequenceDef (ST : TIDLSequenceTypeDefDefinition);
var
TN : String;
begin
TN:=GetTypeName(ST);
if FAutoTypes.IndexOf(TN)=-1 then
begin
FAutoTypes.Add(TN);
DoLog('Automatically adding %s sequence definition.',[TN]);
AddLn('%s = Array of %s;',[TN,GetTypeName(ST.ElementType)]);
ST.Data:=CreatePasName(TN);
Inc(Result);
end;
end;
Var
D,D2,D3 : TIDLDefinition;
FD : TIDLFunctionDefinition absolute D;
@ -373,23 +390,59 @@ begin
if Not (foCallBack in FD.Options) then
begin
if (FD.ReturnType is TIDLSequenceTypeDefDefinition) then
AddSequenceDef(FD.ReturnType as TIDLSequenceTypeDefDefinition);
if AddSequenceDef(FD.ReturnType as TIDLSequenceTypeDefDefinition) then
Inc(Result);
For D2 in FD.Arguments do
if (DA.ArgumentType is TIDLSequenceTypeDefDefinition) then
AddSequenceDef(DA.ArgumentType as TIDLSequenceTypeDefDefinition)
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
AddSequenceDef(D3 as TIDLSequenceTypeDefDefinition);
if AddSequenceDef(D3 as TIDLSequenceTypeDefDefinition) then
Inc(Result);
end;
end;
if Result>0 then
AddLn('');
end;
function TWebIDLToPas.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 TWebIDLToPas.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 TWebIDLToPas.EnsureUniqueNames(ML : TIDLDefinitionList);
Var
@ -470,6 +523,7 @@ begin
CN:=GetName(Intf);
ClassHeader(CN);
WriteFunctionImplicitTypes(ML);
WriteAttributeImplicitTypes(ML);
Decl:=Format('%s = class external name %s ',[CN,MakePascalString(Intf.Name,True)]);
if Assigned(Intf.ParentInterface) then
PN:=GetName(Intf.ParentInterface)
@ -526,6 +580,7 @@ begin
if CP='' then
CP:='TJSObject';
ClassHeader(CN);
WriteDictionaryMemberImplicitTypes(ML);
if (coDictionaryAsClass in Options) then
Addln('%s = class(%s)',[CN,CP])
else
@ -685,12 +740,16 @@ function TWebIDLToPas.WriteReadonlyProperty(aAttr: TIDLAttributeDefinition
): Boolean;
Var
N : String;
TN,N,PN : String;
begin
Result:=True;
N:=GetName(aAttr);
AddLn('Property %s : %s Read %s%s; ',[N,GetTypeName(aAttr.AttributeType),FieldPrefix,N]);
PN:=N;
TN:=GetTypeName(aAttr.AttributeType);
if SameText(PN,TN) then
PN:='_'+PN;
AddLn('Property %s : %s Read %s%s; ',[PN,TN,FieldPrefix,N]);
end;