You've already forked lazarus-ccr
Added gobject introspection converter. Can be used to convert .gir files into pascal units.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1982 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
drewski207
BIN
applications/gobject-introspection/gir2pascal.ico
Normal file
BIN
applications/gobject-introspection/gir2pascal.ico
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 134 KiB |
108
applications/gobject-introspection/gir2pascal.lpi
Normal file
108
applications/gobject-introspection/gir2pascal.lpi
Normal file
@ -0,0 +1,108 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<CommandLineParams Value="-i /usr/share/gir-1.0/Gtk-3.0.gir -o /tmp/gir-out -w"/>
|
||||
<LaunchingApplication Use="True" PathPlusParams="/usr/bin/gnome-terminal -t 'Lazarus Run Output' -e '$(LazarusDir)/tools/runwait.sh $(TargetCmdLine)'"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<Units Count="8">
|
||||
<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"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="girNameSpaces"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="girctypesmapping.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="girCTypesMapping"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="girtokens.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="girTokens"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
<Filename Value="girerrors.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="girErrors"/>
|
||||
</Unit5>
|
||||
<Unit6>
|
||||
<Filename Value="girfiles.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="girFiles"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<Filename Value="girobjects.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="girObjects"/>
|
||||
</Unit7>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="10"/>
|
||||
<Target>
|
||||
<Filename Value="gir2pascal"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<UseMsgFile Value="True"/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
248
applications/gobject-introspection/gir2pascal.lpr
Normal file
248
applications/gobject-introspection/gir2pascal.lpr
Normal file
@ -0,0 +1,248 @@
|
||||
{
|
||||
gir2pascal.lpr
|
||||
Copyright (C) 2011 Andrew Haines andrewd207@aol.com
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU General Public License
|
||||
as published by the Free Software Foundation; either version 2
|
||||
of the License, or (at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
}
|
||||
program gir2pascal;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Classes, SysUtils, CustApp, DOM, XMLRead, girNameSpaces, girFiles,
|
||||
girpascalwriter, girErrors, girCTypesMapping, girTokens, girObjects;
|
||||
|
||||
type
|
||||
|
||||
{ TGirConsoleConverter }
|
||||
|
||||
TGirConsoleConverter = class(TCustomApplication)
|
||||
private
|
||||
FWriteCount: Integer;
|
||||
FPaths: TStringList;
|
||||
FOutPutDirectory : String;
|
||||
FFileToConvert: String;
|
||||
FOverWriteFiles: Boolean;
|
||||
procedure AddDefaultPaths;
|
||||
procedure AddPaths(APaths: String);
|
||||
procedure VerifyOptions;
|
||||
procedure Convert;
|
||||
|
||||
//callbacks
|
||||
function NeedGirFile(AGirFile: TObject; NamespaceName: String) : TXMLDocument;
|
||||
procedure WritePascalFile(Sender: TObject; AUnitName: String; AStream: TStringStream);
|
||||
protected
|
||||
procedure DoRun; override;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure WriteHelp; virtual;
|
||||
end;
|
||||
|
||||
{ TGirConsoleConverter }
|
||||
|
||||
procedure TGirConsoleConverter.AddDefaultPaths;
|
||||
begin
|
||||
FPaths.Add('/usr/share/gir-1.0/');
|
||||
end;
|
||||
|
||||
procedure TGirConsoleConverter.AddPaths(APaths: String);
|
||||
var
|
||||
Strs: TStringList;
|
||||
Str: String;
|
||||
begin
|
||||
Strs := TStringList.Create;
|
||||
Strs.Delimiter:=':';
|
||||
Strs.StrictDelimiter:=True;
|
||||
Strs.DelimitedText:=APaths;
|
||||
|
||||
// so we can add the delimiter
|
||||
for Str in Strs do
|
||||
FPaths.Add(IncludeTrailingPathDelimiter(Str));
|
||||
|
||||
Strs.Free;
|
||||
end;
|
||||
|
||||
procedure TGirConsoleConverter.VerifyOptions;
|
||||
begin
|
||||
if not DirectoryExists(FOutPutDirectory) then
|
||||
begin
|
||||
WriteLn(Format('Output directory "%s" does not exist!', [FOutPutDirectory]));
|
||||
Terminate;
|
||||
end;
|
||||
if FFileToConvert = '' then
|
||||
begin
|
||||
WriteLn('No input file specified! See -h for options.');
|
||||
Terminate;
|
||||
Halt;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGirConsoleConverter.NeedGirFile(AGirFile: TObject; NamespaceName: String): TXMLDocument;
|
||||
var
|
||||
Sr: TSearchRec;
|
||||
Path: String;
|
||||
begin
|
||||
Result := nil;
|
||||
for Path in FPaths do
|
||||
begin
|
||||
if FindFirst(Path+NamespaceName+'.gir', faAnyFile, Sr) = 0 then
|
||||
begin
|
||||
ReadXMLFile(Result, Path+Sr.Name);
|
||||
Exit;
|
||||
end;
|
||||
FindClose(Sr);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGirConsoleConverter.WritePascalFile(Sender: TObject;
|
||||
AUnitName: String; AStream: TStringStream);
|
||||
var
|
||||
SStream: TFileStream;
|
||||
OutFileName: String;
|
||||
begin
|
||||
Inc(FWriteCount);
|
||||
OutFileName:=FOutPutDirectory+LowerCase(AUnitName)+'.pas';
|
||||
if not FileExists(OutFileName)
|
||||
or (FileExists(OutFileName) and FOverWriteFiles) then
|
||||
begin
|
||||
WriteLn(Format('Writing: %s', [OutFileName]));
|
||||
AStream.Position:=0;
|
||||
ForceDirectories(FOutPutDirectory);
|
||||
SStream := TFileStream.Create(OutFileName, fmCreate or fmOpenReadWrite);
|
||||
SStream.CopyFrom(AStream,AStream.Size);
|
||||
SStream.Free;
|
||||
AStream.Free;
|
||||
end
|
||||
else
|
||||
begin
|
||||
WriteLn(Format('File %s already exists! Stopping.', [OutFileName]));
|
||||
Terminate;
|
||||
Halt;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGirConsoleConverter.Convert;
|
||||
var
|
||||
Doc: TXMLDocument;
|
||||
girFile: TgirFile;
|
||||
Writer: TgirPascalWriter;
|
||||
StartTime, EndTime:TDateTime;
|
||||
begin
|
||||
StartTime := Now;
|
||||
ReadXMLFile(Doc, FFileToConvert);
|
||||
|
||||
girFile := TgirFile.Create(nil);
|
||||
girFile.OnNeedGirFile:=@NeedGirFile;
|
||||
girFile.ParseXMLDocument(Doc);
|
||||
Doc.Free;
|
||||
|
||||
Writer := TgirPascalWriter.Create(girFile.NameSpaces);
|
||||
Writer.OnUnitWriteEvent:= @WritePascalFile;
|
||||
Writer.GenerateUnits;
|
||||
|
||||
Writer.Free;
|
||||
EndTime := Now;
|
||||
|
||||
EndTime := EndTime-StartTime;
|
||||
WriteLn(Format('Converted %d file(s) in %f seconds',[FWriteCount, DateTimeToTimeStamp(EndTime).Time / 1000]));
|
||||
end;
|
||||
|
||||
procedure TGirConsoleConverter.DoRun;
|
||||
var
|
||||
ErrorMsg: String;
|
||||
begin
|
||||
// quick check parameters
|
||||
ErrorMsg:=CheckOptions('hnp:o:i:w',['help','no-default','paths','output-directory', 'input', 'overwrite-files']);
|
||||
if ErrorMsg<>'' then begin
|
||||
ShowException(Exception.Create(ErrorMsg));
|
||||
Terminate;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// parse parameters
|
||||
if HasOption('h','help') then begin
|
||||
WriteHelp;
|
||||
Terminate;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if not HasOption('n', 'no-default') then
|
||||
AddDefaultPaths;
|
||||
|
||||
if HasOption('o', 'output-directory') then
|
||||
FOutPutDirectory:=IncludeTrailingPathDelimiter(GetOptionValue('o', 'output-directory'))
|
||||
else
|
||||
FOutPutDirectory:=IncludeTrailingPathDelimiter(GetCurrentDir);
|
||||
|
||||
FFileToConvert:=GetOptionValue('i','input');
|
||||
|
||||
if HasOption('p', 'paths') then
|
||||
AddPaths(GetOptionValue('p', 'paths'));
|
||||
|
||||
if HasOption('w', 'overwrite-files') then
|
||||
FOverWriteFiles:=True;
|
||||
|
||||
VerifyOptions;
|
||||
|
||||
// does all the heavy lifting
|
||||
Convert;
|
||||
|
||||
// stop program loop
|
||||
Terminate;
|
||||
end;
|
||||
|
||||
constructor TGirConsoleConverter.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
FPaths := TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TGirConsoleConverter.Destroy;
|
||||
begin
|
||||
FPaths.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TGirConsoleConverter.WriteHelp;
|
||||
begin
|
||||
Writeln('');
|
||||
writeln(' Usage: ',ExtractFileName(ExeName),' [options] -i filename');
|
||||
Writeln('');
|
||||
Writeln('');
|
||||
Writeln(' -i --input= .gir filename to convert.');
|
||||
Writeln(' -o --output-directory= Directory to write the resulting .pas files to. If not');
|
||||
Writeln(' specified then the current working directory is used.');
|
||||
Writeln(' -w --overwrite-files If the output .pas file(s) already exists then overwrite them.');
|
||||
Writeln(' -n --no-default /usr/share/gir-1.0 is not added as a search location for ');
|
||||
Writeln(' needed .gir files.');
|
||||
Writeln(' -p --paths= List of paths seperated by ":" to search for needed .gir files.');
|
||||
Writeln('');
|
||||
end;
|
||||
|
||||
var
|
||||
Application: TGirConsoleConverter;
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application:=TGirConsoleConverter.Create(nil);
|
||||
Application.Run;
|
||||
Application.Free;
|
||||
end.
|
||||
|
||||
BIN
applications/gobject-introspection/gir2pascal.res
Normal file
BIN
applications/gobject-introspection/gir2pascal.res
Normal file
Binary file not shown.
117
applications/gobject-introspection/girctypesmapping.pas
Normal file
117
applications/gobject-introspection/girctypesmapping.pas
Normal file
@ -0,0 +1,117 @@
|
||||
{
|
||||
ctypesmapping.pas
|
||||
Copyright (C) 2011 Andrew Haines andrewd207@aol.com
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU General Public License
|
||||
as published by the Free Software Foundation; either version 2
|
||||
of the License, or (at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
}
|
||||
unit girCTypesMapping;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
const
|
||||
CTypesMax = 31;
|
||||
var
|
||||
|
||||
TypesPascalCTypes: array [0..CTypesMax-1] of string =
|
||||
(
|
||||
'pointer',
|
||||
'cint',
|
||||
'cint',
|
||||
'cuint',
|
||||
'cuint8',
|
||||
'cuint16',
|
||||
'cuint32',
|
||||
'cuint64',
|
||||
'cint8',
|
||||
'cint16',
|
||||
'cint32',
|
||||
'cint64',
|
||||
'csize_t',
|
||||
'clong',
|
||||
'culong',
|
||||
'cushort',
|
||||
'char',
|
||||
'Boolean32',
|
||||
'PtrInt',
|
||||
'csize_t',
|
||||
'gpointer',
|
||||
'cfloat',
|
||||
'cdouble',
|
||||
'cdouble',
|
||||
'char',
|
||||
'Int64',
|
||||
'Extended',
|
||||
'guint32',
|
||||
'guint32',
|
||||
'file',
|
||||
'qword'
|
||||
|
||||
);
|
||||
TypesGTypes: array [0..CTypesMax-1] of string =
|
||||
(
|
||||
'gpointer',
|
||||
'int',
|
||||
'gint',
|
||||
'guint',
|
||||
'guint8',
|
||||
'guint16',
|
||||
'guint32',
|
||||
'guint64',
|
||||
'gint8',
|
||||
'gint16',
|
||||
'gint32',
|
||||
'gint64',
|
||||
'gsize',
|
||||
'glong',
|
||||
'gulong',
|
||||
'gushort',
|
||||
'gchar',
|
||||
'gboolean',
|
||||
'gssize',
|
||||
'size_t' ,
|
||||
'gconstpointer',
|
||||
'gfloat',
|
||||
'gdouble',
|
||||
'double',
|
||||
'char',
|
||||
'goffset',
|
||||
'long double',
|
||||
'gunichar',
|
||||
'gunichar2',
|
||||
'file',
|
||||
'unsigned long long'
|
||||
);
|
||||
|
||||
function LookupGTypeToCType(AName: String): String;
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
function LookupGTypeToCType(AName: String): String;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
//WriteLn('Looking up: ', AName);
|
||||
for i := 0 to CTypesMax-1 do
|
||||
if AName = TypesGTypes[i] then
|
||||
Exit(TypesPascalCTypes[i]);
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
79
applications/gobject-introspection/girerrors.pas
Normal file
79
applications/gobject-introspection/girerrors.pas
Normal file
@ -0,0 +1,79 @@
|
||||
{
|
||||
girerrors.pas
|
||||
Copyright (C) 2011 Andrew Haines andrewd207@aol.com
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU General Public License
|
||||
as published by the Free Software Foundation; either version 2
|
||||
of the License, or (at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
}
|
||||
unit girErrors;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
type
|
||||
TGirError = (geError, geWarn, geInfo, geDebug, geFatal, geFuzzy);
|
||||
|
||||
TgirErrorFunc = procedure(UserData: Pointer; AType: TgirError; AMsg: String);
|
||||
|
||||
const
|
||||
geUnhandledNode = 'Unhandled node [%s] "%s"';
|
||||
geUnexpectedNodeType = 'Unexpected node [%s] type: found "%s" expected "%s"';
|
||||
geMissingNode = '[%s] Could not find child node "%s" while looking in node "%s"';
|
||||
|
||||
var
|
||||
girErrorName: array[TGirError] of String =(
|
||||
'Error',
|
||||
'Warning',
|
||||
'Info',
|
||||
'Debug',
|
||||
'Fatal',
|
||||
'Fuzzy'
|
||||
);
|
||||
procedure girError(AType: TgirError; AMsg: String);
|
||||
|
||||
//returns old handler
|
||||
function girSetErrorHandler(AHandler: TgirErrorFunc; AUserData: Pointer): TgirErrorFunc;
|
||||
|
||||
implementation
|
||||
|
||||
var
|
||||
UserData: Pointer;
|
||||
InternalHandler: TgirErrorFunc;
|
||||
|
||||
procedure girError(AType: TgirError; AMsg: String);
|
||||
begin
|
||||
if InternalHandler <> nil then
|
||||
begin
|
||||
InternalHandler(UserData, AType, AMsg);
|
||||
Exit;
|
||||
end;
|
||||
// if AType = geDebug then
|
||||
//WriteLn(girErrorName[AType],': ', AMsg);
|
||||
|
||||
end;
|
||||
|
||||
function girSetErrorHandler(AHandler: TgirErrorFunc; AUserData: Pointer
|
||||
): TgirErrorFunc;
|
||||
begin
|
||||
Result := InternalHandler;
|
||||
InternalHandler:=AHandler;
|
||||
UserData:=AUserData;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
149
applications/gobject-introspection/girfiles.pas
Normal file
149
applications/gobject-introspection/girfiles.pas
Normal file
@ -0,0 +1,149 @@
|
||||
{
|
||||
girfiles.pas
|
||||
Copyright (C) 2011 Andrew Haines andrewd207@aol.com
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU General Public License
|
||||
as published by the Free Software Foundation; either version 2
|
||||
of the License, or (at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
}
|
||||
unit girFiles;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
{$INTERFACES CORBA}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, XMLRead, DOM, girNameSpaces, girParser;
|
||||
|
||||
type
|
||||
|
||||
{ TgirFile }
|
||||
|
||||
TgirFile = class(IgirParser)
|
||||
private
|
||||
FNameSpaces: TgirNamespaces;
|
||||
FOnNeedGirFile: TgirNeedGirFileEvent;
|
||||
FOwner: TObject;
|
||||
procedure ParseNode(ANode: TDomNode);
|
||||
procedure SetOnNeedGirFile(AValue: TgirNeedGirFileEvent);
|
||||
procedure SetOwner(const AValue: TObject);
|
||||
procedure ParseIncludeNode(ANode: TDomNode; AIncludes: TList);
|
||||
public
|
||||
constructor Create(AOwner: TObject);
|
||||
destructor Destroy; override;
|
||||
procedure ParseXMLDocument(AXML: TXMLDocument);
|
||||
property NameSpaces: TgirNamespaces read FNameSpaces;
|
||||
property Owner: TObject read FOwner write SetOwner;
|
||||
property OnNeedGirFile: TgirNeedGirFileEvent read FOnNeedGirFile write SetOnNeedGirFile;
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses girErrors, girTokens;
|
||||
|
||||
{ TgirFile }
|
||||
|
||||
|
||||
{ TgirFile }
|
||||
|
||||
procedure TgirFile.ParseNode(ANode: TDomNode);
|
||||
var
|
||||
NS: TgirNamespace;
|
||||
Includes: TList;
|
||||
begin
|
||||
if ANode.NodeName <> 'repository' then
|
||||
girError(geError, 'Not a Valid Document Type!');
|
||||
|
||||
ANode := Anode.FirstChild;
|
||||
Ns := nil;
|
||||
Includes := TList.Create;
|
||||
|
||||
while ANode <> nil do begin
|
||||
case GirTokenNameToToken(ANode.NodeName) of
|
||||
gtInclude: ParseIncludeNode(ANode, Includes);
|
||||
gtNameSpace:
|
||||
begin
|
||||
NS := TgirNamespace.CreateFromNamespaceNode(NameSpaces, ANode, Includes);
|
||||
girError(geDebug, 'Adding Namespace '+NS.NameSpace+' to NameSpaces');
|
||||
FNameSpaces.Add(NS);
|
||||
girError(geDebug, 'Added Namespace '+NS.NameSpace);
|
||||
NS.ParseNode(ANode);
|
||||
end;
|
||||
gtPackage, gtCInclude: ;// ignore for now
|
||||
else
|
||||
girError(geDebug, 'Unknown Node Type for Reposiotory: '+ Anode.NodeName);
|
||||
end;
|
||||
ANode := ANode.NextSibling;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{ANode := ANode.FindNode('namespace');
|
||||
if ANode = nil then
|
||||
girError(geError, 'namespace node not found')
|
||||
else
|
||||
begin
|
||||
|
||||
end;}
|
||||
end;
|
||||
|
||||
procedure TgirFile.SetOnNeedGirFile(AValue: TgirNeedGirFileEvent);
|
||||
begin
|
||||
FNameSpaces.OnNeedGirFile:=AValue;
|
||||
if FOnNeedGirFile=AValue then Exit;
|
||||
FOnNeedGirFile:=AValue;
|
||||
end;
|
||||
|
||||
procedure TgirFile.SetOwner(const AValue: TObject);
|
||||
begin
|
||||
if FOwner=AValue then exit;
|
||||
FOwner:=AValue;
|
||||
end;
|
||||
|
||||
procedure TgirFile.ParseIncludeNode(ANode: TDomNode; AIncludes: TList);
|
||||
var
|
||||
NS: TgirNamespace;
|
||||
NSName, NSVersion: String;
|
||||
begin
|
||||
NSName := TDOMElement(ANode).GetAttribute('name');
|
||||
NSVersion := TDOMElement(ANode).GetAttribute('version');
|
||||
NS := FNameSpaces.FindNameSpace(NSName, NSVersion);
|
||||
if NS <> nil then
|
||||
begin
|
||||
AIncludes.Add(NS);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
constructor TgirFile.Create(AOwner: TObject);
|
||||
begin
|
||||
Owner := AOwner;
|
||||
FNameSpaces := TgirNamespaces.Create(Self);
|
||||
end;
|
||||
|
||||
destructor TgirFile.Destroy;
|
||||
begin
|
||||
FNameSpaces.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TgirFile.ParseXMLDocument(AXML: TXMLDocument);
|
||||
begin
|
||||
Self.ParseNode(AXML.DocumentElement);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
end.
|
||||
|
||||
539
applications/gobject-introspection/girnamespaces.pas
Normal file
539
applications/gobject-introspection/girnamespaces.pas
Normal file
@ -0,0 +1,539 @@
|
||||
{
|
||||
girnamespaces.pas
|
||||
Copyright (C) 2011 Andrew Haines andrewd207@aol.com
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU General Public License
|
||||
as published by the Free Software Foundation; either version 2
|
||||
of the License, or (at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
}
|
||||
unit girNameSpaces;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
{$INTERFACES CORBA}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, DOM, girParser, girTokens, girObjects, contnrs;
|
||||
|
||||
type
|
||||
|
||||
TgirNeedGirFileEvent = function (AGirFile: TObject; BaseNamespaceName: String) : TXMLDocument of object;
|
||||
|
||||
{ TgirNamespace }
|
||||
|
||||
TgirNamespace = class(IgirParser)
|
||||
private
|
||||
FConstants: TList;
|
||||
FFunctions: TList;
|
||||
FNameSpace: String;
|
||||
FOnlyImplied: Boolean;
|
||||
FOnNeedGirFile: TgirNeedGirFileEvent;
|
||||
FOwner: TObject;
|
||||
FRequiredNameSpaces: TList;
|
||||
FSharedLibrary: String;
|
||||
FTypes: TFPHashObjectList;
|
||||
FUnresolvedTypes: TList;
|
||||
FVersion: String;
|
||||
procedure SetOnNeedGirFile(AValue: TgirNeedGirFileEvent);
|
||||
protected
|
||||
function AddFuzzyType(AName: String; ACType: String): TGirBaseType;
|
||||
procedure HandleAlias(ANode: TDomNode);
|
||||
procedure HandleConstant(ANode: TDomNode);
|
||||
procedure HandleEnumeration(ANode: TDomNode);
|
||||
procedure HandleBitField(ANode: TDomNode);
|
||||
procedure HandleCallback(ANode: TDOMNode);
|
||||
procedure HandleFunction(ANode: TDOMNode);
|
||||
procedure HandleUnion(ANode: TDOMNode);
|
||||
{
|
||||
Some 'records' have methods these corelate to pascal 'object'
|
||||
GType extends this 'object' type to have a sort of vmt
|
||||
GObject and subclasses extend gtype and adds more vmt method entries and method entries to the instance itself.
|
||||
}
|
||||
procedure HandleRecord(ANode: TDomNode); //could be struct, object, gtype, gobject, or gobject descendant
|
||||
procedure HandlePlainObject(ANode: TDomNode); // is a record/object with methods but no gtype
|
||||
procedure HandleGType(ANode: TDomNode); // one step above plain object
|
||||
procedure HandleClassStruct(ANode: TDomNode); // one step above GType. Is the 'Virtual' part of an object (VMT)
|
||||
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;
|
||||
public
|
||||
function LookupTypeByName(AName: String; const ACType: String; const SearchOnly: Boolean = False): TGirBaseType;
|
||||
function ResolveFuzzyType(AFuzzyType: TgirFuzzyType): TGirBaseType;
|
||||
function UsesGLib: Boolean;
|
||||
procedure ResolveFuzzyTypes; // called after done
|
||||
procedure ParseNode(ANode: TDomNode);
|
||||
procedure ParseSubNode(ANode: TDomNode); // generally do not use outside of TgirNameSpace
|
||||
constructor Create(AOwner:TObject; AImpliedNamespace: String);
|
||||
constructor CreateFromNamespaceNode(AOwner:TObject; ANode: TDOMNode; AIncludes: TList);
|
||||
destructor Destroy; override;
|
||||
property NameSpace: String read FNameSpace;
|
||||
property RequiredNameSpaces: TList Read FRequiredNameSpaces;
|
||||
property SharedLibrary: String read FSharedLibrary;
|
||||
property Version: String read FVersion;
|
||||
property OnlyImplied: Boolean read FOnlyImplied;
|
||||
property Owner: TObject Read FOwner;
|
||||
|
||||
// has all types in it (records classes classstructs bitfields callbacks gtypes unions etc) does not contain consts or functions
|
||||
property Types: TFPHashObjectList read FTypes;
|
||||
|
||||
property Functions: TList read FFunctions;
|
||||
property Constants: TList read FConstants;
|
||||
property UnresolvedTypes: TList read FUnresolvedTypes write FUnresolvedTypes;
|
||||
end;
|
||||
|
||||
{ TgirNamespaces }
|
||||
|
||||
TgirNamespaces = class(TList)
|
||||
private
|
||||
FOnNeedGirFile: TgirNeedGirFileEvent;
|
||||
FOwner: TObject;
|
||||
function GetNameSpace(AIndex: Integer): TgirNamespace;
|
||||
procedure SetNameSpace(AIndex: Integer; const AValue: TgirNamespace);
|
||||
procedure SetOnNeedGirFile(AValue: TgirNeedGirFileEvent);
|
||||
public
|
||||
constructor Create(AOwner: TObject);
|
||||
function FindNameSpace(AName: String; Version: String = ''): TgirNamespace;
|
||||
property NameSpace[AIndex: Integer]: TgirNamespace read GetNameSpace write SetNameSpace;
|
||||
property Owner: TObject read FOwner;
|
||||
property OnNeedGirFile: TgirNeedGirFileEvent read FOnNeedGirFile write SetOnNeedGirFile;
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
girErrors, SysUtils, girCTypesMapping;
|
||||
|
||||
{ TgirNamespaces }
|
||||
|
||||
function TgirNamespaces.GetNameSpace(AIndex: Integer): TgirNamespace;
|
||||
begin
|
||||
Result := TgirNamespace(Items[AIndex]);
|
||||
end;
|
||||
|
||||
procedure TgirNamespaces.SetNameSpace(AIndex: Integer;
|
||||
const AValue: TgirNamespace);
|
||||
begin
|
||||
Items[AIndex] := AValue;
|
||||
end;
|
||||
|
||||
procedure TgirNamespaces.SetOnNeedGirFile(AValue: TgirNeedGirFileEvent);
|
||||
begin
|
||||
if FOnNeedGirFile=AValue then Exit;
|
||||
FOnNeedGirFile:=AValue;
|
||||
end;
|
||||
|
||||
constructor TgirNamespaces.Create(AOwner: TObject);
|
||||
begin
|
||||
FOwner := AOwner;
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
function TgirNamespaces.FindNameSpace(AName: String; Version: String=''): TgirNamespace;
|
||||
var
|
||||
i: Integer;
|
||||
NameSpaceSearchedFor: Boolean;
|
||||
Doc: TXMLDocument;
|
||||
begin
|
||||
Result := nil;
|
||||
NameSpaceSearchedFor := False;
|
||||
while Result = nil do
|
||||
begin
|
||||
for i := 0 to Count-1 do
|
||||
begin
|
||||
if NameSpace[i].NameSpace = AName then
|
||||
Exit(NameSpace[i]);
|
||||
end;
|
||||
|
||||
if NameSpaceSearchedFor then
|
||||
Exit;
|
||||
NameSpaceSearchedFor := True;
|
||||
if Assigned(FOnNeedGirFile) then
|
||||
begin
|
||||
Doc := FOnNeedGirFile(Owner, AName+'-'+Version);
|
||||
if Doc <> nil then
|
||||
begin
|
||||
(Owner as IgirParser).ParseNode(Doc.DocumentElement);
|
||||
Doc.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TgirNamespace }
|
||||
|
||||
procedure TgirNamespace.ParseNode(ANode: TDomNode);
|
||||
|
||||
begin
|
||||
ANode := ANode.FirstChild;
|
||||
while ANode <> nil do
|
||||
begin
|
||||
//girError(geDebug, 'Parsing Node "'+ANode.NodeName+'"');
|
||||
ParseSubNode(ANode);
|
||||
ANode := ANode.NextSibling;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TgirNamespace.SetOnNeedGirFile(AValue: TgirNeedGirFileEvent);
|
||||
begin
|
||||
if FOnNeedGirFile=AValue then Exit;
|
||||
FOnNeedGirFile:=AValue;
|
||||
end;
|
||||
|
||||
function TgirNamespace.AddFuzzyType(AName: String; ACType: String
|
||||
): TGirBaseType;
|
||||
begin
|
||||
Result := TgirFuzzyType.Create(Self, AName, ACType);
|
||||
FTypes.Add(AName, Result);
|
||||
FUnresolvedTypes.Add(Result);
|
||||
end;
|
||||
|
||||
procedure TgirNamespace.HandleAlias(ANode: TDomNode);
|
||||
var
|
||||
Item: TgirAlias;
|
||||
begin
|
||||
Item := TgirAlias.Create(Self, ANode);
|
||||
Types.Add(Item.Name, Item);
|
||||
end;
|
||||
|
||||
procedure TgirNamespace.HandleConstant(ANode: TDomNode);
|
||||
var
|
||||
Item: TgirConstant;
|
||||
begin
|
||||
Item := TgirConstant.Create(Self, ANode);
|
||||
FConstants.Add(Item);
|
||||
end;
|
||||
|
||||
procedure TgirNamespace.HandleEnumeration(ANode: TDomNode);
|
||||
var
|
||||
Item : TgirEnumeration;
|
||||
begin
|
||||
Item := TgirEnumeration.Create(Self, ANode);
|
||||
Types.Add(Item.Name, Item);
|
||||
end;
|
||||
|
||||
procedure TgirNamespace.HandleBitField(ANode: TDomNode);
|
||||
var
|
||||
Item : TgirBitField;
|
||||
begin
|
||||
Item := TgirBitField.Create(Self, ANode);
|
||||
Types.Add(Item.Name, Item);
|
||||
end;
|
||||
|
||||
procedure TgirNamespace.HandleCallback(ANode: TDOMNode);
|
||||
var
|
||||
Item: TgirCallback;
|
||||
begin
|
||||
Item := TgirCallback.Create(Self, ANode);
|
||||
Types.Add(Item.Name, Item);
|
||||
end;
|
||||
|
||||
procedure TgirNamespace.HandleFunction(ANode: TDOMNode);
|
||||
var
|
||||
Item: TgirFunction;
|
||||
begin
|
||||
Item := TgirFunction.Create(Self, ANode);
|
||||
Functions.Add(Item);
|
||||
end;
|
||||
|
||||
procedure TgirNamespace.HandleUnion(ANode: TDOMNode);
|
||||
var
|
||||
Item: TgirUnion;
|
||||
begin
|
||||
Item := TgirUnion.Create(Self, ANode);
|
||||
Types.Add(Item.Name, Item);
|
||||
end;
|
||||
|
||||
procedure TgirNamespace.HandleRecord(ANode: TDomNode);
|
||||
var
|
||||
Item: tgirRecord;
|
||||
begin
|
||||
if TDOMElement(ANode).GetAttribute('glib:is-gtype-struct-for') <> '' then // is gobject class
|
||||
begin
|
||||
HandleClassStruct(ANode);
|
||||
end
|
||||
else if TDOMElement(ANode).GetAttribute('glib:get-type') <> '' then // is GType
|
||||
HandleGType(ANode)
|
||||
else if (ANode.FindNode('method') <> nil) or (ANode.FindNode('constructor') <> nil) or (ANode.FindNode('function') <> nil) then // is Plain object that is not gtype
|
||||
HandlePlainObject(ANode)
|
||||
else
|
||||
begin
|
||||
Item := tgirRecord.Create(Self, ANode);
|
||||
Types.Add(Item.Name, Item);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TgirNamespace.HandlePlainObject(ANode: TDomNode);
|
||||
var
|
||||
Item: TgirObject;
|
||||
begin
|
||||
Item := TgirObject.Create(Self, ANode);
|
||||
Types.Add(Item.Name, Item);
|
||||
end;
|
||||
|
||||
procedure TgirNamespace.HandleGType(ANode: TDomNode);
|
||||
var
|
||||
Item: TgirGType;
|
||||
begin
|
||||
Item := TgirGType.Create(Self, ANode);
|
||||
Types.Add(Item.Name, Item);
|
||||
end;
|
||||
|
||||
procedure TgirNamespace.HandleClassStruct(ANode: TDomNode);
|
||||
var
|
||||
Item: TgirClassStruct;
|
||||
begin
|
||||
Item := TgirClassStruct.Create(Self, ANode);
|
||||
FTypes.Add(Item.Name, Item);
|
||||
end;
|
||||
|
||||
procedure TgirNamespace.HandleClass(ANode: TDomNode);
|
||||
var
|
||||
Item: TgirClass;
|
||||
begin
|
||||
Item := TgirClass.Create(Self, ANode);
|
||||
FTypes.Add(Item.Name, Item);
|
||||
end;
|
||||
|
||||
procedure TgirNamespace.HandleInterface(ANode: TDomNode);
|
||||
var
|
||||
Item: TgirInterface;
|
||||
begin
|
||||
Item := TgirInterface.Create(Self, ANode);
|
||||
FTypes.Add(Item.Name, Item);
|
||||
end;
|
||||
|
||||
procedure TgirNamespace.AddGLibBaseTypes;
|
||||
procedure AddNativeTypeDef(GType: String; PascalCName: String);
|
||||
var
|
||||
NativeType: TgirNativeTypeDef;
|
||||
begin
|
||||
NativeType:= TgirNativeTypeDef.Create(Self, GType, PascalCName);
|
||||
Types.Add(NativeType.Name, NativeType);
|
||||
end;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to CTypesMax-1 do
|
||||
AddNativeTypeDef(TypesGTypes[i], TypesPascalCTypes[i]);
|
||||
end;
|
||||
|
||||
procedure TgirNamespace.ResolveFuzzyTypes;
|
||||
var
|
||||
i: Integer;
|
||||
FuzzyI: Integer;
|
||||
Fuzzy: TgirFuzzyType;
|
||||
Tmp: TGirBaseType;
|
||||
begin
|
||||
i:= 0;
|
||||
FuzzyI := 0;
|
||||
Fuzzy := nil;
|
||||
while (i < FTypes.Count) or (Fuzzy <> nil) do
|
||||
begin
|
||||
// make our loop safe
|
||||
if i >= FTypes.Count then
|
||||
begin
|
||||
i := FuzzyI+1;
|
||||
Fuzzy := nil;
|
||||
continue;
|
||||
end;
|
||||
|
||||
Tmp := TGirBaseType(FTypes.Items[i]);
|
||||
|
||||
if Fuzzy <> nil then
|
||||
begin
|
||||
if {(Tmp.CType = Fuzzy.CType) or} (Tmp.Name = Fuzzy.Name) then
|
||||
begin
|
||||
Fuzzy.ResolvedType := Tmp;
|
||||
Tmp.ImpliedPointerLevel:=Fuzzy.ImpliedPointerLevel;
|
||||
i := FuzzyI+1;
|
||||
Fuzzy := nil;
|
||||
//WriteLn('Resolved Fuzzy Type: ', Tmp.CType);
|
||||
continue;
|
||||
end;
|
||||
end;
|
||||
|
||||
if (Fuzzy = nil) and (Tmp.ObjectType = otFuzzyType) and (TgirFuzzyType(Tmp).ResolvedType = nil) then
|
||||
begin
|
||||
if i >= FTypes.Count then
|
||||
break;
|
||||
FuzzyI:=i;
|
||||
Fuzzy := TgirFuzzyType(Tmp);
|
||||
//WriteLn('Looking For: ',Fuzzy.CType);
|
||||
end;
|
||||
inc(i);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TgirNamespace.ParseSubNode(ANode: TDomNode);
|
||||
begin
|
||||
case GirTokenNameToToken(ANode.NodeName) of
|
||||
gtAlias: HandleAlias(ANode);
|
||||
gtConstant: HandleConstant(ANode);
|
||||
gtRecord: HandleRecord(ANode);
|
||||
gtBitField: HandleBitField(ANode);
|
||||
gtEnumeration: HandleEnumeration(ANode);
|
||||
gtCallback: HandleCallback(ANode);
|
||||
gtUnion: HandleUnion(ANode);
|
||||
gtFunction: HandleFunction(ANode);
|
||||
gtClass: HandleClass(ANode);
|
||||
gtInterface: HandleInterface(ANode);
|
||||
gtMethod: HandleFunction(ANode);
|
||||
else
|
||||
girError(geError, 'Unknown NodeType: '+ANode.NodeName);
|
||||
end;
|
||||
ResolveFuzzyTypes;
|
||||
end;
|
||||
|
||||
function TgirNamespace.LookupTypeByName(AName: String; const ACType: String; const SearchOnly: Boolean = False): TGirBaseType;
|
||||
function StripPointers(ACPointeredType: String; PtrLevel: PInteger = nil): String;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := Length(ACPointeredType) downto 1 do
|
||||
if ACPointeredType[i] = '*' then
|
||||
begin
|
||||
Delete(ACPointeredType, i, 1);
|
||||
end;
|
||||
if PtrLevel <> nil then
|
||||
Inc(PtrLevel^);
|
||||
Result := ACPointeredType;
|
||||
end;
|
||||
|
||||
var
|
||||
ReqNS,
|
||||
NS: TgirNamespace;
|
||||
NSString: String;
|
||||
FPos: Integer;
|
||||
i: Integer;
|
||||
Current: TGirBaseType;
|
||||
PointerLevel: Integer = 0;
|
||||
PlainCType: String;
|
||||
begin
|
||||
Result := nil;
|
||||
NS := Self;
|
||||
FPos := Pos('.', AName);
|
||||
PlainCType:=StringReplace(StripPointers(ACType, @PointerLevel), ' ', '_', [rfReplaceAll]);
|
||||
|
||||
if FPos > 0 then // type includes namespace "NameSpace.Type"
|
||||
begin
|
||||
NSString:=Copy(AName,1,FPos-1);
|
||||
NS := (Owner As TgirNamespaces).FindNameSpace(NSString);
|
||||
if NS = nil then
|
||||
girError(geError, 'Referenced Namespace "'+NSString+'" not found while looking for '+AName);
|
||||
AName := Copy(AName, FPos+1, Length(AName));
|
||||
end;
|
||||
|
||||
// some basic fixes
|
||||
if PlainCType = 'gchar' then
|
||||
AName := 'utf8';
|
||||
|
||||
if PlainCType = 'GType' then
|
||||
AName := 'Type';
|
||||
|
||||
Result := TGirBaseType(NS.Types.Find(AName));
|
||||
if (Result <> nil) and (Result.ObjectType = otFuzzyType) and (TgirFuzzyType(Result).ResolvedType <> nil) then
|
||||
Result := TgirFuzzyType(Result).ResolvedType;
|
||||
|
||||
if (Result = nil) and not SearchOnly then
|
||||
begin
|
||||
for i := 0 to NS.RequiredNameSpaces.Count-1 do
|
||||
begin
|
||||
ReqNS := TgirNamespace(NS.RequiredNameSpaces.Items[i]);
|
||||
Current := ReqNS.LookupTypeByName(AName, ACType, True);
|
||||
if Current <> nil then
|
||||
begin
|
||||
if (Current.ObjectType = otFuzzyType) and (TgirFuzzyType(Current).ResolvedType <> nil) then
|
||||
Current := TgirFuzzyType(Current).ResolvedType;
|
||||
Result := Current;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
if Result = nil then
|
||||
Result := NS.AddFuzzyType(AName, ACType);
|
||||
end;
|
||||
if Result <> nil then
|
||||
Result.ImpliedPointerLevel:=PointerLevel;
|
||||
end;
|
||||
|
||||
function TgirNamespace.ResolveFuzzyType(AFuzzyType: TgirFuzzyType): TGirBaseType;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to FTypes.Count-1 do
|
||||
begin
|
||||
if (TGirBaseType(FTypes[i]) <> AFuzzyType) and (TGirBaseType(FTypes[i]).Name = AFuzzyType.Name) then
|
||||
Exit(TGirBaseType(FTypes[i]));
|
||||
end;
|
||||
end;
|
||||
|
||||
function TgirNamespace.UsesGLib: Boolean;
|
||||
var
|
||||
Tmp: Pointer;
|
||||
NS: TgirNamespace absolute Tmp;
|
||||
begin
|
||||
Result := False;
|
||||
if Pos('glib', LowerCase(NameSpace)) = 1 then
|
||||
Exit(True);
|
||||
for Tmp in RequiredNameSpaces do
|
||||
if Pos('glib',LowerCase(NS.NameSpace)) = 1 then
|
||||
Exit(True);
|
||||
end;
|
||||
|
||||
constructor TgirNamespace.Create(AOwner:TObject; AImpliedNamespace: String);
|
||||
begin
|
||||
Fowner:=AOwner;
|
||||
FOnlyImplied:=True;
|
||||
FNameSpace:=AImpliedNamespace;
|
||||
girError(geDebug, 'Creating Stub for namespace: '+ AImpliedNamespace);
|
||||
end;
|
||||
|
||||
constructor TgirNamespace.CreateFromNamespaceNode(AOwner:TObject; ANode: TDOMNode; AIncludes: TList);
|
||||
var
|
||||
Node: TDOMElement absolute ANode;
|
||||
begin
|
||||
FOwner := AOwner;
|
||||
if ANode = nil then
|
||||
girError(geError, 'expected namespace got nil');
|
||||
if ANode.NodeName <> 'namespace' then
|
||||
girError(geError, 'expected namespace got '+ANode.NodeName);
|
||||
FNameSpace:=Node.GetAttribute('name');
|
||||
FRequiredNameSpaces := AIncludes;
|
||||
FSharedLibrary:=Node.GetAttribute('shared-library');
|
||||
FVersion:=Node.GetAttribute('version');
|
||||
girError(geDebug, Format('Creating namespace=%s Version=%s LibName=%s',[FNameSpace, FVersion, FSharedLibrary]));
|
||||
|
||||
FConstants := TList.Create;
|
||||
FFunctions := TList.Create;
|
||||
FTypes := TFPHashObjectList.Create(True);
|
||||
FUnresolvedTypes := TList.Create;
|
||||
|
||||
if FNameSpace = 'GLib' then
|
||||
AddGLibBaseTypes;
|
||||
end;
|
||||
|
||||
destructor TgirNamespace.Destroy;
|
||||
begin
|
||||
FConstants.Free;
|
||||
FFunctions.Free;
|
||||
FTypes.Free;
|
||||
FUnresolvedTypes.Free;
|
||||
if Assigned(FRequiredNameSpaces) then
|
||||
FRequiredNameSpaces.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
1048
applications/gobject-introspection/girobjects.pas
Normal file
1048
applications/gobject-introspection/girobjects.pas
Normal file
File diff suppressed because it is too large
Load Diff
18
applications/gobject-introspection/girparser.pas
Normal file
18
applications/gobject-introspection/girparser.pas
Normal file
@ -0,0 +1,18 @@
|
||||
unit girParser;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
{$INTERFACES CORBA}
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Dom;
|
||||
|
||||
type
|
||||
IgirParser = interface
|
||||
procedure ParseNode(ANode: TDomNode);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
|
||||
1791
applications/gobject-introspection/girpascalwriter.pas
Normal file
1791
applications/gobject-introspection/girpascalwriter.pas
Normal file
File diff suppressed because it is too large
Load Diff
90
applications/gobject-introspection/girtokens.pas
Normal file
90
applications/gobject-introspection/girtokens.pas
Normal file
@ -0,0 +1,90 @@
|
||||
{
|
||||
girtokens.pas
|
||||
Copyright (C) 2011 Andrew Haines andrewd207@aol.com
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU General Public License
|
||||
as published by the Free Software Foundation; either version 2
|
||||
of the License, or (at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
}
|
||||
unit girTokens;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes;
|
||||
|
||||
type
|
||||
TGirToken = (gtInvalid, gtAlias, gtConstant, gtRecord, gtBitField, gtEnumeration,
|
||||
gtCallback, gtUnion, gtFunction, gtReturnValue, gtType,
|
||||
gtParameters, gtParameter, gtMember, gtField, gtMethod, gtArray,
|
||||
gtDoc, gtConstructor, gtRepository, gtInclude, gtNameSpace, gtPackage,
|
||||
gtCInclude, gtClass, gtProperty, gtVirtualMethod, gtInterface,
|
||||
gtGlibSignal, gtImplements, gtPrerequisite,gtVarArgs, gtObject, gtClassStruct, gtGType);
|
||||
|
||||
|
||||
|
||||
var
|
||||
GirTokenName: array[TGirToken] of String = (
|
||||
'Invalid Name',
|
||||
'alias',
|
||||
'constant',
|
||||
'record',
|
||||
'bitfield',
|
||||
'enumeration',
|
||||
'callback',
|
||||
'union',
|
||||
'function',
|
||||
'return-value',
|
||||
'type',
|
||||
'parameters',
|
||||
'parameter',
|
||||
'member',
|
||||
'field',
|
||||
'method',
|
||||
'array',
|
||||
'doc',
|
||||
'constructor',
|
||||
'repository',
|
||||
'include',
|
||||
'namespace',
|
||||
'package',
|
||||
'c:include',
|
||||
'class',
|
||||
'property',
|
||||
'virtual-method',
|
||||
'interface',
|
||||
'glib:signal',
|
||||
'implements',
|
||||
'prerequisite',
|
||||
'varargs',
|
||||
'object',
|
||||
'classstruct',
|
||||
'gtype'
|
||||
);
|
||||
|
||||
function GirTokenNameToToken(AName: String): TGirToken;
|
||||
|
||||
implementation
|
||||
|
||||
function GirTokenNameToToken(AName: String): TGirToken;
|
||||
begin
|
||||
for Result in TGirToken do
|
||||
if GirTokenName[Result] = AName then
|
||||
Exit;
|
||||
Result := gtInvalid;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user