gir2pascal changes:

- Added option --max-version. It allows to limit the version of the symbols to a particular version. i.e. Gtk-3.8 when run against 3.14.
 - Added option --keep-deprecated-version. It allow to reduce the version that will exclude deprecated symbols. i.e using --keep-deprecated-version=Gtk-3.8 on version 3.14 will include all symbols from 3.8 up to the current when normally they would be dropped.
 - Some changes to accomodate new nodes in the gir xml files.


git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5356 8e941d3f-bd1b-0410-a28a-d453659cc2b4

applications/gobject-introspection/gir2pascal.lpi

@@ -30,20 +30,18 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="-wCni /home/andrew/programming/lazarus-ccr/applications/gobject-introspection/girfiles-from-felix/Gtk-3.0.gir -o /tmp/gir-out"/>
+        <CommandLineParams Value="-wni /home/andrew/programming/lazarus-ccr.old/applications/gobject-introspection/girfiles-from-felix/Gtk-3.0.gir -o /tmp/gir-out"/>
-        <LaunchingApplication PathPlusParams="/usr/bin/gnome-terminal -t 'Lazarus Run Output' -e '$(LazarusDir)/tools/runwait.sh $(TargetCmdLine)'"/>
+        <LaunchingApplication Use="True" PathPlusParams="/usr/bin/gnome-terminal -t 'Lazarus Run Output' -e '$(LazarusDir)/tools/runwait.sh $(TargetCmdLine)'"/>
       </local>
     </RunParams>
     <Units Count="11">
       <Unit0>
         <Filename Value="gir2pascal.lpr"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="gir2pascal"/>
       </Unit0>
       <Unit1>
         <Filename Value="girpascalwriter.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="girpascalwriter"/>
       </Unit1>
       <Unit2>
         <Filename Value="girnamespaces.pas"/>
@@ -83,7 +81,6 @@
       <Unit9>
         <Filename Value="girpascalwritertypes.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="girpascalwritertypes"/>
       </Unit9>
       <Unit10>
         <Filename Value="commandlineoptions.pas"/>
@@ -101,12 +98,6 @@
       <IncludeFiles Value="$(ProjOutDir)"/>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
-    <Other>
-      <CompilerMessages>
-        <UseMsgFile Value="True"/>
-      </CompilerMessages>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="4">

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 <max-version>. 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

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;
 

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;

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;
+constructor TGirFunctionParam.Create(AOwner: TObject; ANode: TDomNode; AIsInstanceParam: Boolean);
-  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;
 
 
-
+  //if FPointerLevel = -1 then
-  FPointerLevel := PointerLevelFromVarName(C_Type);
+  //  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,10 +1075,11 @@ 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:
@@ -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:;
+      gtDoc,
-      gtMember: AddMember(Node.GetAttribute('name'), Node.GetAttribute('value'),Node.GetAttribute('c:identifier'));
+      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;
 

applications/gobject-introspection/girpascalwriter.pas

@@ -60,6 +60,7 @@ begin
   FUnits := TList.Create;
   FDefaultUnitExtension:='.pas';
   FOptions:=AOptions;
+  FUnitPrefix:=AUnitPrefix;
 end;
 
 procedure TgirPascalWriter.GenerateUnits;

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);
+          if Sanity > 0 then
-          Entry := LowerCase(SanitizeName(Item.Name))+Suffix;
+            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;

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.