Removed CustApp dependency of gir2pas

Implemented some small amount of framework to create pascal classes from gobjects.
Fixed some bugs where properties would not find setters and getters properly when actually available


git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2493 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
drewski207
2012-08-26 20:05:29 +00:00
parent f4e3cdde5d
commit 8d7b0d7e6e
10 changed files with 3051 additions and 2150 deletions

View File

@ -0,0 +1,399 @@
unit CommandLineOptions;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Contnrs;
type
{ TOption }
TOption = class
Names: array of String;
Values: array of String;
Identifier: Integer;
HasArg: Boolean;
Present: Boolean;
Help: String;
MultipleValues: Boolean;
function LongestName: String;
function Value: String;
procedure AddValue(AValue: String);
end;
TCommandLineOptions = class;
TOptionReadError = procedure(Sender: TObject; ErrorMessage: String) of object;
{ TCommandLineOptions }
TCommandLineOptions = class
private
FOnError: TOptionReadError;
FOptions: TObjectList;
FUnassignedArgs: TStringList;
FStopReading: Boolean;
function FindOptionByName(AName: String): TOption;
function FindOptionByIdentifier(AIdentifier: Integer): TOption;
procedure DoError(ErrorMessage: String); virtual;
public
// first setup options
procedure SetOptions(ShortOptions: String; LongOptions: array of String);
procedure AddOption(OptionNames: array of String; HasArg: Boolean = False; Help: String = ''; CanUseMultipleTimes: Boolean = False; Identifier: Integer = -1);
// read from commandline
procedure ReadOptions;
function HasOption(AName: String): Boolean;
function OptionValue(AName:String): String;
function OptionValues(AName: String): TStrings;
constructor Create;
destructor Destroy; override;
function PrintHelp(MaxLineWidth: Integer): TStrings; virtual;
property OnError: TOptionReadError read FOnError write FOnError;
property OptionsMalformed: Boolean read FStopReading;
end;
resourcestring
ErrUnknownOption = 'Option unknown: "%s"';
ErrArgNeededNotPossible = 'Option "%s" requires an argument but an argument is not possible. (Hint: Use "%s" as last option in group "-%s" or use long option --%s)';
ErrArgumentNeeded = 'Option "%s" requires an argument';
ErrOptionHasNoArgument = 'Option "%s" does not accept arguments';
ErrOnlyOneInstance = 'Option "%s" cannot be used more than once';
ErrNoEqualsAllowed = 'Symbol "=" not allowed in argument group "-%s"';
implementation
{ TOption }
function TOption.LongestName: String;
var
N: String;
begin
Result := '';
for N in Names do
begin
if Length(N) > Length(Result) then
Result := N;
end;
end;
function TOption.Value: String;
begin
if Length(Values) > 0 then
Exit(Values[0])
else
Result := '';
end;
procedure TOption.AddValue(AValue: String);
begin
SetLength(Values, Length(Values)+1);
Values[High(Values)] := AValue;
end;
{ TCommandLineOptions }
function TCommandLineOptions.FindOptionByName(AName: String): TOption;
var
Opt: TOption;
N: String;
begin
Result := Nil;
for Pointer(Opt) in FOptions do
begin
for N in Opt.Names do
if AName = N then
Exit(Opt)
end;
end;
function TCommandLineOptions.FindOptionByIdentifier(AIdentifier: Integer
): TOption;
begin
end;
procedure TCommandLineOptions.DoError(ErrorMessage: String);
begin
FStopReading:=True;
if Assigned(FOnError) then
FOnError(Self, ErrorMessage)
else
WriteLn(ErrorMessage);
end;
procedure TCommandLineOptions.SetOptions(ShortOptions: String;
LongOptions: array of String);
var
L: String;
S: String;
HasArg: Boolean;
P,
E: PChar;
begin
P:= PChar(ShortOptions);
E := P + Length(ShortOptions);
for L in LongOptions do
begin
S := P[0];
if P+1 < E then
HasArg:=P[1] = ':';
Inc(P, 1+Ord(HasArg));
AddOption([S, L], HasArg);
end;
end;
procedure TCommandLineOptions.AddOption(OptionNames: array of String;
HasArg: Boolean; Help: String; CanUseMultipleTimes: Boolean; Identifier: Integer);
var
Opt: TOption;
C: Integer;
begin
Opt := TOption.Create;
C := Length(OptionNames);
SetLength(Opt.Names, C);
for C := Low(OptionNames) to High(OptionNames) do
Opt.Names[C] := OptionNames[C];
Opt.HasArg:=HasArg;
Opt.Identifier:=Identifier;
Opt.MultipleValues:=CanUseMultipleTimes;
Opt.Help:=Help;
FOptions.Add(Opt);
end;
procedure TCommandLineOptions.ReadOptions;
var
OptIndex: Integer;
procedure ReadOption(S, G: String; OptionPossible: Boolean);
var
Opt: TOption;
Arg: String;
HasEq: Integer = 0;
begin
HasEq := Pos('=', S);
if HasEq > 0 then
begin
Arg := Copy(S, HasEq+1, Length(S));
S := Copy(S,1, HasEq-1);
end;
Opt := FindOptionByName(S);
if Opt = Nil then
begin
DoError(Format(ErrUnknownOption, [S]));
Exit;
end;
if Opt.HasArg and not OptionPossible then
begin
DoError(Format(ErrArgNeededNotPossible, [S, S, G, Opt.LongestName]));
Exit;
end;
if Opt.HasArg then
begin
if (OptIndex = Paramcount) and (HasEq = 0) then
begin
DoError(Format(ErrArgumentNeeded, [S]));
Exit;
end;
if Opt.Present and not Opt.MultipleValues then
begin
DoError(Format(ErrOnlyOneInstance, [S]));
Exit;
end;
// Verify???
if HasEq = 0 then
begin
Arg := ParamStr(OptIndex+1);
Inc(OptIndex);
end;
Opt.AddValue(Arg);
end
else if HasEq > 0 then
begin
DoError(Format(ErrOptionHasNoArgument, [S]));
end;
Opt.Present:=True;
end;
procedure ReadSingleOptions(S: String);
var
I: Integer;
begin
if S[1] = '-' then // its a long option with 2 dashes : --option
ReadOption(Copy(S,2,Length(S)), '', True)
else // short options put together : -abcdefg
begin
if Pos('=', S) > 0 then
begin
DoError(Format(ErrNoEqualsAllowed,[S]));
Exit;
end;
for I := 1 to Length(S) do
ReadOption(S[I], S, I = Length(S));
end;
end;
var
RawOpt: String;
begin
OptIndex:=0;
while OptIndex < Paramcount do
begin
if FStopReading then
Exit;
Inc(OptIndex);
RawOpt := ParamStr(OptIndex);
if (RawOpt[1] = '-') and (RawOpt <> '-') then // '-' is treated as an unassigned arg.
ReadSingleOptions(Copy(RawOpt,2,Length(RawOpt)))
else
FUnassignedArgs.Add(RawOpt);
end;
end;
function TCommandLineOptions.HasOption(AName: String): Boolean;
var
Opt: TOption;
begin
Result := True;
Opt := FindOptionByName(AName);
if (Opt = nil) or not(Opt.Present) then
Result := False;
end;
function TCommandLineOptions.OptionValue(AName: String): String;
var
Opt: TOption;
S: String;
begin
Opt := FindOptionByName(AName);
Result := Opt.Value;
end;
function TCommandLineOptions.OptionValues(AName: String): TStrings;
var
Opt: TOption;
S: String;
begin
Opt := FindOptionByName(AName);
Result := TStringList.Create;
if Opt = nil then
Exit;
for S in Opt.Values do
Result.Add(S);
end;
constructor TCommandLineOptions.Create;
begin
FOptions := TObjectList.create(True);
FUnassignedArgs := TStringList.Create;
end;
destructor TCommandLineOptions.Destroy;
begin
FOptions.Clear;
FOptions.Free;
FUnassignedArgs.Free;
inherited Destroy;
end;
function TCommandLineOptions.PrintHelp(MaxLineWidth: Integer): TStrings;
var
Padding: array [0..255] of char;
function Space(Orig: String; LengthNeeded: Integer; Before: Boolean = False): String;
begin
if not Before then
Result := Orig+Copy(Padding,0,LengthNeeded-Length(Orig))
else
Result := Copy(Padding,0,LengthNeeded-Length(Orig))+Orig;
end;
var
Opt: TOption;
Tmp: String;
Line: String;
LinePart: String;
I, J: Integer;
S,L,D: TStringList; // short opt, long opt, description
SL, LL: String; // short line, long line
SLL, LLL: Integer; //short line length, long line length
LineSize: Integer;
Gap: Integer;
begin
FillChar(Padding, 256, ' ');
S := TStringList.Create;
L := TStringList.Create;
D := TStringList.Create;
Result := TStringList.Create;
for I := 0 to FOptions.Count-1 do
begin
SL := '';
LL := '';
Line := '';
Opt := TOption(FOptions.Items[I]);
for Tmp in Opt.Names do
if Length(Tmp) = 1 then
SL := SL + ' -' + Tmp
else
LL := LL + ' --' + Tmp;
S.Add(SL);
L.Add(LL);
D.Add(Opt.Help);
end;
SLL := 0;
LLL := 0;
for Tmp in S do
if Length(Tmp) > SLL then
SLL := Length(Tmp);
for Tmp in L do
if Length(Tmp) > LLL then
LLL := Length(Tmp);
for I := 0 to S.Count-1 do
begin
LinePart := '';
SL := Space(S[I], SLL);
LL := Space(L[I], LLL);
Line := SL + ' ' + LL + ' '+ D[I];
if Length(Line) > MaxLineWidth then
begin
LineSize:=MaxLineWidth;
Gap := 0;
repeat
J := LineSize;
//if J > Length(Line) then J := Length(Line);
while (J > 0){ and (Length(Line) > 0)} do
begin
if (Line[J] = ' ') or (J = 1) then
begin
LinePart := Copy(Line, 1, J);
LinePart := Space(LinePart, Length(LinePart)+Gap, True);
Delete(Line,1,J);
Result.Add(LinePart);
break;
end;
Dec(J);
end;
Gap := SLL+1+LLL+4;
LineSize := MaxLineWidth-(Gap);
until Length(Line) = 0;
end
else
Result.Add(Line);
end;
S.Free;
L.Free;
D.Free;
end;
end.

View File

@ -30,11 +30,11 @@
<RunParams>
<local>
<FormatVersion Value="1"/>
<CommandLineParams Value="-i /usr/share/gir-1.0/WebKit-3.0.gir -o /home/andrew/programming/lazarus-ccr/bindings/gtk3/ -w"/>
<CommandLineParams Value="-wCni /home/andrew/programming/lazarus-ccr/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)'"/>
</local>
</RunParams>
<Units Count="8">
<Units Count="11">
<Unit0>
<Filename Value="gir2pascal.lpr"/>
<IsPartOfProject Value="True"/>
@ -75,10 +75,25 @@
<IsPartOfProject Value="True"/>
<UnitName Value="girObjects"/>
</Unit7>
<Unit8>
<Filename Value="girpascalclasswriter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="girPascalClassWriter"/>
</Unit8>
<Unit9>
<Filename Value="girpascalwritertypes.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="girpascalwritertypes"/>
</Unit9>
<Unit10>
<Filename Value="commandlineoptions.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="CommandLineOptions"/>
</Unit10>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="10"/>
<Version Value="11"/>
<Target>
<Filename Value="gir2pascal"/>
</Target>
@ -86,12 +101,6 @@
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<GenerateDebugInfo Value="True"/>
<DebugInfoType Value="dsAuto"/>
</Debugging>
</Linking>
<Other>
<CompilerMessages>
<UseMsgFile Value="True"/>

View File

@ -19,44 +19,53 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
program gir2pascal;
{$mode objfpc}{$H+}
{ $DEFINE CreatePascalClasses}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp, DOM, XMLRead, girNameSpaces, girFiles,
girpascalwriter, girErrors, girCTypesMapping, girTokens, girObjects;
Classes, SysUtils,CommandLineOptions, DOM, XMLRead, girNameSpaces, girFiles,
girpascalwriter, girErrors, girCTypesMapping, girTokens, girObjects,
girPascalClassWriter, girpascalwritertypes{$IFDEF UNIX}, baseunix, termio{$ENDIF};
type
{ TGirConsoleConverter }
TGirConsoleConverter = class(TCustomApplication)
TGirConsoleConverter = class
private
FCmdOptions: TCommandLineOptions;
FWriteCount: Integer;
FPaths: TStringList;
FOutPutDirectory : String;
FFileToConvert: String;
FOverWriteFiles: Boolean;
FWantTest: Boolean;
FDynamicLink: Boolean;
FOptions: TgirOptions;
procedure AddDefaultPaths;
procedure AddPaths(APaths: String);
procedure VerifyOptions;
procedure Convert;
// options
function CheckOptions: String;
//callbacks
function NeedGirFile(AGirFile: TObject; NamespaceName: String) : TXMLDocument;
// AName is the whole name unit.pas or file.c
procedure WriteFile(Sender: TObject; AName: String; AStream: TStringStream);
procedure Terminate;
protected
procedure DoRun; override;
procedure DoRun; //override;
public
constructor Create(TheOwner: TComponent); override;
constructor Create;
destructor Destroy; override;
procedure WriteHelp; virtual;
procedure Run;
end;
{ TGirConsoleConverter }
procedure TGirConsoleConverter.AddDefaultPaths;
@ -94,6 +103,12 @@ begin
Terminate;
Halt;
end;
if FCmdOptions.HasOption('objects') and FCmdOptions.HasOption('classes') then
begin
WriteLn('Cannot use options ''--objects'' and ''--classes'' together!.');
Terminate;
Halt;
end;
end;
function TGirConsoleConverter.NeedGirFile(AGirFile: TObject; NamespaceName: String): TXMLDocument;
@ -101,9 +116,11 @@ var
Sr: TSearchRec;
Path: String;
begin
WriteLn('Looking for gir file: ', NamespaceName);
Result := nil;
for Path in FPaths do
begin
WriteLn('Looking in path: ', Path);
if FindFirst(Path+NamespaceName+'.gir', faAnyFile, Sr) = 0 then
begin
ReadXMLFile(Result, Path+Sr.Name);
@ -111,6 +128,8 @@ begin
end;
FindClose(Sr);
end;
if Result = nil then
WriteLn('Unable to find gir file: ',NamespaceName);
end;
procedure TGirConsoleConverter.WriteFile(Sender: TObject; AName: String; AStream: TStringStream);
@ -139,6 +158,11 @@ begin
end;
end;
procedure TGirConsoleConverter.Terminate;
begin
Halt(1);
end;
procedure TGirConsoleConverter.Convert;
var
Doc: TXMLDocument;
@ -154,7 +178,7 @@ begin
girFile.ParseXMLDocument(Doc);
Doc.Free;
Writer := TgirPascalWriter.Create(girFile.NameSpaces, FWantTest, FDynamicLink);
Writer := TgirPascalWriter.Create(girFile.NameSpaces, FOptions);
Writer.OnUnitWriteEvent:= @WriteFile;
Writer.GenerateUnits;
@ -165,44 +189,99 @@ begin
WriteLn(Format('Converted %d file(s) in %f seconds',[FWriteCount, DateTimeToTimeStamp(EndTime).Time / 1000]));
end;
function TGirConsoleConverter.CheckOptions: String;
begin
Result := '';
//FCmdOptions.SetOptions(ShortOpts, LongOpts);
with FCmdOptions do
begin
AddOption(['h', 'help'], False ,'Show this help message.');
AddOption(['i', 'input'], True ,'.gir filename to convert.');
AddOption(['o', 'output-directory'], True ,'Directory to write the resulting .pas files to. If not specified then the current working directory is used.');
AddOption(['D', 'dynamic'], False , 'Use unit dynlibs and link at runtime');
{$IFDEF CreatePascalClasses}
AddOption(['s', 'seperate-units'], False ,'Creates seperate units for each gir file: (xConsts, xTypes, xFunctions, [xClasses, xObjects].');
AddOption(['C', 'classes'], False ,'Create Pascal classes that envelope/wrap the GObjects. Also forces ''-s''');
AddOption(['O', 'objects'], False ,'OPTION NOT IMPLEMENTED YET. See Note below. '+
'Creates a seperate unit for pascal Objects (not classes). Forces ''-s'' '+
'Note: If -C or -O are not used then pascal Objects and consts '+
'are in a single unit.');
{$ENDIF CreatePascalClasses}
AddOption(['w', 'overwrite-files'], False ,'If the output .pas file(s) already exists then overwrite them.');
AddOption(['n', 'no-default'], False ,'/usr/share/gir-1.0 is not added as a search location for needed .gir files.');
AddOption(['p', 'paths'], True ,'List of paths seperated by ":" to search for needed .gir files.');
AddOption(['t', 'test'], False ,'Creates a test program per unit to verify struct sizes.');
end;
FCmdOptions.ReadOptions;
if FCmdOptions.OptionsMalformed then
REsult := 'Error reading arguments';
end;
procedure TGirConsoleConverter.DoRun;
var
ErrorMsg: String;
begin
// quick check parameters
ErrorMsg:=CheckOptions('hnp:o:i:wtD',['help','no-default','paths','output-directory', 'input', 'overwrite-files', 'test', 'dynamic']);
if ErrorMsg<>'' then begin
ShowException(Exception.Create(ErrorMsg));
Terminate;
Exit;
end;
CheckOptions;//('hnp:o:i:wtDCsO',['help','no-default','paths','output-directory', 'input', 'overwrite-files', 'test', 'dynamic', 'classes', 'seperate-units', 'objects']);
// parse parameters
if HasOption('h','help') then begin
if FCmdOptions.OptionsMalformed then
begin
WriteLn('See -h for options.');
Terminate;
Halt;
end;
if FCmdOptions.HasOption('help') then begin
WriteHelp;
Terminate;
Exit;
end;
if not HasOption('n', 'no-default') then
if not FCmdOptions.HasOption('input') then
begin
WriteLn('No input file specified! See -h for options.');
Terminate;
Halt;
end;
if not FCmdOptions.HasOption('no-default') then
AddDefaultPaths;
if HasOption('o', 'output-directory') then
FOutPutDirectory:=IncludeTrailingPathDelimiter(GetOptionValue('o', 'output-directory'))
if FCmdOptions.HasOption('output-directory') then
FOutPutDirectory:=IncludeTrailingPathDelimiter(FCmdOptions.OptionValue('output-directory'))
else
FOutPutDirectory:=IncludeTrailingPathDelimiter(GetCurrentDir);
FFileToConvert:=GetOptionValue('i','input');
FFileToConvert:=FCmdOptions.OptionValue('input');
AddPaths(ExtractFilePath(FFileToConvert));
if HasOption('p', 'paths') then
AddPaths(GetOptionValue('p', 'paths'));
if FCmdOptions.HasOption('paths') then
AddPaths(FCmdOptions.OptionValue('paths'));
if HasOption('w', 'overwrite-files') then
if FCmdOptions.HasOption('overwrite-files') then
FOverWriteFiles:=True;
FWantTest := HasOption('t', 'test');
if FCmdOptions.HasOption('test') then
Include(FOptions, goWantTest);
FDynamicLink := HasOption('D', 'dynamic');
if FCmdOptions.HasOption('dynamic') then
Include(FOptions, goLinkDynamic);
if FCmdOptions.HasOption('classes') then
begin
Include(FOptions, goClasses);
Include(FOptions, goSeperateConsts);
end;
if FCmdOptions.HasOption('objects') then
begin
Include(FOptions, goObjects);
Include(FOptions, goSeperateConsts);
end;
if FCmdOptions.HasOption('seperate-units') then
Include(FOptions, goSeperateConsts);
VerifyOptions;
@ -213,34 +292,62 @@ begin
Terminate;
end;
constructor TGirConsoleConverter.Create(TheOwner: TComponent);
constructor TGirConsoleConverter.Create;
begin
inherited Create(TheOwner);
//inherited Create(TheOwner);
FCmdOptions := TCommandLineOptions.Create;
FPaths := TStringList.Create;
end;
destructor TGirConsoleConverter.Destroy;
begin
FPaths.Free;
FCmdOptions.Free;
inherited Destroy;
end;
procedure TGirConsoleConverter.WriteHelp;
var
{$IFDEF UNIX}
w: winsize;
{$ENDIF}
ConsoleWidth: Integer;
begin
ConsoleWidth:=80;
{$IFDEF UNIX}
fpioctl(0, TIOCGWINSZ, @w);
ConsoleWidth:=w.ws_col;
{$ENDIF}
Writeln('Usage: ',ExtractFileName(ParamStr(0)),' [options] -i filename');
WriteLn(FCmdOptions.PrintHelp(ConsoleWidth).Text);
{
Writeln('');
writeln(' Usage: ',ExtractFileName(ExeName),' [options] -i filename');
writeln(' Usage: ',ExtractFileName(ParamStr(0)),' [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(' -D --dynamic Use unit dynlibs and link at runtime');
Writeln(' specified then the current working directory is used.');
WriteLn(' -s --seperate-units Creates seperate units for each gir file:');
WriteLn(' (xConsts, xTypes, xFunctions, [xClasses, xObjects].');
WriteLn(' -C --classes Create Pascal classes that envelope/wrap the GObjects.');
WriteLn(' Also forces ''-s''');
WriteLn(' -O --objects OPTION NOT IMPLEMENTED YET. See Note below');
WriteLn(' Creates a seperate unit for pascal Objects (not classes). Forces ''-s''');
WriteLn(' Note: If -C or -O are not used then pascal Objects and consts');
WriteLn(' are in a single unit.');
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(' needed .gir files.');
Writeln(' -p --paths= List of paths seperated by ":" to search for needed .gir files.');
Writeln(' -t --test Creates a test program and a test c file per unit to verify struct sizes.');
Writeln('');
}
end;
procedure TGirConsoleConverter.Run;
begin
DoRun;
end;
var
@ -249,7 +356,7 @@ var
{$R *.res}
begin
Application:=TGirConsoleConverter.Create(nil);
Application:=TGirConsoleConverter.Create;
Application.Run;
Application.Free;
end.

View File

@ -63,7 +63,7 @@ begin
Exit;
end;
// if AType = geDebug then
//WriteLn(girErrorName[AType],': ', AMsg);
WriteLn(girErrorName[AType],': ', AMsg);
end;

View File

@ -482,7 +482,9 @@ begin
if FPos > 0 then // type includes namespace "NameSpace.Type"
begin
NSString:=Copy(AName,1,FPos-1);
NS := (Owner As TgirNamespaces).FindNameSpace(NSString);
//NS := (Owner As TgirNamespaces).FindNameSpace(NSString);
NS := TgirNamespaces(Owner).FindNameSpace(NSString);
if NS = nil then
girError(geError, 'Referenced Namespace "'+NSString+'" not found while looking for '+AName);
AName := Copy(AName, FPos+1, Length(AName));
@ -490,6 +492,7 @@ begin
if NS <> Self then SearchOnly:=True;
//if NS <> Self then WriteLn('Self NS = ', NameSpace, ' Lookup NS = ', NS.NameSpace);
Result := TGirBaseType(NS.Types.Find(AName));
if (Result <> nil) and (Result.ObjectType = otFuzzyType) and (TgirFuzzyType(Result).ResolvedType <> nil) then
Result := TgirFuzzyType(Result).ResolvedType;

View File

@ -726,7 +726,6 @@ var
begin
inherited Create(AOwner, ANode);
FFields := TgirFieldsList.Create;
{$warning not implemented}
Node := ANode.FirstChild;
while Node <> nil do
begin
@ -814,6 +813,9 @@ begin
//NodeURL(ANode);
//Node := TDomELement(ANode.FindNode('type'));
Node := TDOMElement(ANode.FirstChild);
if Node = nil then
girError(geError, Format(geMissingNode,[ClassName, '', ANode.NodeName]));
while Node <> nil do
begin
// it's one or the other
@ -851,8 +853,25 @@ begin
if (FVarType <> nil) {and (GirTokenNameToToken(ANode.NodeName) = gtArray)} then
FVarType.ImpliedPointerLevel := PointerLevelFromVarName(CType);
if Token <> gtVarArgs then
FVarType.ImpliedPointerLevel:=PointerLevel; //only will grow
if (FVarType <> nil) and (Token <> gtVarArgs) then
FVarType.ImpliedPointerLevel:=PointerLevel; //only will grow
if (FVarType = nil) and (Token <> gtVarArgs) then
begin
WriteLn('Vartype name = ',VarTypeName);
VarTypeName := ANode.NodeName;
Node := TDOMElement(Anode.ParentNode);
while Node <> nil do
begin
if node.InheritsFrom(TDOMElement) then
VarTypeName := Node.NodeName + '('+Node.GetAttribute('name')+')/'+ VarTypeName
else
VarTypeName := Node.NodeName + '/'+ VarTypeName;
Node := TDOMElement(Node.ParentNode);
end;
WriteLn('Vartype is nil when it shouldnt be! '+VarTypeName );
raise Exception.Create('Vartype is nil when it shouldnt be! ');
end;
FObjectType:=otTypeParam;
end;
@ -1052,10 +1071,22 @@ end;
constructor TgirAlias.Create(AOwner: TObject; ANode: TDomNode);
var
Node: TDOMElement;
TmpNode, Node: TDOMElement;
NodePath: String;
begin
inherited Create(AOwner, ANode);
Node := TDomELement(ANode.FindNode('type'));
TmpNode := Node;
while TmpNode <> nil do
begin
if TmpNode.InheritsFrom(TDOMElement) then
NodePath := TmpNode.NodeName + '('+TmpNode.GetAttribute('name')+')/'+ NodePath
else
NodePath := TmpNode.NodeName + '/'+ NodePath;
TmpNode := TDOMElement(TmpNode.ParentNode);
end;
//WriteLn('ALIAS: ', Node.GetAttribute('name')+' ', NodePath);
FForType := TgirNamespace(Owner).LookupTypeByName(Node.GetAttribute('name'), Node.GetAttribute('c:type'));
FObjectType:=otAlias;
end;

View File

@ -0,0 +1,42 @@
{
The purpose of this unit is to create native pascal classes that wrap gobjects in a comfortable and usable way.
}
unit girPascalClassWriter;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, girObjects, girpascalwriter, girpascalwritertypes;
type
{ TGObjectClass }
TGObjectClass = class
private
FParentGObjectClass: TGObjectClass;
FgirObject: TgirClass;
FPascalUnit: TPascalUnit;
public
constructor Create(AParentGObjectClass: TGObjectClass; AClass: TgirClass; APascalUnit: TPascalUnit);
property ParentGObjectClass: TGObjectClass read FParentGObjectClass;
end;
implementation
{ TGObjectClass }
constructor TGObjectClass.Create(AParentGObjectClass: TGObjectClass; AClass: TgirClass; APascalUnit: TPascalUnit);
begin
FParentGObjectClass := AParentGObjectClass;
FgirObject := AClass;
FPascalUnit:=APascalUnit;
end;
end.

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -81,7 +81,9 @@ implementation
function GirTokenNameToToken(AName: String): TGirToken;
begin
for Result in TGirToken do
if GirTokenName[Result] = AName then
if GirTokenName[Result][1] <> AName[1] then
continue
else if GirTokenName[Result] = AName then
Exit;
Result := gtInvalid;
end;