pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Updated gir2pascal to add the parameter error: PPGError to functions if throws=1 is set as a property name

Browse Source 
https://bugzilla.gnome.org/show_bug.cgi?id=721588
Added support for the new parameter type "instance-parameter" which is similiar to the hidden "self" param of pascal


git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2876 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
drewski207
2014-01-06 02:31:04 +00:00
parent 64a3fb1dc4
commit ba51e1b8d9
5 changed files with 105 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
applications/gobject-introspection/gir2pascal.lpi
View File

@ -1,4 +1,4 @@
<?xml version="1.0"?>
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>

1
applications/gobject-introspection/girerrors.pas
View File

@ -34,6 +34,7 @@ type
geUnhandledNode = 'Unhandled node [%s] "%s"';
geUnexpectedNodeType = 'Unexpected node [%s] type: found "%s" expected "%s"';
geMissingNode = '[%s] Could not find child node "%s" while looking in node "%s"';
geAddingErrorNode = '%s %s throws an error but is not included as a param. Adding...';
var
girErrorName: array[TGirError] of String =(

69
applications/gobject-introspection/girobjects.pas
View File

@ -106,14 +106,17 @@ type
TgirTypeParam = class(TGirBaseType)
private
FIsInstanceParam: Boolean;
FVarType: TGirBaseType;
FPointerLevel: Integer;
function GetPointerLevel: Integer;
function GetType: TGirBaseType;
public
constructor Create(AOwner: TObject; ANode: TDomNode); override;
constructor Create(AOwner: TObject; ANode: TDomNode; AIsInstanceParam: Boolean); virtual;
property VarType: TGirBaseType read GetType;
property PointerLevel: Integer read GetPointerLevel;
property IsInstanceParam: Boolean read FIsInstanceParam;
end;
{ TgirProperty }
@ -199,6 +202,7 @@ type
TGirFunctionParam = class(TgirTypeParam)
public
constructor Create(AOwner: TObject; ANode: TDomNode); override;
constructor Create(AOwner: TObject; ANode: TDomNode; AIsInstanceParam: Boolean); override;
end;
{ TgirFunctionReturn }
@ -226,6 +230,7 @@ type
FDeprecatedVersion: String;
FParams: TgirParamList;
FReturns: TgirFunctionReturn;
FThrowsGError: Boolean;
publiC
constructor Create(AOwner: TObject; ANode: TDomNode); override;
destructor Destroy; override;
@ -235,6 +240,7 @@ type
property Deprecated: Boolean read FDeprecated;
property DeprecatedMsg: String read FDeprecatedMsg;
property DeprecatedVersion: String read FDeprecatedVersion;
property ThrowsGError: Boolean read FThrowsGError write FThrowsGError;
end;
{ TgirMethod }
@ -374,7 +380,7 @@ type
implementation
uses girNameSpaces, girErrors;
uses girNameSpaces, girErrors, XMLRead;
{ TgirClassStruct }
@ -773,6 +779,12 @@ begin
FObjectType:=otFunctionParam;
end;
constructor TGirFunctionParam.Create(AOwner: TObject; ANode: TDomNode;
AIsInstanceParam: Boolean);
begin
inherited Create(AOwner, ANode, AIsInstanceParam);
end;
{ TgirTypeParam }
function TgirTypeParam.GetType: TGirBaseType;
@ -891,6 +903,13 @@ begin
FObjectType:=otTypeParam;
end;
constructor TgirTypeParam.Create(AOwner: TObject; ANode: TDomNode;
AIsInstanceParam: Boolean);
begin
FIsInstanceParam:=AIsInstanceParam;
Create(AOwner, ANode);
end;
{ TgirFunction }
constructor TgirFunction.Create(AOwner: TObject; ANode: TDomNode);
@ -898,6 +917,46 @@ var
Node: TDOMNode;
NodeToken: TGirToken;
procedure CheckAddErrorParam(ParentNode: TDomNode);
//const
// ErrorXML = '<parameter name="error"> <type name="Error" c:type="GError**"/> </parameter>';
var
Param: TGirFunctionParam;
AddParam: Boolean;
ErrorNode: TDOMElement;
TypeNode: TDOMElement;
begin
// some functions have throws=1 as a property of the node. This indicates that
// the last parameter is GError **error. The introspection file does not include
// this as a parameter so we have to add it ourselves
AddParam:=False;
if FParams.Count > 0 then
begin
Param := FParams.Param[FParams.Count-1];
//WriteLn(Param.CType);
if Param.CType <> 'GError**' then
begin
AddParam:=True;
end;
end
else
AddParam:=True;
if AddParam then
begin
girError(geInfo, Format(geAddingErrorNode,[ClassName, CIdentifier]));
ErrorNode := ParentNode.OwnerDocument.CreateElement('parameter');
ErrorNode.SetAttribute('name','error');
TypeNode := ParentNode.OwnerDocument.CreateElement('type');
ErrorNode.AppendChild(TypeNode);
TypeNode.SetAttribute('name','Error');
TypeNode.SetAttribute('c:type','GError**');
ParentNode.AppendChild(ErrorNode);
end;
end;
procedure CreateParameters(ANode: TDomNode);
var
PNode: TDomNode;
@ -913,9 +972,16 @@ var
Param := TGirFunctionParam.Create(AOwner, PNode);
FParams.Add(Param);
end;
gtInstanceParameter:
begin
Param := TGirFunctionParam.Create(AOwner, PNode, True);
FParams.Add(Param);
end;
else
girError(geError, Format(geUnexpectedNodeType,[ClassName, PNode.NodeName, GirTokenName[gtParameter]]));
end;
if FThrowsGError and (PNode.NextSibling = nil) then
CheckAddErrorParam(ANode); // may add a NextSibling
PNode := PNode.NextSibling;
end;
end;
@ -924,6 +990,7 @@ begin
inherited Create(AOwner, ANode);
FParams := TgirParamList.Create;
FCIdentifier:=TDOMElement(ANode).GetAttribute('c:identifier');
ThrowsGError:=TDOMElement(ANode).GetAttribute('throws') = '1';
if FName = '' then FName:=FCIdentifier;
if FName = '' then FName:=StringReplace(FCType, '*', '', [rfReplaceAll]);

49
applications/gobject-introspection/girpascalwritertypes.pas
View File

@ -213,7 +213,7 @@ type
procedure WriteWrapperForObject(ARoutineType, AObjectName, AObjectFunctionName: String; AParams:TgirParamList; AFunctionReturns: String; AFlatFunctionName: String; AWantSelf: Boolean);
function WriteCallBack(AItem: TgirFunction; IsInObject: Boolean; AExistingUsedNames: TStringList = nil): String;
procedure WriteFunctionTypeAndReturnType(AItem: TgirFunction; out AFunctionType, AFunctionReturnType: String);
function WriteFunctionParams(AParams: TgirParamList; AArgs: PString = nil): String;
function WriteFunctionParams(AParams: TgirParamList; AArgs: PString = nil; AIncludeInstanceParam: Boolean = False): String;
function WriteFunction(AFunction: TgirFunction; AItem: TGirBaseType; AIsMethod: Boolean; AWantWrapperForObject: Boolean; AFunctionList: TStrings; AExistingUsedNames: TStringList = nil): String;
function WriteParamAsString(AParam: TgirTypeParam; AIndex: Integer; out ABitSizeSpecified: Boolean; AFirstParam: PString = nil; AExistingUsedNames: TStringList = nil): String;
function WriteRecord(ARecord: TgirRecord; ABaseIndent: Integer = 0; AIsUnion: Boolean = False): String;
@ -1144,10 +1144,14 @@ var
Postfix: String;
Entry: String;
InLineS: String = '';
Deprecated: String = '';
DeprecatedS: String = '';
ProperUnit: TPascalUnit;
OptionsIndicateWrapperMethod: Boolean;
begin
{ I apologize to anyone who tries to figure all this out. In short this function
writes procedure lines for an object and it's implementation. As well as the
plain function the object method calls.
}
Result := '';
OptionsIndicateWrapperMethod:= FUnitType = PascalUnitTypeAll;
// we skip deprecated functions
@ -1164,7 +1168,7 @@ begin
if AWantWrapperForObject then
InLineS:=' inline;';
if AFunction.Deprecated then Deprecated :=' deprecated ''Since ' + NameSpace.NameSpace + ' ' + AFunction.DeprecatedVersion+' '+StringReplace(AFunction.DeprecatedMsg,'''','`', [rfReplaceAll])+''';';
if AFunction.Deprecated then DeprecatedS :=' deprecated ''Since ' + NameSpace.NameSpace + ' ' + AFunction.DeprecatedVersion+' '+StringReplace(AFunction.DeprecatedMsg,'''','`', [rfReplaceAll])+''';';
// this fills in the values for procedure/function and the return type
WriteFunctionTypeAndReturnType(AFunction, RoutineType, Returns);
@ -1172,13 +1176,13 @@ begin
if AFunction.InheritsFrom(TgirConstructor) then
Returns := ': '+MakePascalTypeFromCType(AItem.TranslatedName ,1)+'; cdecl;';
Params := WriteFunctionParams(AFunction.Params);
Params := WriteFunctionParams(AFunction.Params, nil, False);
if Pos('array of const', Params) + Pos('va_list', Params) > 0 then
Prefix:='//';
if not (goLinkDynamic in FOptions) then
Postfix := ' external;'+ Deprecated// '+UnitName+'_library;';
Postfix := ' external;'+ DeprecatedS// '+UnitName+'_library;';
else
PostFix := ''+Deprecated;
PostFix := ''+DeprecatedS;
// first wrapper proc
Entry := Prefix + RoutineType +' '+ SanitizeName(AFunction.Name, AExistingUsedNames)+ParenParams(Params)+Returns+InLineS;
@ -1190,18 +1194,24 @@ begin
// This is the line that will be used by in the TObject declaration. <----
// result will be written in the object declaration.
if OptionsIndicateWrapperMethod and not(goNoWrappers in FOptions) then
Result := Entry + Deprecated
Result := Entry + DeprecatedS
else
Result := '';
// now make sure the flat proc has all the params it needs
if AIsMethod then
begin
// methods do not include the first param for it's type so we have to add it
if Params <> '' then
Params := SanitizeName('A'+AItem.Name) +': '+TypeAsString(AItem, 1)+'; ' + Params
// with older introspection versions methods do not include the first param for it's type so we have to add it
if (AFunction.Params.Count = 0) // <--only true if older
or ((AFunction.Params.Count > 0) and not(AFunction.Params.Param[0].IsInstanceParam)) then // <-- true if older
begin
if Params <> '' then
Params := SanitizeName('A'+AItem.Name) +': '+TypeAsString(AItem, 1)+'; ' + Params
else
Params := SanitizeName('A'+AItem.Name) +': '+TypeAsString(AItem, 1);
end
else
Params := SanitizeName('A'+AItem.Name) +': '+TypeAsString(AItem, 1);
Params := WriteFunctionParams(AFunction.Params, nil, True);
end;
ProperUnit := FGroup.GetUnitForType(utFunctions);
@ -1625,7 +1635,7 @@ var
begin
if AWantSelf then
begin
if AParams.Count = 0 then
if (AParams.Count = 0) or ((AParams.Count = 1) and AParams.Param[0].IsInstanceParam) then
CallParams:='@self'
else
CallParams:='@self, ';
@ -1634,11 +1644,12 @@ begin
CallParams:='';
if (ARoutineType = 'function') or (ARoutineType='constructor') then
ResultStr := 'Result := ';
Params:=WriteFunctionParams(AParams, @Args);
Params:=WriteFunctionParams(AParams, @Args, not AWantSelf);
CallParams:=CallParams+Args;
Code := TPCodeText.Create;
Code.Content := Format(Decl, [ARoutineType, AObjectName, AObjectFunctionName, ParenParams(Params), AFunctionReturns])+
Format(Body, [ResultStr, FGroup.UnitForType[utFunctions].UnitFileName+'.'+AFlatFunctionName, CallParams]);
Format(Body, [ResultStr, FGroup.UnitForType[utFunctions].UnitFileName+'.'+AFlatFunctionName,
CallParams]);
ImplementationSection.Declarations.Add(Code);
@ -1690,7 +1701,7 @@ begin
end;
end;
function TPascalUnit.WriteFunctionParams(AParams: TgirParamList; AArgs: PString = nil): String;
function TPascalUnit.WriteFunctionParams(AParams: TgirParamList; AArgs: PString = nil; AIncludeInstanceParam: Boolean = false): String;
var
i: Integer;
ArgName: String;
@ -1701,7 +1712,13 @@ begin
AArgs^ := '';
for i := 0 to AParams.Count-1 do
begin
Result := Result+WriteParamAsString(AParams.Param[i], i, Dummy, @ArgName);
// IsInstanceParam is only the ever the first param so this is safe if it's the
// only Param and AArgs is not updated. AArgs := @Self[, ;] is set in WriteFunction
if AIncludeInstanceParam or (not AIncludeInstanceParam and not AParams.Param[i].IsInstanceParam) then
Result := Result+WriteParamAsString(AParams.Param[i], i, Dummy, @ArgName)
else
Continue;
if i < AParams.Count-1 then
begin
Result := Result +'; ';

3
applications/gobject-introspection/girtokens.pas
View File

@ -28,7 +28,7 @@ uses
type
TGirToken = (gtInvalid, gtAlias, gtConstant, gtRecord, gtBitField, gtEnumeration,
gtCallback, gtUnion, gtFunction, gtReturnValue, gtType,
gtParameters, gtParameter, gtMember, gtField, gtMethod, gtArray,
gtParameters, gtParameter, gtInstanceParameter, gtMember, gtField, gtMethod, gtArray,
gtDoc, gtConstructor, gtRepository, gtInclude, gtNameSpace, gtPackage,
gtCInclude, gtClass, gtProperty, gtVirtualMethod, gtInterface,
gtGlibSignal, gtImplements, gtPrerequisite,gtVarArgs, gtObject, gtClassStruct, gtGType);
@ -50,6 +50,7 @@ var
'type',
'parameters',
'parameter',
'instance-parameter',
'member',
'field',
'method',