From ba51e1b8d99e873c343a0757e151ff0312da9db5 Mon Sep 17 00:00:00 2001 From: drewski207 Date: Mon, 6 Jan 2014 02:31:04 +0000 Subject: [PATCH] Updated gir2pascal to add the parameter error: PPGError to functions if throws=1 is set as a property name 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 --- .../gobject-introspection/gir2pascal.lpi | 2 +- .../gobject-introspection/girerrors.pas | 1 + .../gobject-introspection/girobjects.pas | 69 ++++++++++++++++++- .../girpascalwritertypes.pas | 49 ++++++++----- .../gobject-introspection/girtokens.pas | 3 +- 5 files changed, 105 insertions(+), 19 deletions(-) diff --git a/applications/gobject-introspection/gir2pascal.lpi b/applications/gobject-introspection/gir2pascal.lpi index 5c5fa2ce4..dd37f5b15 100644 --- a/applications/gobject-introspection/gir2pascal.lpi +++ b/applications/gobject-introspection/gir2pascal.lpi @@ -1,4 +1,4 @@ - + diff --git a/applications/gobject-introspection/girerrors.pas b/applications/gobject-introspection/girerrors.pas index 2753a2b4b..5afc5e519 100644 --- a/applications/gobject-introspection/girerrors.pas +++ b/applications/gobject-introspection/girerrors.pas @@ -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 =( diff --git a/applications/gobject-introspection/girobjects.pas b/applications/gobject-introspection/girobjects.pas index b89f0b2c3..8ed374798 100644 --- a/applications/gobject-introspection/girobjects.pas +++ b/applications/gobject-introspection/girobjects.pas @@ -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 = ' '; + 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]); diff --git a/applications/gobject-introspection/girpascalwritertypes.pas b/applications/gobject-introspection/girpascalwritertypes.pas index baf8789c1..006ded173 100644 --- a/applications/gobject-introspection/girpascalwritertypes.pas +++ b/applications/gobject-introspection/girpascalwritertypes.pas @@ -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 +'; '; diff --git a/applications/gobject-introspection/girtokens.pas b/applications/gobject-introspection/girtokens.pas index 0a527c718..b507d3f9f 100644 --- a/applications/gobject-introspection/girtokens.pas +++ b/applications/gobject-introspection/girtokens.pas @@ -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',