diff --git a/applications/gobject-introspection/gir2pascal.lpi b/applications/gobject-introspection/gir2pascal.lpi
index dd37f5b15..64f6e0c31 100644
--- a/applications/gobject-introspection/gir2pascal.lpi
+++ b/applications/gobject-introspection/gir2pascal.lpi
@@ -30,20 +30,18 @@
-
-
+
+
-
-
@@ -83,7 +81,6 @@
-
@@ -101,12 +98,6 @@
-
-
-
-
-
-
diff --git a/applications/gobject-introspection/gir2pascal.lpr b/applications/gobject-introspection/gir2pascal.lpr
index bdaae4944..336d2059c 100644
--- a/applications/gobject-introspection/gir2pascal.lpr
+++ b/applications/gobject-introspection/gir2pascal.lpr
@@ -174,7 +174,7 @@ begin
StartTime := Now;
ReadXMLFile(Doc, FFileToConvert);
- girFile := TgirFile.Create(nil);
+ girFile := TgirFile.Create(Self, FCmdOptions);
girFile.OnNeedGirFile:=@NeedGirFile;
girFile.ParseXMLDocument(Doc);
Doc.Free;
@@ -216,6 +216,8 @@ begin
AddOption(['d', 'deprecated'], False, 'Include fields and methods marked as deprecated.');
AddOption(['t', 'test'], False ,'Creates a test program per unit to verify struct sizes.');
AddOption(['P', 'unit-prefix'], True, 'Set a prefix to be added to each unitname.');
+ AddOption(['M', 'max-version'], True, 'Do not include symbols introduced after . Can be used multiple times. i.e "-M gtk-3.12 -M glib-2.23"');
+ AddOption(['k', 'keep-deprecated-version'], True, 'Include deprecated symbols that are >= to $version. Uses the same format as --max-version. Has no effect if --deprecated is defined');
end;
FCmdOptions.ReadOptions;
if FCmdOptions.OptionsMalformed then
@@ -296,6 +298,11 @@ begin
if FCmdOptions.HasOption('seperate-units') then
Include(FOptions, goSeperateConsts);
+ if FCmdOptions.HasOption('unit-prefix') then
+ FUnitPrefix:=FCmdOptions.OptionValue('unit-prefix')
+ else
+ FUnitPrefix:='';
+
VerifyOptions;
// does all the heavy lifting
diff --git a/applications/gobject-introspection/gir2pascal.res b/applications/gobject-introspection/gir2pascal.res
index 7c6cf3e4b..e994dfa65 100644
Binary files a/applications/gobject-introspection/gir2pascal.res and b/applications/gobject-introspection/gir2pascal.res differ
diff --git a/applications/gobject-introspection/girfiles.pas b/applications/gobject-introspection/girfiles.pas
index 847435108..6d2f0dadc 100644
--- a/applications/gobject-introspection/girfiles.pas
+++ b/applications/gobject-introspection/girfiles.pas
@@ -24,7 +24,7 @@ unit girFiles;
interface
uses
- Classes, SysUtils, DOM, girNameSpaces, girParser;
+ Classes, SysUtils, DOM, girNameSpaces, girParser, CommandLineOptions;
type
@@ -35,16 +35,19 @@ type
FNameSpaces: TgirNamespaces;
FOnNeedGirFile: TgirNeedGirFileEvent;
FOwner: TObject;
+ FCmdOptions: TCommandLineOptions;
procedure ParseNode(ANode: TDomNode);
procedure SetOnNeedGirFile(AValue: TgirNeedGirFileEvent);
procedure SetOwner(const AValue: TObject);
procedure ParseIncludeNode(ANode: TDomNode; AIncludes: TList);
+ procedure CheckVersionLimits(const ANameSpace: TgirNamespace);
+ function CheckVersionOptions(const ANamespace: String; var AMajor, AMinor: Integer): Boolean;
public
- constructor Create(AOwner: TObject);
+ constructor Create(AOwner: TObject; AOptions: TCommandLineOptions);
destructor Destroy; override;
procedure ParseXMLDocument(AXML: TXMLDocument);
property NameSpaces: TgirNamespaces read FNameSpaces;
- property Owner: TObject read FOwner write SetOwner;
+ property Owner: TObject read FOwner write SetOwner; // TGirConsoleConverter
property OnNeedGirFile: TgirNeedGirFileEvent read FOnNeedGirFile write SetOnNeedGirFile;
end;
@@ -79,6 +82,7 @@ begin
girError(geDebug, 'Adding Namespace '+NS.NameSpace+' to NameSpaces');
FNameSpaces.Add(NS);
girError(geDebug, 'Added Namespace '+NS.NameSpace);
+ CheckVersionLimits(NS);
NS.ParseNode(Node);
end;
gtPackage, gtCInclude: ;// ignore for now
@@ -126,10 +130,67 @@ begin
end;
end;
+procedure TgirFile.CheckVersionLimits(const ANameSpace: TgirNamespace);
-constructor TgirFile.Create(AOwner: TObject);
+
+ function SplitVersion(AVersionStr: String; out AVersion: TGirVersion): Boolean;
+ begin
+ try
+ AVersion := girVersion(AVersionStr);
+ Result := True;
+ except
+ Result := False;
+ end;
+ end;
+
+
+ function SplitNameSpaceVersionCheck(AOptionName: String; var AVersion: TGirVersion): Boolean;
+ var
+ i: Integer;
+ begin
+ if FCmdOptions.HasOption(AOptionName) then
+ with FCmdOptions.OptionValues(AOptionName) do
+ begin
+ for i := 0 to Count-1 do
+ begin
+ if Lowercase(ANameSpace.NameSpace)+'-' = Lowercase(Copy(Strings[i], 1, Length(ANameSpace.NameSpace)+1)) then
+ begin
+ Result := SplitVersion(Copy(Strings[i], Length(ANameSpace.NameSpace)+2, MaxInt), AVersion);
+ break;
+ end;
+ end;
+
+ end;
+ end;
+
+var
+ lVersion: TGirVersion;
+begin
+ if SplitNameSpaceVersionCheck('max-version', lVersion) then
+ ANameSpace.MaxSymbolVersion := lVersion
+ else
+ ANameSpace.MaxSymbolVersion := girVersion(MaxInt, MaxInt);
+
+
+ if SplitNameSpaceVersionCheck('keep-deprecated-version', lVersion) then
+ ANameSpace.DeprecatedVersion := lVersion
+ else
+ ANameSpace.DeprecatedVersion := girVersion(MaxInt, MaxInt);
+
+
+end;
+
+function TgirFile.CheckVersionOptions(const ANamespace: String; var AMajor, AMinor: Integer): Boolean;
+begin
+ Result := False;
+
+end;
+
+
+constructor TgirFile.Create(AOwner: TObject; AOptions: TCommandLineOptions);
begin
Owner := AOwner;
+ FCmdOptions := AOptions;
FNameSpaces := TgirNamespaces.Create(Self);
end;
diff --git a/applications/gobject-introspection/girnamespaces.pas b/applications/gobject-introspection/girnamespaces.pas
index 005b0db54..66960a64f 100644
--- a/applications/gobject-introspection/girnamespaces.pas
+++ b/applications/gobject-introspection/girnamespaces.pas
@@ -37,7 +37,10 @@ type
FCIncludeName: String;
FConstants: TList;
FCPackageName: String;
+ FCPrefix: String;
+ FDeprecatedVersion: TGirVersion;
FFunctions: TList;
+ FMaxSymbolVersion: TGirVersion;
FNameSpace: String;
FOnlyImplied: Boolean;
FOnNeedGirFile: TgirNeedGirFileEvent;
@@ -46,7 +49,7 @@ type
FSharedLibrary: String;
FTypes: TFPHashObjectList;
FUnresolvedTypes: TList;
- FVersion: String;
+ FVersion: TGirVersion;
procedure SetOnNeedGirFile(AValue: TgirNeedGirFileEvent);
protected
function AddFuzzyType(AName: String; ACType: String): TGirBaseType;
@@ -69,8 +72,8 @@ type
procedure HandleClass(ANode: TDomNode); // one step above GType. Is the object structure and it's methods. ClassStruct is like the VMT
procedure HandleInterface(ANode: TDomNode);
procedure AddGLibBaseTypes;
- procedure AddType(AType: TGirBaseType);
public
+ procedure AddType(AType: TGirBaseType);
function LookupTypeByName(AName: String; const ACType: String; SearchOnly: Boolean = False): TGirBaseType;
function ResolveFuzzyType(AFuzzyType: TgirFuzzyType): TGirBaseType;
function UsesGLib: Boolean;
@@ -83,9 +86,10 @@ type
property NameSpace: String read FNameSpace;
property CIncludeName: String read FCIncludeName;
property CPackageName: String read FCPackageName;
+ property CPrefix: String read FCPrefix;
property RequiredNameSpaces: TList Read FRequiredNameSpaces;
property SharedLibrary: String read FSharedLibrary;
- property Version: String read FVersion;
+ property Version: TGirVersion read FVersion;
property OnlyImplied: Boolean read FOnlyImplied;
property Owner: TObject Read FOwner;
@@ -95,6 +99,10 @@ type
property Functions: TList read FFunctions;
property Constants: TList read FConstants;
property UnresolvedTypes: TList read FUnresolvedTypes write FUnresolvedTypes;
+ // exclude symbols newer than this version
+ property MaxSymbolVersion: TGirVersion read FMaxSymbolVersion write FMaxSymbolVersion;
+ // exclude symbols this version and older that are marked as deprecated
+ property DeprecatedVersion: TGirVersion read FDeprecatedVersion write FDeprecatedVersion;
end;
{ TgirNamespaces }
@@ -208,7 +216,7 @@ var
Item: TgirAlias;
begin
Item := TgirAlias.Create(Self, ANode);
- Types.Add(Item.Name, Item);
+ AddType(Item);
end;
procedure TgirNamespace.HandleConstant(ANode: TDomNode);
@@ -224,7 +232,7 @@ var
Item : TgirEnumeration;
begin
Item := TgirEnumeration.Create(Self, ANode);
- Types.Add(Item.Name, Item);
+ AddType(Item);
end;
procedure TgirNamespace.HandleBitField(ANode: TDomNode);
@@ -232,7 +240,7 @@ var
Item : TgirBitField;
begin
Item := TgirBitField.Create(Self, ANode);
- Types.Add(Item.Name, Item);
+ AddType(Item);
end;
procedure TgirNamespace.HandleCallback(ANode: TDOMNode);
@@ -240,7 +248,7 @@ var
Item: TgirCallback;
begin
Item := TgirCallback.Create(Self, ANode);
- Types.Add(Item.Name, Item);
+ AddType(Item);
end;
procedure TgirNamespace.HandleFunction(ANode: TDOMNode);
@@ -256,7 +264,7 @@ var
Item: TgirUnion;
begin
Item := TgirUnion.Create(Self, ANode);
- Types.Add(Item.Name, Item);
+ AddType(Item);
end;
procedure TgirNamespace.HandleRecord(ANode: TDomNode);
@@ -274,7 +282,7 @@ begin
else
begin
Item := tgirRecord.Create(Self, ANode);
- Types.Add(Item.Name, Item);
+ AddType(Item);
end;
end;
@@ -284,7 +292,7 @@ var
Item: TgirObject;
begin
Item := TgirObject.Create(Self, ANode);
- Types.Add(Item.Name, Item);
+ AddType(Item);
end;
procedure TgirNamespace.HandleGType(ANode: TDomNode);
@@ -292,7 +300,7 @@ var
Item: TgirGType;
begin
Item := TgirGType.Create(Self, ANode);
- Types.Add(Item.Name, Item);
+ AddType(Item);
end;
procedure TgirNamespace.HandleClassStruct(ANode: TDomNode);
@@ -328,7 +336,7 @@ procedure TgirNamespace.AddGLibBaseTypes;
if TranslatedName <> '' then
NativeType.TranslatedName:=TranslatedName;
NativeType.ImpliedPointerLevel:=3;
- Types.Add(NativeType.Name, NativeType);
+ AddType(NativeType);
Result := NativeType;
end;
@@ -347,6 +355,8 @@ begin
if (PrevFound <> nil) and (PrevFound.ObjectType = otFuzzyType) then
begin
(PrevFound as TgirFuzzyType).ResolvedType := AType;
+ //WriteLn('Resolved FuzzyType: ', AType.Name);
+ FUnresolvedTypes.Remove(PrevFound);
end;
//if PrevFound <> nil then WriteLn('Found Name Already Added: ', AType.Name, ' ', PrevFound.ObjectType, ' ', AType.ObjectType);
if PrevFound = nil then
@@ -387,6 +397,7 @@ begin
begin
Fuzzy.ResolvedType := Tmp;
Tmp.ImpliedPointerLevel:=Fuzzy.ImpliedPointerLevel;
+ Tmp.DeprecatedOverride:= Tmp.DeprecatedOverride or Fuzzy.DeprecatedOverride;
i := FuzzyI+1;
Fuzzy := nil;
//WriteLn('Resolved Fuzzy Type: ', Tmp.CType);
@@ -477,6 +488,9 @@ begin
if (PlainCType = 'GType') {or (AName = 'Type')} or (AName = 'GType')then
AName := 'GLib.Type';
+ if AName = 'any' then
+ AName := 'gpointer';
+
FPos := Pos('.', AName);
if FPos > 0 then // type includes namespace "NameSpace.Type"
@@ -507,7 +521,6 @@ begin
if Result <> nil then
Result.ImpliedPointerLevel:=PointerLevel;
-
end;
function TgirNamespace.ResolveFuzzyType(AFuzzyType: TgirFuzzyType): TGirBaseType;
@@ -572,16 +585,19 @@ begin
FNameSpace:=Node.GetAttribute('name');
FRequiredNameSpaces := AIncludes;
FSharedLibrary:=Node.GetAttribute('shared-library');
- FVersion:=Node.GetAttribute('version');
+ FVersion:=girVersion(Node.GetAttribute('version'));
+ FCPrefix:=Node.GetAttribute('c:prefix');
SetCInclude;
SetPackage;
- girError(geDebug, Format('Creating namespace=%s Version=%s LibName=%s',[FNameSpace, FVersion, FSharedLibrary]));
+ girError(geDebug, Format('Creating namespace=%s Version=%s LibName=%s',[FNameSpace, FVersion.AsString, FSharedLibrary]));
FConstants := TList.Create;
FFunctions := TList.Create;
FTypes := TFPHashObjectList.Create(True);
FUnresolvedTypes := TList.Create;
+ FMaxSymbolVersion.Major:=MaxInt;
+
if FNameSpace = 'GLib' then
AddGLibBaseTypes;
end;
diff --git a/applications/gobject-introspection/girobjects.pas b/applications/gobject-introspection/girobjects.pas
index 4c59ede4f..c9d12d2cf 100644
--- a/applications/gobject-introspection/girobjects.pas
+++ b/applications/gobject-introspection/girobjects.pas
@@ -35,37 +35,52 @@ type
otGType, otInterface, otMethod, otNativeType, otObject, otProperty,
otRecord, otTypeParam, otUnion, otVirtualMethod);
+
{ TGirBaseType }
TGirBaseType = class
private
FBits: Integer;
FCType: String;
+ FDeprecated: Boolean;
+ FDeprecatedMsg: String;
+ FDeprecatedOverride: Boolean;
+ FDeprecatedVersion: TGirVersion;
FDoc: String;
FForwardDefinitionWritten: Boolean;
+ FGLibGetType: String;
FHasFields: Boolean;
FImpliedPointerLevel: Integer;
FName: String;
FObjectType: TGirObjectType;
+ FDisguised: Boolean;
FOwner: TObject;
FTranslatedName: String;
- FVersion: String;
+ FVersion: TGirVersion;
FWriting: TGirModeState;
procedure SetImpliedPointerLevel(AValue: Integer);
function MaybeResolvedType: TGirBaseType;
+ function GetPointerLevelFromCType(ACType: String = ''): Integer;
public
constructor Create(AOwner: TObject; ANode: TDomNode); virtual;
property CType: String read FCType write FCType;
+ property GLibGetType: String read FGLibGetType;
property Name: String read FName;
property TranslatedName: String read FTranslatedName write FTranslatedName;
property ImpliedPointerLevel: Integer read FImpliedPointerLevel write SetImpliedPointerLevel; // only grows
property Owner: TObject Read FOwner; // TgirNameSpace
property Doc: String read FDoc;
property Bits: Integer read FBits;
- property Version: String read FVersion;
+ property Version: TGirVersion read FVersion;
property ForwardDefinitionWritten: Boolean read FForwardDefinitionWritten write FForwardDefinitionWritten;
property Writing: TGirModeState read FWriting write FWriting;
+ property Disguised: Boolean read FDisguised; // only access this type with the functions given not fieids directly.
property ObjectType: TGirObjectType read FObjectType;
+ property Deprecated: Boolean read FDeprecated;
+ property DeprecatedMsg: String read FDeprecatedMsg;
+ property DeprecatedVersion: TGirVersion read FDeprecatedVersion;
+ { if an object that is not deprecated depends on this deprecated item then override it. }
+ property DeprecatedOverride: Boolean read FDeprecatedOverride write FDeprecatedOverride;
end;
{ TgirNativeTypeDef }
@@ -142,6 +157,8 @@ type
private
FFixedSize: Integer;
FParentFieldName: String;
+ FNode: TDOMNode;
+ function GetBestPointerLevel: Integer; // only works while the Constructor is active.
public
constructor Create(AOwner: TObject; ANode: TDomNode); override;
property FixedSize: Integer read FFixedSize;
@@ -152,6 +169,7 @@ type
TgirConstant = class(TGirBaseType)
private
+ FCName: String;
FIsString: Boolean;
FTypeDecl: TGirBaseType;
FValue: String;
@@ -160,6 +178,7 @@ type
property TypeDecl: TGirBaseType read FTypeDecl;
property Value: String read FValue;
property IsString: Boolean read FIsString;
+ property CName: String read FCName;
end;
{ TgirEnumeration }
@@ -184,12 +203,15 @@ type
TgirEnumeration = class(TGirBaseType)
private
FMembers: TgirEnumList;
- procedure AddMember(AName, AValue, ACIdentifier: String);
+ FNeedsSignedType: Boolean;
+ FNotIntTypeEnum: Boolean;
+ procedure AddMember(AName, AValue, ACIdentifier: String; Node: TDomElement);
procedure HandleFunction(ANode: TDomNode);
public
constructor Create(AOwner: TObject; ANode: TDomNode); override;
destructor Destroy; override;
property Members: TgirEnumList read FMembers;
+ property NeedsSignedType: Boolean read FNeedsSignedType;
end;
{ TgirBitField }
@@ -227,9 +249,6 @@ type
TgirFunction = class(TGirBaseType)
private
FCIdentifier: String;
- FDeprecated: Boolean;
- FDeprecatedMsg: String;
- FDeprecatedVersion: String;
FParams: TgirParamList;
FReturns: TgirFunctionReturn;
FThrowsGError: Boolean;
@@ -239,9 +258,6 @@ type
property Params: TgirParamList read FParams;
property Returns: TgirFunctionReturn read FReturns;
property CIdentifier: String read FCIdentifier;
- property Deprecated: Boolean read FDeprecated;
- property DeprecatedMsg: String read FDeprecatedMsg;
- property DeprecatedVersion: String read FDeprecatedVersion;
property ThrowsGError: Boolean read FThrowsGError write FThrowsGError;
end;
@@ -489,6 +505,9 @@ begin
FOwner := AOwner;
FCType:=AGType;
FName:=AGType; // used by LookupName in namespace
+ FVersion := TgirNamespace(FOwner).Version.AsMajor;
+ FDeprecatedVersion := girVersion(MaxInt, MaxInt);
+
//now some fixups :(
if FName = 'gchar' then
FName := 'utf8';
@@ -540,7 +559,8 @@ begin
while Node <> nil do
begin
case GirTokenNameToToken(Node.NodeName) of
- gtDoc:; // ignore
+ gtDoc,
+ gtDocDeprecated:; // ignore
gtType: FPropType := TgirNamespace(Owner).LookupTypeByName(Node.GetAttribute('name'), Node.GetAttribute('c:type'));
gtArray:
begin
@@ -650,23 +670,55 @@ end;
{ TgirArray }
+function TgirArray.GetBestPointerLevel: Integer;
+var
+ ArrayCType: String;
+ TypeCType: String;
+ TypeNode: TDOMElement;
+ ArrayCTypeLevel,
+ TypeCTypeLevel: Integer;
+begin
+ ArrayCType:=TDOMElement(FNode).GetAttribute('c:type');
+ TypeNode := TdomElement(FNode.FindNode('type'));
+ TypeCType:=TDOMElement(TypeNode).GetAttribute('c:type');
+
+
+ ArrayCTypeLevel := GetPointerLevelFromCType(ArrayCType);
+ TypeCTypeLevel := GetPointerLevelFromCType(TypeCType);
+
+ if ArrayCTypeLevel > TypeCTypeLevel then
+ begin
+ FCType:=ArrayCType;
+ Exit(ArrayCTypeLevel)
+ end;
+
+ Result := TypeCTypeLevel;
+ //FCType:=TypeCType; // already assigned in TgirTypeParam.Create
+end;
+
constructor TgirArray.Create(AOwner: TObject; ANode: TDomNode);
var
Node: TDomELement;
begin
+ FObjectType:=otArray;
+ FNode := ANode;
inherited Create(AOwner, ANode);
+ // ctype is in two places for arrays. one as an attribute of the array node.
+ // and in the subnode 'type' assigned above in inherited Create.
+ FPointerLevel:=GetBestPointerLevel;
Node := TDomElement(ANode.FindNode('type'));
if Node <> nil then
begin
FVarType := TgirNamespace(Owner).LookupTypeByName(Node.GetAttribute('name'), CType);
+ FVarType.ImpliedPointerLevel:=FPointerLevel;
TryStrToInt(TDomElement(ANode).GetAttribute('fixed-size'), FFixedSize);
end;
+
Node := TDOMElement(ANode.ParentNode);
FParentFieldName := Node.GetAttribute('name');
if FName = '' then
FName := FParentFieldName;
- FObjectType:=otArray;
end;
{ TgirObject }
@@ -712,7 +764,8 @@ begin
while Node <> nil do
begin
case GirTokenNameToToken(Node.NodeName) of
- gtDoc:;
+ gtDoc,
+ gtDocDeprecated:;
gtType: FFields.Add(TgirTypeParam.Create(Owner, ANode));
gtCallback: FFields.Add(TgirCallback.Create(Owner, Node));
gtArray: Fields.Add(TgirArray.Create(Owner, Node));
@@ -730,7 +783,8 @@ var
NameStr: String;
begin
case ANodeType of
- gtDoc:;
+ gtDoc,
+ gtDocDeprecated:;
gtField : HandleField(ANode);
gtUnion: HandleUnion(ANode);
gtFunction: begin
@@ -778,13 +832,12 @@ end;
constructor TGirFunctionParam.Create(AOwner: TObject; ANode: TDomNode);
begin
inherited Create(AOwner, ANode);
- FObjectType:=otFunctionParam;
end;
-constructor TGirFunctionParam.Create(AOwner: TObject; ANode: TDomNode;
- AIsInstanceParam: Boolean);
+constructor TGirFunctionParam.Create(AOwner: TObject; ANode: TDomNode; AIsInstanceParam: Boolean);
begin
inherited Create(AOwner, ANode, AIsInstanceParam);
+ FObjectType:=otFunctionParam;
end;
{ TgirTypeParam }
@@ -837,7 +890,7 @@ constructor TgirTypeParam.Create(AOwner: TObject; ANode: TDomNode);
if Pos('const ', C_Type) > 0 then
begin
FIsConst:=True;
- Result := Copy(C_Type, 7, Length(C_Type) - 6);
+ Result := Copy(C_Type, 7, Length(C_Type));
end
else
Result := C_Type;
@@ -848,6 +901,10 @@ var
Tmp: String;
Token: TGirToken;
VarTypeName: String;
+ SubTypeNode: TDomElement;
+ SubTypeName: String;
+ ParamDir: TGirToken;
+ ParamPointerLevel: Integer;
begin
inherited Create(AOwner, ANode);
//NodeURL(ANode);
@@ -856,12 +913,24 @@ begin
if Node = nil then
girError(geError, Format(geMissingNode,[ClassName, '', ANode.NodeName]));
+ FPointerLevel:=-1;
+
+ ParamDir:= GirTokenNameToToken(TDomElement(ANode).GetAttribute('direction'));
+ case ParamDir of
+ gtIn,
+ gtEmpty: ParamPointerLevel := 0;
+ gtOut,
+ gtInOut: ParamPointerLevel := 1;
+ end;
+
+
while Node <> nil do
begin
// it's one or the other
Token := GirTokenNameToToken(Node.NodeName);
case Token of
- gtDoc:;
+ gtDoc,
+ gtDocDeprecated:;
gtType: begin
C_Type := AssignC_Type(Node.GetAttribute('c:type'));
@@ -870,13 +939,30 @@ begin
if VarTypeName = '' then
VarTypeName:= StringReplace(C_Type, '*', '', [rfReplaceAll]);
FVarType := TgirNamespace(Owner).LookupTypeByName(VarTypeName, C_Type);
+
+ SubTypeNode := TDomElement(Node.FindNode('type'));
+ if SubTypeNode <> nil then
+ begin
+ SubTypeName := SubTypeNode.GetAttribute('name');
+ if (SubTypeName = 'any') or (SubTypeName = 'gpointer') then // 'any' means gpointer for some reason
+ Inc(ParamPointerLevel);
+ end;
+ if InheritsFrom(TgirArray) then
+ ParamPointerLevel:=TgirArray(Self).GetBestPointerLevel
+ else if GetPointerLevelFromCType > ParamPointerLevel then
+ ParamPointerLevel:=GetPointerLevelFromCType;
end;
gtArray: begin
+
C_Type := AssignC_Type(Node.GetAttribute('c:type'));
FVarType := TgirNamespace(Owner).LookupTypeByName(TDOMElement(Node.FirstChild).GetAttribute('name'), C_Type);
Tmp := Node.GetAttribute('length');
if Tmp <> '' then
FVarType.ImpliedPointerLevel:=StrToInt(Tmp);
+ if PointerLevelFromVarName(C_Type) > ParamPointerLevel then
+ ParamPointerLevel:=PointerLevelFromVarName(C_Type);
+ if (ParamPointerLevel = 0) and (ParamDir in [gtOut, gtInOut]) then
+ ParamPointerLevel:=1;
end;
gtVarArgs: begin
FVarType := nil
@@ -888,11 +974,21 @@ begin
end;
-
- FPointerLevel := PointerLevelFromVarName(C_Type);
+ //if FPointerLevel = -1 then
+ // FPointerLevel := PointerLevelFromVarName(C_Type);
+ if ParamPointerLevel > FPointerLevel then
+ FPointerLevel:=ParamPointerLevel;
if (FVarType <> nil) {and (GirTokenNameToToken(ANode.NodeName) = gtArray)} then
- FVarType.ImpliedPointerLevel := PointerLevelFromVarName(CType);
+ begin
+ FVarType.ImpliedPointerLevel:=FPointerLevel;
+ //FVarType.ImpliedPointerLevel := PointerLevelFromVarName(CType);
+ if FVarType.Deprecated and (TgirNamespace(Owner).DeprecatedVersion <= DeprecatedVersion) and not FVarType.DeprecatedOverride then
+ begin
+ girError(geWarn, Format('Type %s is deprecated but is used by %s. Including %s',[FVarType.CType, Name, FVarType.CType]));
+ FVarType.DeprecatedOverride:=True;
+ end;
+ end;
if (FVarType <> nil) and (Token <> gtVarArgs) then
FVarType.ImpliedPointerLevel:=PointerLevel; //only will grow
@@ -911,7 +1007,7 @@ begin
Node := TDOMElement(Node.ParentNode);
end;
WriteLn('Vartype is nil when it shouldnt be! '+VarTypeName );
- raise Exception.Create('Vartype is nil when it shouldnt be! ');
+ raise Exception.Create('Vartype is nil when it shouldn''t be! ');
end;
FObjectType:=otTypeParam;
end;
@@ -979,13 +1075,14 @@ var
while PNode <> nil do
begin
case GirTokenNameToToken(PNode.NodeName) of
- gtDoc:;
+ gtDoc,
+ gtDocDeprecated:;
gtParameter:
begin
- Param := TGirFunctionParam.Create(AOwner, PNode);
+ Param := TGirFunctionParam.Create(AOwner, PNode, False);
FParams.Add(Param);
end;
- gtInstanceParameter:
+ gtInstanceParameter:
begin
Param := TGirFunctionParam.Create(AOwner, PNode, True);
FParams.Add(Param);
@@ -1020,7 +1117,8 @@ begin
while Node <> nil do
begin
case GirTokenNameToToken(Node.NodeName) of
- gtDoc:;
+ gtDoc,
+ gtDocDeprecated:;
gtReturnValue: FReturns := TgirFunctionReturn.Create(AOwner, Node);
gtParameters: CreateParameters(Node);
else
@@ -1033,12 +1131,6 @@ begin
WriteLn('Return value not defined for: ', Name);
Halt
end;
- FDeprecated:=TDOMElement(ANode).GetAttribute('deprecated') <> '';
- if FDeprecated then
- begin
- FDeprecatedMsg:=TDOMElement(ANode).GetAttribute('deprecated');
- FDeprecatedVersion:=TDOMElement(ANode).GetAttribute('deprecated-version');
- end;
FObjectType:=otFunction;
end;
@@ -1063,14 +1155,40 @@ end;
{ TgirEnumeration }
-procedure TgirEnumeration.AddMember(AName, AValue, ACIdentifier: String);
+procedure TgirEnumeration.AddMember(AName, AValue, ACIdentifier: String;
+ Node: TDomElement);
var
Member: PgirEnumMember;
+ IntValue: LongInt;
+ FailPoint: Integer;
begin
+ if (ACIdentifier = '') and Assigned(Node) then
+ begin
+ // sometimes there is an attribute child node
+ Node := TDomElement(Node.FirstChild);
+ while Node <> nil do
+ begin
+ if Node.NodeName = 'attribute' then
+ begin
+ if Node.GetAttribute('name') = 'c:identifier' then
+ ACIdentifier:=Node.GetAttribute('value');
+ end;
+ Node := TDomElement(Node.NextSibling);
+ end;
+ end;
if ACIdentifier = 'GDK_DRAG_MOTION' then ACIdentifier := 'GDK_DRAG_MOTION_';
if ACIdentifier = 'GDK_DRAG_STATUS' then ACIdentifier := 'GDK_DRAG_STATUS_';
if ACIdentifier = 'GDK_PROPERTY_DELETE' then ACIdentifier := 'GDK_PROPERTY_DELETE_';
+ // See of the enum needs a signed type or not. Probably not.
+ if not FNotIntTypeEnum and not FNeedsSignedType then
+ begin
+ Val(AValue, IntValue, FailPoint);
+ if (FailPoint = 0) and (Length(AValue) > 0) and (AValue[1] = '-') then
+ FNeedsSignedType:=True;
+ if FailPoint <> 0 then
+ FNotIntTypeEnum:=True; // so we won't continue trying to convert invalid values to ints.
+ end;
New(Member);
Member^.Name:=AName;
@@ -1100,8 +1218,9 @@ begin
while Node <> nil do
begin
case GirTokenNameToToken(Node.NodeName) of
- gtDoc:;
- gtMember: AddMember(Node.GetAttribute('name'), Node.GetAttribute('value'),Node.GetAttribute('c:identifier'));
+ gtDoc,
+ gtDocDeprecated:;
+ gtMember: AddMember(Node.GetAttribute('name'), Node.GetAttribute('value'),Node.GetAttribute('c:identifier'), Node);
// some enumerations seem to have functions part of them. They are only functions directly related to the enumeration and cannot be part of the enum
gtFunction: HandleFunction(Node);
else
@@ -1127,10 +1246,13 @@ var
Node: TDOMElement;
begin
inherited Create(AOwner, ANode);
+ FCName:=TDomELement(ANode).GetAttribute('c:type');
+ if FCName = '' then
+ FCName := FName;
Node := TDomELement(ANode.FindNode('type'));
FTypeDecl := TgirNamespace(Owner).LookupTypeByName(Node.GetAttribute('name'), Node.GetAttribute('c:type'));
FValue:= TDOMElement(ANode).GetAttribute('value');
- FIsString:=Node.GetAttribute('c:type') = 'gchar*';
+ FIsString:=(Node.GetAttribute('c:type') = 'gchar*') or (Node.GetAttribute('name') = 'utf8');
//girError(geDebug, Format('Added constant "%s" with value "%s" of type "%s"',[Name, Value, FTypeDecl.Name]));
FObjectType:=otConstant;
end;
@@ -1158,6 +1280,8 @@ begin
FOwner := AOwner;
FCType:=ACtype;
FObjectType:=otFuzzyType;
+ FVersion := TgirNamespace(FOwner).Version.AsMajor;
+ FDeprecatedVersion := girVersion(MaxInt, MaxInt); // not deprecated
//girError(geFuzzy, 'Creating Fuzzy Type "'+AName+'/'+ACtype+'"');
end;
@@ -1200,6 +1324,8 @@ begin
FCType:=ACType;
FTranslatedName:=ATranslatedName;
FObjectType:=otAlias;
+ FVersion := TgirNamespace(FOwner).Version.AsMajor;
+ FDeprecatedVersion := girVersion(MaxInt, MaxInt); // not deprecated
end;
{ TGirBaseType }
@@ -1222,7 +1348,19 @@ begin
Result := Self;
end;
-constructor TGirBaseType.Create(AOwner: TObject; ANode: TDOMNode);
+function TGirBaseType.GetPointerLevelFromCType(ACType: String): Integer;
+var
+ C: Char;
+begin
+ if ACType = '' then
+ ACType:=FCType;
+ Result := 0;
+ for C in ACType do
+ if C = '*' then
+ Inc(Result);
+end;
+
+constructor TGirBaseType.Create(AOwner: TObject; ANode: TDomNode);
var
Element: TDOMElement absolute ANode;
Node: TDomNode;
@@ -1232,8 +1370,17 @@ begin
girError(geError, 'Creating '+ClassName+' with a nil node');
FOwner := AOwner;
FCType := Element.GetAttribute('c:type');
+ if FCType = '' then
+ FCType := Element.GetAttribute('glib:type-name');
FName := Element.GetAttribute('name');
- FVersion:= Element.GetAttribute('version');
+ try
+ FVersion:= girVersion(Element.GetAttribute('version'));
+ except
+ FVersion := TgirNamespace(FOwner).Version.AsMajor;
+ end;
+
+ FDisguised := Element.GetAttribute('disguised') = '1';
+ FGLibGetType:= Element.GetAttribute('glib:get-type');
AttrValue := Element.GetAttribute('bits');
if AttrValue <> '' then
FBits := StrToInt(AttrValue);
@@ -1241,6 +1388,24 @@ begin
if Node <> nil then
FDoc := Node.FirstChild.TextContent;
ImpliedPointerLevel:=2;
+ FDeprecated:=TDOMElement(ANode).GetAttribute('deprecated') = '1';
+ if FDeprecated then
+ begin
+ Node := ANode.FindNode('doc-deprecated');
+ if Node <> nil then
+ begin
+ FDeprecatedMsg:=StringReplace(Node.TextContent, #10, ' ', [rfReplaceAll]);
+ FDeprecatedMsg := StringReplace(FDeprecatedMsg, '''', '''''', [rfReplaceAll]); // replace ' with ''
+ end;
+ try
+ FDeprecatedVersion:=girVersion(TDOMElement(ANode).GetAttribute('deprecated-version'));
+ except
+ FDeprecatedVersion:=TgirNamespace(FOwner).Version.AsMajor;
+ end;
+ end
+ else
+ FDeprecatedVersion := girVersion(MaxInt, MaxInt); // not deprecated
+
FObjectType:=otBaseType;
end;
diff --git a/applications/gobject-introspection/girpascalwriter.pas b/applications/gobject-introspection/girpascalwriter.pas
index 8b8512a94..98882bd36 100644
--- a/applications/gobject-introspection/girpascalwriter.pas
+++ b/applications/gobject-introspection/girpascalwriter.pas
@@ -60,6 +60,7 @@ begin
FUnits := TList.Create;
FDefaultUnitExtension:='.pas';
FOptions:=AOptions;
+ FUnitPrefix:=AUnitPrefix;
end;
procedure TgirPascalWriter.GenerateUnits;
diff --git a/applications/gobject-introspection/girpascalwritertypes.pas b/applications/gobject-introspection/girpascalwritertypes.pas
index f04c501b4..f6e6bdb09 100644
--- a/applications/gobject-introspection/girpascalwritertypes.pas
+++ b/applications/gobject-introspection/girpascalwritertypes.pas
@@ -49,7 +49,7 @@ type
private
FDynamicFunctions: Boolean;
public
- constructor Create(ADynamicFunctions: Boolean);
+ constructor Create(ADynamicFunctions: Boolean); reintroduce;
function AsString: String; override;
end;
@@ -111,7 +111,7 @@ type
FFunctionSection: TPDeclarationFunctions;
FUsesSection: TPUses;
public
- constructor Create(AOwner: TObject; AUses: TPUses; ADynamicFunctions: Boolean);
+ constructor Create(AOwner: TObject; AUses: TPUses; ADynamicFunctions: Boolean); reintroduce;
destructor Destroy; override;
function AsString: String; override;
property UsesSection: TPUses read FUsesSection;
@@ -155,7 +155,6 @@ type
FUnitPrefix: String;
FWriter: TObject;//girPascalWriter;
FUnits: TFPList;
- //Units: array[TPascalUnitType] of TPascalUnit;
function GetUnitForType(AType: TPascalUnitType): TPascalUnit;
public
constructor Create(AWriter: TObject{TgirPascalWriter}; ANameSpace: TgirNamespace; AOptions: TgirOptions; AUnitPrefix: String);
@@ -218,7 +217,7 @@ type
procedure WriteFunctionTypeAndReturnType(AItem: TgirFunction; out AFunctionType, AFunctionReturnType: 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 WriteParamAsString(AParentName: String; 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;
function WriteUnion(AUnion: TgirUnion; ASkipRecordName: Boolean; ABaseIndent: Integer = 0): String;
function ParenParams(const AParams: String; const AForceParens: Boolean = False): String;
@@ -246,7 +245,8 @@ type
public
constructor Create(AGroup: TPascalUnitGroup; ANameSpace: TgirNamespace; AOptions: TgirOptions; AUnitType: TPascalUnitTypes; AUnitPrefix: String);
destructor Destroy; override;
- procedure ProcessConsts(AList:TList); // of TgirBaseType descandants
+ function MeetsVersionConstraints(AItem: TGirBaseType): Boolean;
+ procedure ProcessConsts(AList: TList; AUsedNames: TStringList); // of TgirBaseType descandants
procedure ProcessTypes(AList:TFPHashObjectList); // of TgirBaseType descandants
procedure ProcessFunctions(AList:TList);// of TgirFunction
procedure GenerateUnit;
@@ -335,6 +335,7 @@ begin
FUnits := TFPList.Create;
FUnitPrefix:=AUnitPrefix;
FSimpleUnit := ([goSeperateConsts, goClasses, goObjects] * AOptions ) = [];
+ FUnitPrefix:=AUnitPrefix;
if FSimpleUnit then
begin
@@ -369,13 +370,31 @@ begin
end;
procedure TPascalUnitGroup.GenerateUnits;
+ function CollectFunctionNames: TStringList;
+ var
+ i: Integer;
+ begin
+ Result := TStringList.Create;
+ Result.Duplicates:=dupError;
+ if UnitForType[utConsts] <> UnitForType[utFunctions] then
+ Exit;
+ Result.Capacity := FNameSpace.Functions.Count;
+ for i := 0 to FNameSpace.Functions.Count-1 do
+ Result.Add(TgirFunction(FNameSpace.Functions.Items[i]).CIdentifier);
+
+ Result.Sorted:=True;
+ end;
+
var
PUnit: TPascalUnit;
+ lUsedNames: TStringList;
begin
for Pointer(PUnit) in FUnits do
if Assigned(PUnit) then
PUnit.GenerateUnit;
- UnitForType[utConsts].ProcessConsts(FNameSpace.Constants);
+ lUsedNames := CollectFunctionNames;
+ UnitForType[utConsts].ProcessConsts(FNameSpace.Constants, lUsedNames);
+ lUsedNames.Free;
UnitForType[utTypes].ProcessTypes(FNameSpace.Types);
UnitForType[utFunctions].ProcessFunctions(FNameSpace.Functions);
for Pointer(PUnit) in FUnits do
@@ -559,12 +578,12 @@ end;
function TPascalUnit.GetUnitName: String;
begin
- Result := CalculateUnitName(FNameSpace.NameSpace, FNameSpace.Version);
+ Result := FGroup.FUnitPrefix + CalculateUnitName(FNameSpace.NameSpace, FNameSpace.Version.AsString);
end;
function TPascalUnit.GetUnitFileName: String;
begin
- Result := UnitPrefix+UnitName+GetUnitPostfix;
+ Result := {UnitPrefix+}UnitName+GetUnitPostfix;
end;
function TPascalUnit.GetUnitPostfix: String;
@@ -677,13 +696,18 @@ begin
if (AType.CType = '') then //(AType.Name = '') then
begin
- girError(geWarn, 'Type.Ctype undefined! : '+ Atype.Name);
+ //girError(geWarn, 'Type.Ctype undefined! : '+ Atype.Name);
//Halt;
end;
if ProcessLevel > 0 then
begin
WriteForwardDefinition(AType);
+ if AType.Deprecated and not AType.DeprecatedOverride and not (MeetsVersionConstraints(AType))then
+ begin
+ AType.DeprecatedOverride:=True;
+ girError(girErrors.geWarn, Format('Type %s is deprecated but is pulled in by a field or parameter',[AType.CType]));
+ end;
if AType.InheritsFrom(TgirCallback) or AType.InheritsFrom(TgirBitField) then
AForceWrite:=True;
if not AForceWrite then
@@ -695,6 +719,10 @@ begin
Exit;
end;
+
+ if not MeetsVersionConstraints(AType) then
+ Exit;
+
//if AForceWrite then
// WriteLn('ForceWriting: ', AType.CType);
@@ -756,6 +784,7 @@ begin
if CTypesType <> '' then
begin
FuzzyType.TranslatedName:= CTypesType;
+ //FuzzyType.TranslatedName:= FNameSpace.CPrefix + FuzzyType.Name;
FuzzyType.Writing := msWritten;
end;
end;
@@ -880,6 +909,7 @@ var
ResolvedForName: String;
CType: TGirBaseType = nil;
ProperUnit: TPascalUnit;
+ TargetType: TGirBaseType = nil;
begin
ProperUnit := FGroup.GetUnitForType(utTypes);
if ProperUnit <> Self then begin
@@ -887,12 +917,18 @@ begin
Exit;
end;
ResolveTypeTranslation(AItem);
- ResolveTypeTranslation(AItem.ForType);
+
+ TargetType := AItem.ForType;
+
+ ResolveTypeTranslation(TargetType);
+
+ if TargetType.ClassType = TgirFuzzyType then writeln('Alias for type assigned to fuzzy type! ', TargetType.Name);
+
// some aliases are just for the parser to connect a name to an alias
if AItem.CType = '' then
Exit;
- ResolvedForName := aItem.ForType.TranslatedName;
+ ResolvedForName := TargetType.TranslatedName;
if ResolvedForName = '' then
begin
{
@@ -941,7 +977,7 @@ var
CName: String;
TypeName: String;
ProperUnit: TPascalUnit;
-
+ IntType: String;
begin
ProperUnit := FGroup.GetUnitForType(utTypes);
if ProperUnit <> Self then begin
@@ -960,9 +996,14 @@ begin
TypeName := ': '+AItem.TranslatedName;
+ if AItem.NeedsSignedType then
+ IntType := 'Integer'
+ else
+ IntType := 'DWord';
+
// yes we cheat a little here using the const section to write type info
ConstSection.Lines.Add('type');
- ConstSection.Lines.Add(IndentText(AItem.TranslatedName+' = Integer;', 2,0));
+ ConstSection.Lines.Add(IndentText(AItem.TranslatedName+' = '+IntType+';', 2,0));
ConstSection.Lines.Add('const');
end
else
@@ -1131,6 +1172,10 @@ begin
ProperUnit.HandleFunction(AItem);
Exit;
end;
+
+ if not MeetsVersionConstraints(AItem) then
+ Exit; // ==>
+
WriteFunctionTypeAndReturnType(AItem, RoutineType, Returns);
Params := WriteFunctionParams(AItem.Params);
Postfix := ' external;';// '+UnitName+'_library;';
@@ -1164,7 +1209,7 @@ begin
Result := '';
OptionsIndicateWrapperMethod:= FUnitType = PascalUnitTypeAll;
// we skip deprecated functions
- if AFunction.Deprecated and not (goIncludeDeprecated in FOptions) then //and (CompareStr(AFunction.DeprecatedVersion, NameSpace.Version) >= 0) then
+ if not MeetsVersionConstraints(AFunction) then
Exit;
// some abstract functions that are to be implemented by a module and shouldn't be declared. There is no indicator in the gir file that this is so :(
@@ -1177,7 +1222,14 @@ begin
if AWantWrapperForObject then
InLineS:=' inline;';
- if AFunction.Deprecated then DeprecatedS :=' deprecated ''Since ' + NameSpace.NameSpace + ' ' + AFunction.DeprecatedVersion+' '+StringReplace(AFunction.DeprecatedMsg,'''','`', [rfReplaceAll])+''';';
+ if AFunction.Deprecated then
+ begin
+ if AFunction.DeprecatedMsg = '' then
+ DeprecatedS :=' deprecated ''Since ' + NameSpace.NameSpace + ' ' + AFunction.DeprecatedVersion.AsString+' '+StringReplace(AFunction.DeprecatedMsg,'''','`', [rfReplaceAll])+''';'
+ else
+ DeprecatedS :=' deprecated '''+AFunction.DeprecatedMsg+''';';
+ end;
+
// this fills in the values for procedure/function and the return type
WriteFunctionTypeAndReturnType(AFunction, RoutineType, Returns);
@@ -1328,6 +1380,9 @@ var
Comment: String='';
OptionsIndicateWrapperMethod: Boolean;
begin
+ Result := '';
+ if AProperty.Deprecated and not (goIncludeDeprecated in FOptions) then
+ Exit;
OptionsIndicateWrapperMethod:=FUnitType = PascalUnitTypeAll;
if not OptionsIndicateWrapperMethod or (goNoWrappers in FOptions) then
Exit('');
@@ -1360,7 +1415,7 @@ var
Exit;
end;
- Param := WriteParamAsString(AParam,i, ParamIsBitSized, nil, UsedNames);
+ Param := WriteParamAsString(AItem.name, AParam,i, ParamIsBitSized, nil, UsedNames);
if ParamIsBitSized then
PackedBitsAddEntry(PackedBits, AItem, PackedBitsFieldCount, Param, TypeDecl)
@@ -1371,7 +1426,7 @@ var
procedure AddLinesIfSet(AList: TStrings; const TextIn: String);
begin
- if TextIn <> '' then
+ if Trim(TextIn) <> '' then
AList.Add(TextIn);
end;
@@ -1380,11 +1435,14 @@ var
SetFound: Boolean;
PropType: String;
begin
+
+ if not MeetsVersionConstraints(Field) then
+ Exit;
+
AddedBitSizedType:=False;
// FIRST PASS
if AFirstPass then
begin
-
case Field.ObjectType of
otVirtualMethod: ; // ignore. may be usefull if we wrap this in pascal classes instead of objects. Is already written in the class struct
otCallback,
@@ -1582,10 +1640,27 @@ begin
Exit;
end;
ResolveTypeTranslation(AItem);
+ if AItem.ImpliedPointerLevel > 0 then
+ WriteForwardDefinition(AItem);
WantTypeSection.Lines.Add(WriteUnion(AItem, False, 2));
end;
+function TPascalUnit.MeetsVersionConstraints(AItem: TGirBaseType): Boolean;
+begin
+ Result := not AItem.Deprecated;
+ if not Result then
+ Result := goIncludeDeprecated in FOptions;
+
+ if not Result then
+ Result := AItem.DeprecatedVersion >= FNameSpace.DeprecatedVersion;
+
+ if not Result then
+ Result := AItem.DeprecatedOverride;
+
+ Result := Result and (AItem.Version <= FNameSpace.MaxSymbolVersion);
+end;
+
procedure TPascalUnit.WriteForwardDefinition(AType: TGirBaseType);
procedure WriteForward;
var
@@ -1700,7 +1775,10 @@ begin
end
else
begin
- CBName:=MakePascalTypeFromCType(AItem.CType);
+ if AItem.CType <> '' then
+ CBName:=MakePascalTypeFromCType(AItem.CType)
+ else
+ CBName:=MakePascalTypeFromCType(NameSpace.CPrefix+AItem.Name);
Symbol := ' = ';
end;
@@ -1714,7 +1792,8 @@ procedure TPascalUnit.WriteFunctionTypeAndReturnType(AItem: TgirFunction;
out AFunctionType, AFunctionReturnType: String);
begin
ResolveTypeTranslation(AItem.Returns.VarType);
- if (AItem.Returns.VarType.CType = 'void') and (AItem.Returns.PointerLevel = 0) then
+ if ((AItem.Returns.VarType.CType = 'void') or (AItem.Returns.VarType.Name = 'none'))
+ and (AItem.Returns.PointerLevel = 0) then
begin
AFunctionType:='procedure';
AFunctionReturnType := '; cdecl;';
@@ -1743,7 +1822,7 @@ begin
// 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)
+ Result := Result+WriteParamAsString('', AParams.Param[i], i, Dummy, @ArgName)
else
Continue;
@@ -1826,7 +1905,7 @@ begin
end;
end;
-function TPascalUnit.WriteParamAsString(AParam: TgirTypeParam; AIndex: Integer; out ABitSizeSpecified: Boolean; AFirstParam: PString = nil; AExistingUsedNames: TStringList = nil): String;
+function TPascalUnit.WriteParamAsString(AParentName: String; AParam: TgirTypeParam; AIndex: Integer; out ABitSizeSpecified: Boolean; AFirstParam: PString; AExistingUsedNames: TStringList): String;
var
PT: String;
PN: String;
@@ -1841,7 +1920,6 @@ begin
exit;
end;
-
IsArray := AParam.InheritsFrom(TgirArray) ;
//if Length(AParam.VarType.Name) < 1 then
@@ -1858,7 +1936,6 @@ begin
else
PN := AParam.Name;
-
if PN = '' then
PN := 'param'+IntToStr(AIndex);
PN := SanitizeName(PN, AExistingUsedNames);
@@ -1882,6 +1959,9 @@ begin
end;
Result := PN +': '+PT;
+ if PN = PT then
+ WriteLn('Dup name and type! : ',AParam.Name,' ' , AParam.VarType.Name, ' ', PN + ': '+ PT);
+
ProcessType(AParam.VarType, AParam.PointerLevel = 0); // will skip if written
end;
@@ -1898,7 +1978,7 @@ var
// Iten
begin
Result := False;
- Param := WriteParamAsString(TgirTypeParam(AField),i, Result);
+ Param := WriteParamAsString(ARecord.Name, TgirTypeParam(AField),i, Result);
if Result and not AIsUnion then
PackedBitsAddEntry(PackedBits, ARecord, PackedBitsCount, Param, TypeDecl)
else
@@ -1967,7 +2047,7 @@ begin
Field := AUnion.Fields.Field[i];
case Field.ObjectType of
otArray,
- otTypeParam : Union.Add(IndentText(IntToStr(i)+ ' : ' +ParenParams(WriteParamAsString(TgirTypeParam(Field),i, Dummy))+';',ABaseIndent+ 4,0));
+ otTypeParam : Union.Add(IndentText(IntToStr(i)+ ' : ' +ParenParams(WriteParamAsString(AUnion.NAme, TgirTypeParam(Field),i, Dummy))+';',ABaseIndent+ 4,0));
otCallback : Union.Add(IndentText(IntToStr(i)+ ' : ' +ParenParams(WriteCallBack(TgirCallback(Field),True)),ABaseIndent+4,0));
otRecord : Union.Add(IndentText(IntToStr(i)+ ' : ' +ParenParams(WriteRecord(TgirRecord(Field),6, True))+';',ABaseIndent+4,0));
//WriteFunction(AFunction, AItem, AIsMethod, AWantWrapperForObject, AFunctionList): String;
@@ -2123,15 +2203,12 @@ var
Sucess: Boolean;
TestName: String;
begin
+ Result := AName;
+
for Name in PascalReservedWords do
if Name = LowerCase(AName) then
Result := Aname+'_';
- If Result = '' then
- Result := AName;
- if AName = 'CSET_A_2_Z' then
- Result := 'CSET_A_2_Z_UPPER';
- if AName = 'CSET_a_2_z' then
- Result := 'CSET_a_2_z_lower';
+
Result := StringReplace(Result, '-','_',[rfReplaceAll]);
Result := StringReplace(Result, ' ','_',[rfReplaceAll]);
Result := StringReplace(Result, '.','_',[rfReplaceAll]);
@@ -2143,7 +2220,7 @@ begin
repeat
Inc(Sanity);
try
- AExistingUsedNames.Add(TestName);
+ AExistingUsedNames.Add(LowerCase(TestName));
Result := TestName;
Sucess := True;
except
@@ -2164,7 +2241,7 @@ begin
begin
RawName := ABaseType.CType;
if RawName = '' then
- RawName:= ABaseType.Name;
+ RawName:= NameSpace.CPrefix+ABaseType.Name;
ABaseType.TranslatedName:=MakePascalTypeFromCType(RawName, 0);
end;
end;
@@ -2201,6 +2278,7 @@ begin
FDynamicEntryNames.Sorted:=True;
FDynamicEntryNames.Duplicates := dupIgnore;
FNameSpace := ANameSpace;
+
if goWantTest in FOptions then
begin
//FTestCFile := TStringStream.Create('');
@@ -2234,13 +2312,13 @@ begin
inherited Destroy;
end;
-procedure TPascalUnit.ProcessConsts(AList: TList);
+procedure TPascalUnit.ProcessConsts(AList: TList; AUsedNames: TStringList);
function WriteConst(AConst: TgirConstant; Suffix: String = ''): String;
begin
if AConst.IsString then
- Result := SanitizeName(AConst.Name) + Suffix+' = '+QuotedStr(AConst.Value)+';'
+ Result := AConst.CName + Suffix+' = '+QuotedStr(AConst.Value)+';'
else
- Result := SanitizeName(AConst.Name) + Suffix+' = '+AConst.Value+';';
+ Result := AConst.CName + Suffix+' = '+AConst.Value+';';
end;
var
@@ -2263,16 +2341,18 @@ begin
Sanity := 0;
Suffix := '';
Item := TgirConstant(AList.Items[i]);
- //if Item.ClassType <> TgirConstant then ; // raise error
- Entry := LowerCase(SanitizeName(Item.Name));
repeat
try
+ Entry := SanitizeName(Item.CName+Suffix, AUsedNames);
+ if Entry <> Item.CName+Suffix then
+ raise Exception.Create('');
Consts.AddObject(Entry, TObject(PtrUInt(NewConst.Lines.Count)));
break;
except
- Suffix := '__'+IntToStr(Sanity);
- Entry := LowerCase(SanitizeName(Item.Name))+Suffix;
+ if Sanity > 0 then
+ Suffix := '__'+IntToStr(Sanity)
+ else Suffix := '_';
end;
Inc(Sanity);
until Sanity > 10;
@@ -2293,6 +2373,8 @@ begin
for i := 0 to AList.Count-1 do
begin
BaseType := TGirBaseType(AList.Items[i]);
+ if not MeetsVersionConstraints(BaseType) then
+ Continue;
ProcessType(BaseType);
end;
@@ -2306,6 +2388,8 @@ begin
for i := 0 to AList.Count-1 do
begin
Func := TgirFunction(AList.Items[i]);
+ if not MeetsVersionConstraints(Func) then
+ Continue;
HandleFunction(Func);
end;
end;
@@ -2320,7 +2404,7 @@ begin
for i := 0 to FNameSpace.RequiredNameSpaces.Count-1 do
begin
NS := TgirNamespace(FNameSpace.RequiredNameSpaces.Items[i]);
- NeedUnit:=UnitPrefix+CalculateUnitName(NS.NameSpace,NS.Version);
+ NeedUnit:=FGroup.FUnitPrefix + CalculateUnitName(NS.NameSpace,NS.Version.AsString);
if FUnitType = PascalUnitTypeAll then
InterfaceSection.UsesSection.Units.Add(' '+NeedUnit)
@@ -2387,7 +2471,7 @@ begin
Libs := GetLibs;
Result := TStringStream.Create('');
Str.WriteString(IndentText('{ This is an autogenerated unit using gobject introspection (gir2pascal). Do not Edit. }',0,1));
- Str.WriteString(IndentText('unit '+ UnitPrefix+UnitFileName+';',0,2));
+ Str.WriteString(IndentText('unit '+ {UnitPrefix+}UnitFileName+';',0,2));
Str.WriteString(IndentText('{$MODE OBJFPC}{$H+}',0,2));
if utTypes in FUnitType then
Str.WriteString(IndentText('{$PACKRECORDS C}',0,1));
@@ -2444,6 +2528,7 @@ function TPDeclarationList.AsString: String;
var
i: Integer;
begin
+ Result := '';
for i := 0 to Count-1 do
begin
Result := Result+Declarations[i].AsString+LineEnding;
diff --git a/applications/gobject-introspection/girtokens.pas b/applications/gobject-introspection/girtokens.pas
index b507d3f9f..ddfffffba 100644
--- a/applications/gobject-introspection/girtokens.pas
+++ b/applications/gobject-introspection/girtokens.pas
@@ -26,18 +26,30 @@ uses
Classes;
type
- TGirToken = (gtInvalid, gtAlias, gtConstant, gtRecord, gtBitField, gtEnumeration,
+ TGirToken = (gtInvalid, gtEmpty, gtAlias, gtConstant, gtRecord, gtBitField, gtEnumeration,
gtCallback, gtUnion, gtFunction, gtReturnValue, gtType,
gtParameters, gtParameter, gtInstanceParameter, gtMember, gtField, gtMethod, gtArray,
- gtDoc, gtConstructor, gtRepository, gtInclude, gtNameSpace, gtPackage,
+ gtDoc, gtDocDeprecated, gtConstructor, gtRepository, gtInclude, gtNameSpace, gtPackage,
gtCInclude, gtClass, gtProperty, gtVirtualMethod, gtInterface,
- gtGlibSignal, gtImplements, gtPrerequisite,gtVarArgs, gtObject, gtClassStruct, gtGType);
+ gtGlibSignal, gtImplements, gtPrerequisite,gtVarArgs, gtObject, gtClassStruct, gtGType,
+ // Direction for parameters. in is default = no pointer. out and inout means one pointer level.
+ // If subnode is array then increase pointer level.
+ gtIn, gtOut, gtInOut
+ );
+ TGirVersion = object
+ Major: Integer;
+ Minor: Integer;
+ function AsString: String; // '$major.$minor'
+ function AsMajor: TGirVersion; // return as $major.0 i.e 3.0 instead of 3.8
+
+ end;
var
GirTokenName: array[TGirToken] of String = (
'Invalid Name',
+ '{empty}',
'alias',
'constant',
'record',
@@ -56,6 +68,7 @@ var
'method',
'array',
'doc',
+ 'doc-deprecated',
'constructor',
'repository',
'include',
@@ -72,21 +85,100 @@ var
'varargs',
'object',
'classstruct',
- 'gtype'
+ 'gtype',
+ 'in',
+ 'out',
+ 'inout'
);
function GirTokenNameToToken(AName: String): TGirToken;
+ function girVersion(AVersion: String; ADefaultMajor: Integer = -1; ADefaultMinor: Integer = -1): TGirVersion;
+ function girVersion(AMajor, AMinor: Integer): TGirVersion;
+
+ operator >= (AVersion, BVersion: TGirVersion): Boolean;
+ operator <= (AVersion, BVersion: TGirVersion): Boolean;
+ operator > (AVersion, BVersion: TGirVersion): Boolean;
implementation
+uses
+ sysutils;
function GirTokenNameToToken(AName: String): TGirToken;
begin
+ if AName = '' then
+ Exit(gtEmpty);
+ try
for Result in TGirToken do
if GirTokenName[Result][1] <> AName[1] then
continue
else if GirTokenName[Result] = AName then
Exit;
Result := gtInvalid;
+
+ except
+ WriteLn('GirToken Exception: ',AName);
+ end;
+end;
+
+function girVersion(AVersion: String; ADefaultMajor: Integer; ADefaultMinor: Integer): TGirVersion;
+var
+ SplitPoint: Integer;
+ Minor: String;
+begin
+ if (AVersion = '') and (ADefaultMajor <> -1) and (ADefaultMinor <> -1) then
+ begin
+ Result := girVersion(ADefaultMajor, ADefaultMinor);
+ Exit;
+ end;
+ SplitPoint := Pos('.', AVersion);
+
+ if SplitPoint < 1 then
+ raise Exception.Create(Format('Invalid version string format: "%s" (length %d)', [AVersion, Length(AVersion)]));
+
+ Result.Major:=StrToInt(Copy(AVersion,1, SplitPoint-1));
+ Minor := Copy(AVersion,SplitPoint+1, MaxInt);
+ SplitPoint := Pos('.', AVersion);
+ // we are not interested in the third version chunk
+ if SplitPoint > 0 then
+ Minor := Copy(Minor,1, SplitPoint-1);
+ Result.Minor:=StrToInt(Minor);
+end;
+
+function girVersion(AMajor, AMinor: Integer): TGirVersion;
+begin
+ REsult.Major := AMajor;
+ Result.Minor := AMinor;
+end;
+
+operator >= (AVersion, BVersion: TGirVersion): Boolean;
+begin
+ Result := (AVersion.Major > BVersion.Major)
+ or ((AVersion.Major = BVersion.Major) and (AVersion.Minor >= BVersion.Minor));
+end;
+
+operator<=(AVersion, BVersion: TGirVersion): Boolean;
+begin
+ Result := (AVersion.Major < BVersion.Major)
+ or ((AVersion.Major = BVersion.Major) and (AVersion.Minor <= BVersion.Minor));
+end;
+
+operator > (AVersion, BVersion: TGirVersion): Boolean;
+begin
+ Result := (AVersion.Major > BVersion.Major)
+ or ((AVersion.Major = BVersion.Major) and (AVersion.Minor > BVersion.Minor));
+end;
+
+{ TGirVersion }
+
+function TGirVersion.AsString: String;
+begin
+ Result := IntToStr(Major)+'.'+IntToStr(Minor);
+end;
+
+function TGirVersion.AsMajor: TGirVersion;
+begin
+ Result.Major:=Major;
+ REsult.Minor:=0;
end;
end.