You've already forked lazarus-ccr
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:
399
applications/gobject-introspection/commandlineoptions.pas
Normal file
399
applications/gobject-introspection/commandlineoptions.pas
Normal 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.
|
||||
|
@ -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"/>
|
||||
|
@ -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.
|
||||
|
@ -63,7 +63,7 @@ begin
|
||||
Exit;
|
||||
end;
|
||||
// if AType = geDebug then
|
||||
//WriteLn(girErrorName[AType],': ', AMsg);
|
||||
WriteLn(girErrorName[AType],': ', AMsg);
|
||||
|
||||
end;
|
||||
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
42
applications/gobject-introspection/girpascalclasswriter.pas
Normal file
42
applications/gobject-introspection/girpascalclasswriter.pas
Normal 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
2400
applications/gobject-introspection/girpascalwritertypes.pas
Normal file
2400
applications/gobject-introspection/girpascalwritertypes.pas
Normal file
File diff suppressed because it is too large
Load Diff
@ -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;
|
||||
|
Reference in New Issue
Block a user