paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

chelper: removed some debug output. implemented objcprotocol parsing and writting

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1285 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz 2010-08-15 19:35:32 +00:00
parent 838a446e4a
commit 019dddefcd
2 changed files with 118 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
components/chelper/ctopasconvert.pas
View File

@ -146,6 +146,7 @@ type
function GetPasObjCMethodName(names: TStrings): AnsiString;
procedure WriteObjCMethod(m: TObjCMethod);
procedure WriteObjCInterface(cent: TObjCInterface);
procedure WriteObjCProtocol(cent: TObjCProtocol);
procedure PushWriter;
procedure PopWriter;
@ -514,6 +515,7 @@ begin
cfg:=ASettings;
wr:=TCodeWriter.Create;
WriteFunc:=@DefFuncWrite;
DebugEntities := True;
end;
destructor TCodeConvertor.Destroy;
@ -627,7 +629,7 @@ begin
wr.W(';');
wr.W(' message ''');
for i:=0 to m.Name.Count-1 do wr.W(m.Name[i]);
wr.Wln(''';');
wr.W(''';');
end;
procedure TCodeConvertor.WriteObjCInterface(cent:TObjCInterface);
@ -675,13 +677,41 @@ begin
wr.IncIdent;
for i:=0 to cent.Methods.Count-1 do begin
m:=TObjCMethod(cent.Methods[i]);
WriteObjCMethod(m)
WriteLnCommentsBeforeOffset(m.Offset);
WriteObjCMethod(m);
WriteLnCommentForOffset(m.Offset);
end;
wr.DecIdent;
wr.Wln('end;')
wr.Wln('end external;')
end;
end;
procedure TCodeConvertor.WriteObjCProtocol(cent:TObjCProtocol);
var
i : Integer;
m : TObjCMethod;
begin
SetPasSection(wr, 'type');
wr.W(cent.Name+'Protocol = objcprotocol');
if cent.Protocols.Count>0 then begin
wr.W('(');
for i:=0 to cent.Protocols.Count-2 do wr.W(cent.Protocols[i]+', ');
wr.W(cent.Protocols[cent.Protocols.Count-1]);
wr.Wln(')');
end;
wr.IncIdent;
for i:=0 to cent.Methods.Count-1 do begin
m:=TObjCMethod(cent.Methods[i]);
WriteLnCommentsBeforeOffset(m.Offset);
WriteObjCMethod(m);
WriteLnCommentForOffset(m.Offset);
end;
wr.DecIdent;
wr.W('end; ');
wr.Wln(' external name '''+cent.Name+''';');
end;
procedure TCodeConvertor.PushWriter;
begin
if not Assigned(fWriters) then fWriters:=TList.Create;
@ -1002,6 +1032,8 @@ begin
WritePreprocessor(cent as TCPrepDefine)
else if cent is TObjCInterface then
WriteObjCInterface(cent as TObjCInterface)
else if cent is TObjCProtocol then
WriteObjCProtocol(cent as TObjCProtocol)
else begin
if DebugEntities then
wr.Wln(cent.ClassName);

105
components/chelper/objcparsing.pas
View File

@ -44,6 +44,8 @@ type
Name : AnsiString;
end;
TObjCMethodOpt = (mo_Required, mo_Optional);
TObjCMethod = class(TEntity)
public
isClassMethod : Boolean;
@ -51,6 +53,7 @@ type
RetType : TEntity;
RetName : TNamePart;
Args : array of TObjCMethodArg;
Option : TObjCMethodOpt;
constructor Create(AOffset: Integer=-1); override;
destructor Destroy; override;
procedure AddArg(const ArgType: TEntity; ArgTypeName: TNamePart; const Name: AnsiString);
@ -81,11 +84,24 @@ type
destructor Destroy; override;
end;
{ TObjCProtocol }
TObjCProtocol = class(TEntity)
public
Name : AnsiString;
isForward : Boolean;
Protocols : TStringList;
Methods : TList;
constructor Create(AOffset: Integer=-1); override;
destructor Destroy; override;
end;
function ParseClassList(AParser: TTextParser): TObjCClasses;
function ParseInterface(AParser: TTextParser): TObjCInterface;
function ParseMethod(AParser: TTextParser): TObjCMethod;
function ParseMethods(AParser: TTextParser; MethodsList: TList; const EndToken: AnsiString): Boolean;
function ParserProtocol(AParser: TTextParser): TEntity;
function ParseProtocol(AParser: TTextParser): TEntity;
function ParseNextObjCEntity(AParser: TTextParser): TEntity;
@ -200,7 +216,6 @@ begin
if AParser.Token=':' then begin
AParser.NextToken;
if not ConsumeIdentifier(AParser, itf.SuperClass) then Exit;
//writeln('SuperClass = ', itf.SuperClass);
end;
// protocols
@ -208,7 +223,6 @@ begin
AParser.NextToken;
while AParser.Token<>'>' do begin
if not ConsumeIdentifier(AParser, nm) then Exit;
//writeln('Protos = ', nm);
itf.Protocols.Add(nm);
if AParser.Token=',' then AParser.NextToken
else if AParser.Token<>'>' then begin
@ -219,15 +233,10 @@ begin
AParser.NextToken;
end;
//writeln('parsing vars1 ', AParser.Token);
ParseInstVars(AParser, itf.Vars);
//writeln('parsing vars2 ', AParser.Token);
end;
//writeln('parsing methods1 ', AParser.Token);
if not ParseMethods(AParser, itf.Methods, '@end') then Exit;
//writeln('parsing methods2 ', AParser.Token);
if AParser.Token='@end' then AParser.NextToken;
Result:=itf;
@ -236,9 +245,39 @@ begin
end;
end;
function ParserProtocol(AParser: TTextParser): TEntity;
function ParseProtocol(AParser: TTextParser): TEntity;
var
p : TObjCProtocol;
nm : AnsiString;
begin
Result:=nil;
if AParser.Token<>'@protocol' then Exit;
p := TObjCProtocol.Create(AParser.TokenPos);
try
AParser.NextToken;
if not ConsumeIdentifier(AParser, p.Name) then Exit;
p.isForward:= AParser.Token=';';
if p.isForward then begin
Result:=p;
AParser.NextToken;
Exit;
end;
if AParser.Token='<' then begin
AParser.NextToken;
while AParser.Token<>'>' do begin
if not ConsumeIdentifier(AParser, nm) then Exit;
p.Protocols.Add(nm);
if AParser.Token=',' then AParser.NextToken;
end;
if AParser.Token='>' then AParser.NextToken;
end;
if ParseMethods(AParser, p.Methods, '@end') then Result:=p;
if AParser.Token='@end' then AParser.NextToken;
finally
if not Assigned(Result) then p.Free;
end;
end;
var
@ -252,7 +291,7 @@ begin
t:=GetObjCKeyword(AParser.Token);
if t='class' then Result:=ParseClassList(AParser)
else if t='interface' then Result:=ParseInterface(AParser)
else if t='protocol' then Result:=ParserProtocol(AParser);
else if t='protocol' then Result:=ParseProtocol(AParser);
end else begin
if Assigned(PrevParseNextEntity) then
Result:=PrevParseNextEntity(AParser)
@ -308,27 +347,23 @@ var
begin
Result:=nil;
if (AParser.Token<>'+') and (AParser.Token<>'-') then Exit;
//writeln('in method: ', AParser.Token);
m:=TObjCMethod.Create(AParser.TokenPos);
try
AParser.NextToken;
//writeln('in method2: ', AParser.Token);
if AParser.Token='(' then begin
AParser.NextToken;
if not ParseName(AParser, m.RetType, m.RetName) then Exit;
if not ConsumeToken(AParser, ')') then Exit;
end;
//writeln('in method3: ', AParser.Token);
if not ConsumeIdentifier(AParser, nm) then Exit;
//writeln('in method3: ', AParser.Token);
if (AParser.Token=':') then begin
m.Name.Add(nm+':');
AParser.NextToken;
//writeln('in method4: ', AParser.Token);
while AParser.Token<>';' do begin
prm:=ConsumeToken(AParser, '(') and
ParseName(APArser, atype, atname) and
@ -349,7 +384,6 @@ begin
if not ConsumeToken(AParser, ';') then Exit;
end;
//writeln('in method5: ', AParser.Token);
Result:=m;
finally
if not Assigned(Result) then m.Free;
@ -358,16 +392,24 @@ end;
function ParseMethods(AParser: TTextParser; MethodsList: TList; const EndToken: AnsiString = '@end'): Boolean;
var
m : TObjCMethod;
m : TObjCMethod;
opt : TObjCMethodOpt;
begin
Result:=False;
if not Assigned(MethodsList) or not Assigned(AParser) then Exit;
opt:=mo_Required;
while (AParser.Token<>EndToken) and (AParser.Token<>'') and (AParser.Token[1] in ['+','-']) do begin
//writeln('AParser.Token = ', AParser.Token);
m:=ParseMethod(AParser);
//writeln('m = ', Integer(m));
if not Assigned(m) then Exit;
MethodsList.Add(m);
if isObjCKeyword(AParser.Token) then begin
if GetObjCKeyword(AParser.Token)='optional'
then opt:=mo_Optional
else opt:=mo_Required;
AParser.NextToken
end else begin
m:=ParseMethod(AParser);
if not Assigned(m) then Exit;
m.Option:=opt;
MethodsList.Add(m);
end;
end;
Result:=True;
end;
@ -415,6 +457,25 @@ begin
inherited Destroy;
end;
{ TObjCProtocol }
constructor TObjCProtocol.Create(AOffset:Integer);
begin
inherited Create(AOffset);
Protocols := TStringList.Create;
Methods := TList.Create;
end;
destructor TObjCProtocol.Destroy;
var
i : Integer;
begin
for i:=0 to Methods.Count-1 do TObject(Methods[i]).Free;
Methods.Free;
Protocols.Free;
inherited Destroy;
end;
initialization
PrevParseNextEntity:=ParseNextEntity;
ParseNextEntity:=ParseNextObjCEntity;