chelper: fix for objc methods, protocols parsing and writting
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1288 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
parent
e3d745b988
commit
dd80a33837
@ -226,9 +226,69 @@ type
|
||||
_Params : AnsiString;
|
||||
end;
|
||||
|
||||
// parsing function
|
||||
type
|
||||
|
||||
{ TSimpleType }
|
||||
|
||||
TSimpleType = class(TEntity)
|
||||
public
|
||||
Name : AnsiString;
|
||||
end;
|
||||
|
||||
{ TExpression }
|
||||
|
||||
TExpPart = record
|
||||
Token : AnsiString;
|
||||
TokenType : TTokenType;
|
||||
end;
|
||||
|
||||
TExpression = class(TEntity)
|
||||
function DoParse(AParser: TTextParser): Boolean; override;
|
||||
public
|
||||
Tokens : array of TExpPart;
|
||||
Count : Integer;
|
||||
procedure PushToken(const AToken: AnsiString; ATokenType: TTokenType);
|
||||
end;
|
||||
|
||||
const
|
||||
nk_Ident = 0;
|
||||
nk_Ref = 1;
|
||||
nk_Array = 2;
|
||||
nk_Func = 3;
|
||||
|
||||
type
|
||||
TNameKind = Integer;
|
||||
|
||||
type
|
||||
TNamePart = class;
|
||||
|
||||
TFuncParam = record
|
||||
prmtype : TEntity;
|
||||
name : TNamePart;
|
||||
end;
|
||||
|
||||
{ TNamePart }
|
||||
|
||||
TNamePart = class(TObject)
|
||||
private
|
||||
fChild : TNamePart;
|
||||
fOwner : TNamePart;
|
||||
public
|
||||
Kind : TNameKind;
|
||||
RefCount : Integer;
|
||||
Id : AnsiString;
|
||||
arrayexp : array of TExpression;
|
||||
params : array of TFuncParam;
|
||||
constructor Create(AKind: TNameKind);
|
||||
procedure AddParam(prmtype: TEntity; prmname: TNamePart);
|
||||
procedure AddArrayExpr(expr: TExpression);
|
||||
property child: TNamePart read fchild write fChild; // int (*p)[10]; "[10]" is child of (*p)
|
||||
property owner: TNamePart read fowner write fOwner;
|
||||
end;
|
||||
|
||||
var
|
||||
ParseNextEntity: function (AParser: TTextParser): TEntity = nil;
|
||||
ParseNamePart : function (Parser: TTextParser): TNamePart = nil;
|
||||
|
||||
function ParseNextCEntity(AParser: TTextParser): TEntity;
|
||||
|
||||
@ -254,64 +314,12 @@ function CreateCParser(const CHeaderText: AnsiString;
|
||||
type
|
||||
TCustomEntityProc = function (Parent: TEntity; Parser: TTextParser): TEntity;
|
||||
|
||||
type
|
||||
|
||||
{ TSimpleType }
|
||||
|
||||
TSimpleType = class(TEntity)
|
||||
public
|
||||
Name : AnsiString;
|
||||
end;
|
||||
|
||||
{ TExpression }
|
||||
|
||||
TExpPart = record
|
||||
Token : AnsiString;
|
||||
TokenType : TTokenType;
|
||||
end;
|
||||
TExpression = class(TEntity)
|
||||
function DoParse(AParser: TTextParser): Boolean; override;
|
||||
public
|
||||
Tokens : array of TExpPart;
|
||||
Count : Integer;
|
||||
procedure PushToken(const AToken: AnsiString; ATokenType: TTokenType);
|
||||
end;
|
||||
|
||||
procedure ErrorExpect(Parser: TTextParser; const Expect: AnsiString);
|
||||
function ConsumeToken(Parser: TTextParser; const Token: AnsiString): Boolean;
|
||||
function ConsumeIdentifier(Parser: TTextParser; var Id: AnsiString): Boolean;
|
||||
|
||||
function ParseCType(Parser: TTextParser): TEntity;
|
||||
|
||||
type
|
||||
TNamePart = class;
|
||||
|
||||
TFuncParam = record
|
||||
prmtype : TEntity;
|
||||
name : TNamePart;
|
||||
end;
|
||||
|
||||
TNameKind = (nk_Ident, nk_Ref, nk_Array, nk_Func);
|
||||
|
||||
{ TNamePart }
|
||||
|
||||
TNamePart = class(TObject)
|
||||
private
|
||||
fChild : TNamePart;
|
||||
fOwner : TNamePart;
|
||||
public
|
||||
Kind : TNameKind;
|
||||
RefCount : Integer;
|
||||
Id : AnsiString;
|
||||
arrayexp : array of TExpression;
|
||||
params : array of TFuncParam;
|
||||
constructor Create(AKind: TNameKind);
|
||||
procedure AddParam(prmtype: TEntity; prmname: TNamePart);
|
||||
procedure AddArrayExpr(expr: TExpression);
|
||||
property child: TNamePart read fchild write fChild; // int (*p)[10]; "[10]" is child of (*p)
|
||||
property owner: TNamePart read fowner write fOwner;
|
||||
end;
|
||||
|
||||
function ParseNames(Parser: TTextParser; var NameType: TEntity; Names: TList; AllowMultipleNames: Boolean=True): Boolean;
|
||||
function ParseName(Parser: TTextParser; var NameType: TEntity; var name: TNamePart): Boolean;
|
||||
|
||||
@ -1458,8 +1466,6 @@ end;
|
||||
function ParseNextCEntity(AParser: TTextParser): TEntity;
|
||||
var
|
||||
s : AnsiString;
|
||||
tt : TTokenType;
|
||||
|
||||
tp : TEntity;
|
||||
nm : TNamePart;
|
||||
v : TVarFuncEntity;
|
||||
@ -1493,6 +1499,8 @@ begin
|
||||
end else
|
||||
Result:=v;
|
||||
end;
|
||||
|
||||
if AParser.Token<>';' then ErrorExpect(AParser,';');
|
||||
end;
|
||||
|
||||
procedure ErrorExpect(Parser:TTextParser;const Expect:AnsiString);
|
||||
@ -1644,7 +1652,7 @@ begin
|
||||
Parser.NextToken;
|
||||
end;
|
||||
|
||||
function ParseNamePart(Parser: TTextParser): TNamePart;
|
||||
function ParseCNamePart(Parser: TTextParser): TNamePart;
|
||||
var
|
||||
prefix : TNamePart;
|
||||
id : TNamePart;
|
||||
@ -2023,6 +2031,7 @@ end;
|
||||
|
||||
initialization
|
||||
ParseNextEntity:=@ParseNextCEntity;
|
||||
ParseNamePart:=@ParseCNamePart;
|
||||
|
||||
|
||||
end.
|
||||
|
@ -81,6 +81,23 @@ function isNumberExp(x: TExpression; var v: Int64): Boolean;
|
||||
// int a[MAXCONST] -> a: array [0..MAXCONST-1] of Integer;
|
||||
function PasArrayLimit(x: TExpression): AnsiString;
|
||||
|
||||
type
|
||||
|
||||
{ TStopComment }
|
||||
|
||||
TStopComment = class(TObject)
|
||||
public
|
||||
FirstComment : boolean;
|
||||
CommentFound : boolean;
|
||||
CommentEnd : Integer;
|
||||
Precomp : TEntity;
|
||||
PrecompEnd : Integer;
|
||||
|
||||
procedure OnComment(Sender: TObject; const Str: ansistring);
|
||||
procedure OnPrecompiler(Sender: TTextParser; PrecompEntity: TObject);
|
||||
procedure Clear;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
@ -114,7 +131,6 @@ type
|
||||
CmtList : TList;
|
||||
Breaker : TLineBreaker;
|
||||
LastOffset : Integer;
|
||||
function FindCommentForLine(ln: Integer): TComment;
|
||||
protected
|
||||
fWriters : TList;
|
||||
AuxTypeCounter : Integer;
|
||||
@ -140,7 +156,7 @@ type
|
||||
procedure WriteEnumAsConst(en: TEnumType; FinishWithInteger: Boolean=True);
|
||||
procedure WriteUnion(st: TUnionType);
|
||||
procedure WriteStruct(st: TStructType);
|
||||
procedure WriteCommentToPas(cent: TComment);
|
||||
procedure WriteCommentToPas(cent: TComment; NeedLineBreak: Boolean);
|
||||
procedure WriteExp(x: TExpression);
|
||||
procedure WritePreprocessor(cent: TCPrepDefine);
|
||||
|
||||
@ -239,21 +255,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
type
|
||||
|
||||
{ TStopComment }
|
||||
|
||||
TStopComment = class(TObject)
|
||||
public
|
||||
FirstComment : boolean;
|
||||
CommentFound : boolean;
|
||||
CommentEnd : Integer;
|
||||
Precomp : TEntity;
|
||||
PrecompEnd : Integer;
|
||||
|
||||
procedure OnComment(Sender: TObject; const Str: ansistring);
|
||||
procedure OnPrecompiler(Sender: TTextParser; PrecompEntity: TObject);
|
||||
end;
|
||||
{ TStopComment }
|
||||
|
||||
procedure TStopComment.OnComment(Sender: TObject; const Str: ansistring);
|
||||
var
|
||||
@ -278,22 +280,24 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function ParseNextEntityOrComment(AParser: TTextParser): TEntity;
|
||||
procedure TStopComment.Clear;
|
||||
begin
|
||||
FirstComment:=False;
|
||||
CommentFound:=False;
|
||||
Precomp:=nil;
|
||||
CommentEnd:=-1;
|
||||
PrecompEnd:=-1;
|
||||
end;
|
||||
|
||||
function ParseNextEntityOrComment(AParser: TTextParser; cmt: TStopComment): TEntity;
|
||||
var
|
||||
cmt : TStopComment;
|
||||
ent : TEntity;
|
||||
entidx : Integer;
|
||||
begin
|
||||
cmt := TStopComment.Create;
|
||||
AParser.UseCommentEntities := True;
|
||||
AParser.OnComment := @cmt.OnComment;
|
||||
AParser.OnPrecompile:=@cmt.OnPrecompiler;
|
||||
Result:=nil;
|
||||
|
||||
AParser.NextToken;
|
||||
|
||||
ent := ParseNextEntity(AParser);
|
||||
entidx:=AParser.Index;
|
||||
entidx := AParser.Index;
|
||||
|
||||
if cmt.FirstComment then begin
|
||||
if Assigned(cmt.Precomp) then begin
|
||||
@ -306,11 +310,11 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
cmt.Free;
|
||||
if (not Assigned(Result)) or (Assigned(ent) and (ent.Offset<Result.Offset)) then begin
|
||||
Result:=ent;
|
||||
AParser.Index:=entidx;
|
||||
end;
|
||||
end else
|
||||
AParser.NextToken;
|
||||
end;
|
||||
|
||||
function GetRefAsterix(const AstCount: integer): ansistring;
|
||||
@ -343,7 +347,6 @@ begin
|
||||
Result:=PasExp(x) + '-1';
|
||||
end;
|
||||
|
||||
|
||||
procedure WriteArray(arr: TNamePart; wr: TCodeWriter);
|
||||
var
|
||||
i : Integer;
|
||||
@ -353,7 +356,6 @@ begin
|
||||
wr.W(' of ');
|
||||
end;
|
||||
|
||||
|
||||
type
|
||||
TMacrosMaker = class(TObject)
|
||||
public
|
||||
@ -436,6 +438,7 @@ var
|
||||
owncfg : Boolean;
|
||||
lastsec : AnsiString; // last code section
|
||||
ofs : Integer;
|
||||
cmt : TStopComment;
|
||||
begin
|
||||
Result:='';
|
||||
ent:=nil;
|
||||
@ -447,13 +450,19 @@ begin
|
||||
|
||||
if cfg.CustomDefines<>'' then PrepareMacros(cfg.CustomDefines, macros);
|
||||
|
||||
cmt := TStopComment.Create;
|
||||
p := CreateCParser(t);
|
||||
p.MacroHandler:=macros;
|
||||
p.UseCommentEntities := True;
|
||||
p.OnComment := @cmt.OnComment;
|
||||
p.OnPrecompile:=@cmt.OnPrecompiler;
|
||||
|
||||
try
|
||||
repeat
|
||||
try
|
||||
ofs := p.Index;
|
||||
ent := ParseNextEntityOrComment(p);
|
||||
p.NextToken;
|
||||
ent := ParseNextEntityOrComment(p, cmt);
|
||||
except
|
||||
ent:=nil;
|
||||
end;
|
||||
@ -473,7 +482,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
cnv.WriteCtoPas(ent, p.Comments, t);
|
||||
cnv.WriteCtoPas(ent, p.Comments, p.Buf);
|
||||
|
||||
lastsec:=cnv.wr.Section;
|
||||
except
|
||||
@ -495,15 +504,14 @@ begin
|
||||
while i < p.Index do begin
|
||||
Inc(endPoint.Y);
|
||||
le := i;
|
||||
SkipLine(t, i);
|
||||
SkipLine(p.Buf, i);
|
||||
end;
|
||||
endPoint.X := p.Index - le + 1 + p.MacrosDelta;
|
||||
|
||||
|
||||
|
||||
finally
|
||||
p.Free;
|
||||
macros.Free;
|
||||
cmt.Free;
|
||||
end;
|
||||
except
|
||||
on e: Exception do Result:=Result+LineEnding+' internal error: '+ e.Message;
|
||||
@ -533,7 +541,7 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TCodeConvertor.WriteCommentToPas(cent: TComment);
|
||||
procedure TCodeConvertor.WriteCommentToPas(cent: TComment; NeedLineBreak: Boolean);
|
||||
var
|
||||
u: ansistring;
|
||||
begin
|
||||
@ -541,12 +549,13 @@ begin
|
||||
if cent.CommenType = ctBlock then
|
||||
begin
|
||||
u := StringReplace(u, '*)', '* )', [rfReplaceAll]);
|
||||
wr.Wln('(*' + u + ' *)');
|
||||
wr.W('(*' + u + ' *)');
|
||||
end
|
||||
else
|
||||
begin
|
||||
wr.Wln('//' + u);
|
||||
wr.W('//' + u);
|
||||
end;
|
||||
if NeedLineBreak then wr.Wln;
|
||||
end;
|
||||
|
||||
procedure TCodeConvertor.WriteExp(x:TExpression);
|
||||
@ -625,7 +634,10 @@ begin
|
||||
if m.Args[i].Name=''
|
||||
then PNames[i]:=cfg.ParamPrefix+IntToStr(i)
|
||||
else PNames[i]:=m.Args[i].Name;
|
||||
PTypes[i]:=GetPasTypeName(m.Args[i].RetType, m.Args[i].TypeName);
|
||||
if not Assigned(m.Args[i].RetType) then
|
||||
PTypes[i]:='id'
|
||||
else
|
||||
PTypes[i]:=GetPasTypeName(m.Args[i].RetType, m.Args[i].TypeName);
|
||||
end;
|
||||
|
||||
DefFuncWrite(wr, GetPasObjCMethodName(m.Name), ret, PNames, PTypes);
|
||||
@ -662,7 +674,6 @@ begin
|
||||
|
||||
wr.W('procedure '+nm+'(AValue: '+tp+'); message '''+mtd+''';');
|
||||
end;
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -675,14 +686,17 @@ begin
|
||||
for i:=0 to list.Count-1 do begin
|
||||
ent:=TEntity(list[i]);
|
||||
if not Assigned(ent) then Continue;
|
||||
|
||||
WriteLnCommentsBeforeOffset(ent.Offset);
|
||||
if ent is TObjCMethod then
|
||||
WriteObjCMethod(TObjCMethod(ent))
|
||||
else if ent is TObjCProperty then begin
|
||||
WriteObjCProperty(TObjCProperty(ent));
|
||||
end;
|
||||
|
||||
WriteLnCommentForOffset(ent.Offset);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TCodeConvertor.WriteObjCInterface(cent:TObjCInterface);
|
||||
@ -696,7 +710,9 @@ const
|
||||
begin
|
||||
SetPasSection(wr, 'type');
|
||||
if cent.isCategory then begin
|
||||
wr.W(cent.Name + ' = objccategory')
|
||||
wr.W(cent.Name + ' = objccategory');
|
||||
if cent.SuperClass<>'' then wr.W('('+cent.SuperClass+')');
|
||||
wr.Wln;
|
||||
end else begin
|
||||
wr.W(cent.Name + ' = objcclass');
|
||||
if cent.SuperClass<>'' then wr.W('('+cent.SuperClass);
|
||||
@ -730,7 +746,7 @@ begin
|
||||
WriteObjCMethods(cent.Methods);
|
||||
wr.DecIdent;
|
||||
end;
|
||||
wr.Wln('end external;')
|
||||
wr.Wln('end external;');
|
||||
end;
|
||||
|
||||
procedure TCodeConvertor.WriteObjCProtocol(cent:TObjCProtocol);
|
||||
@ -738,19 +754,24 @@ var
|
||||
i : Integer;
|
||||
begin
|
||||
SetPasSection(wr, 'type');
|
||||
wr.W(cent.Name+'Protocol = objcprotocol');
|
||||
if cent.Names.Count=1 then begin
|
||||
wr.W(cent.Names[0]+'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(')');
|
||||
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;
|
||||
WriteObjCMethods(cent.Methods);
|
||||
wr.DecIdent;
|
||||
wr.W('end; ');
|
||||
wr.Wln(' external name '''+cent.Names[0]+''';');
|
||||
end else begin
|
||||
for i:=0 to cent.Names.Count-1 do
|
||||
wr.Wln(cent.Names[i]+'Protocol = objcprotocol; external name '''+cent.Names[i]+''';');
|
||||
end;
|
||||
wr.IncIdent;
|
||||
WriteObjCMethods(cent.Methods);
|
||||
wr.DecIdent;
|
||||
wr.W('end; ');
|
||||
wr.Wln(' external name '''+cent.Name+''';');
|
||||
end;
|
||||
|
||||
procedure TCodeConvertor.PushWriter;
|
||||
@ -808,14 +829,25 @@ end;
|
||||
procedure TCodeConvertor.WriteLnCommentForOffset(AOffset:Integer; NeedOffset: Boolean);
|
||||
var
|
||||
cmt : TComment;
|
||||
ln : Integer;
|
||||
c : Integer;
|
||||
i : Integer;
|
||||
begin
|
||||
cmt:=FindCommentForLine( Breaker.LineNumber(AOffset));
|
||||
if Assigned(cmt) then begin
|
||||
LastOffset:=cmt.Offset;
|
||||
if NeedOffset then wr.W(' ');
|
||||
WriteCommentToPas(cmt);
|
||||
end else
|
||||
wr.Wln;
|
||||
ln:= Breaker.LineNumber(AOffset);
|
||||
c:=0;
|
||||
for i:=0 to CmtList.Count-1 do begin
|
||||
cmt:=TComment(CmtList[i]);
|
||||
if Breaker.LineNumber(TComment(CmtList[i]).Offset)=ln then begin
|
||||
if NeedOffset then begin
|
||||
wr.W(' ');
|
||||
NeedOffset:=False;
|
||||
end;
|
||||
WriteCommentToPas(cmt, false);
|
||||
LastOffset:=cmt.Offset;
|
||||
inc(c);
|
||||
end;
|
||||
end;
|
||||
wr.Wln;
|
||||
end;
|
||||
|
||||
function TCodeConvertor.NextCommentBefore(AOffset:Integer):Integer;
|
||||
@ -1078,7 +1110,7 @@ begin
|
||||
wr.Wln(';');
|
||||
end;
|
||||
end else if cent is TComment then
|
||||
WriteCommentToPas(cent as TComment)
|
||||
WriteCommentToPas(cent as TComment, True)
|
||||
else if cent is TCPrepDefine then
|
||||
WritePreprocessor(cent as TCPrepDefine)
|
||||
else if cent is TObjCInterface then
|
||||
@ -1332,20 +1364,7 @@ begin
|
||||
wr.W(PasTypeName + ' = ');}
|
||||
wr.W('todo: '+TypeEntity.ClassName);
|
||||
end;
|
||||
//todo: ...
|
||||
end;
|
||||
|
||||
function TCodeConvertor.FindCommentForLine(ln:Integer):TComment;
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
Result:=nil;
|
||||
if not Assigned(CmtList) then Exit;
|
||||
for i:=0 to CmtList.Count-1 do
|
||||
if Breaker.LineNumber(TComment(CmtList[i]).Offset)=ln then begin
|
||||
Result:=TComment(CmtList[i]);
|
||||
Exit;
|
||||
end;
|
||||
//todo: ...parse any Entity
|
||||
end;
|
||||
|
||||
procedure TCodeConvertor.DefFuncWrite(wr:TCodeWriter;const FuncName,FuncRetType:AnsiString;
|
||||
|
@ -26,6 +26,9 @@ interface
|
||||
uses
|
||||
Classes, SysUtils, cparsertypes;
|
||||
|
||||
const
|
||||
objcend = '@end';
|
||||
|
||||
type
|
||||
|
||||
{ TObjCClasses }
|
||||
@ -54,6 +57,7 @@ type
|
||||
RetName : TNamePart;
|
||||
Args : array of TObjCMethodArg;
|
||||
Option : TObjCMethodOpt;
|
||||
VarParams : Boolean;
|
||||
constructor Create(AOffset: Integer=-1); override;
|
||||
destructor Destroy; override;
|
||||
procedure AddArg(const ArgType: TEntity; ArgTypeName: TNamePart; const Name: AnsiString);
|
||||
@ -88,7 +92,7 @@ type
|
||||
|
||||
TObjCProtocol = class(TEntity)
|
||||
public
|
||||
Name : AnsiString;
|
||||
Names : TStringList;
|
||||
isForward : Boolean;
|
||||
Protocols : TStringList;
|
||||
Methods : TList;
|
||||
@ -113,7 +117,7 @@ function ParseClassList(AParser: TTextParser): TObjCClasses;
|
||||
function ParseInterface(AParser: TTextParser): TObjCInterface;
|
||||
function ParseMethod(AParser: TTextParser): TObjCMethod;
|
||||
function ParseProperty(AParser: TTextParser): TObjCProperty;
|
||||
function ParseMethods(AParser: TTextParser; MethodsList: TList; const EndToken: AnsiString): Boolean;
|
||||
function ParseMethods(AParser: TTextParser; MethodsList: TList; const EndToken: AnsiString = objcend): Boolean;
|
||||
function ParseProtocol(AParser: TTextParser): TEntity;
|
||||
|
||||
function ParseNextObjCEntity(AParser: TTextParser): TEntity;
|
||||
@ -121,6 +125,9 @@ function ParseNextObjCEntity(AParser: TTextParser): TEntity;
|
||||
function isObjCKeyword(const token: AnsiString): Boolean; inline;
|
||||
function GetObjCKeyword(const token: AnsiString): AnsiString;
|
||||
|
||||
const
|
||||
nk_Protocol = $1000;
|
||||
|
||||
implementation
|
||||
|
||||
function isObjCKeyword(const token: AnsiString): Boolean; inline;
|
||||
@ -140,25 +147,30 @@ var
|
||||
begin
|
||||
Result:=nil;
|
||||
if AParser.Token<>'@class' then Exit;
|
||||
cl:=TObjCClasses.Create(AParser.TokenPos);
|
||||
AParser.NextToken;
|
||||
while AParser.Token<>';' do begin
|
||||
if AParser.TokenType<>tt_Ident then begin
|
||||
ErrorExpect(AParser,'identifier');
|
||||
cl.Free;
|
||||
Exit;
|
||||
end;
|
||||
cl.Classes.Add(AParser.Token);
|
||||
try
|
||||
cl:=TObjCClasses.Create(AParser.TokenPos);
|
||||
AParser.NextToken;
|
||||
if AParser.Token=',' then
|
||||
AParser.NextToken
|
||||
else if AParser.Token<>';' then begin
|
||||
ErrorExpect(AParser,';');
|
||||
cl.Free;
|
||||
Exit;
|
||||
while AParser.Token<>';' do begin
|
||||
if AParser.TokenType<>tt_Ident then begin
|
||||
ErrorExpect(AParser,'identifier');
|
||||
cl.Free;
|
||||
Exit;
|
||||
end;
|
||||
cl.Classes.Add(AParser.Token);
|
||||
AParser.NextToken;
|
||||
if AParser.Token=',' then
|
||||
AParser.NextToken
|
||||
else if AParser.Token<>';' then begin
|
||||
ErrorExpect(AParser,';');
|
||||
cl.Free;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
if AParser.Token<>';' then ErrorExpect(AParser, ';');
|
||||
Result:=cl;
|
||||
finally
|
||||
if not Assigned(Result) then cl.Free;
|
||||
end;
|
||||
Result:=cl;
|
||||
end;
|
||||
|
||||
function ParseInstVars(AParser: TTextParser; Vars: TList): Boolean;
|
||||
@ -217,14 +229,14 @@ begin
|
||||
|
||||
itf:=TObjCInterface.Create(i);
|
||||
try
|
||||
itf.Name:=nm;
|
||||
itf.isCategory:=AParser.Token='(';
|
||||
if itf.isCategory then begin
|
||||
AParser.NextToken;
|
||||
if not ConsumeIdentifier(AParser, itf.SuperClass) and ConsumeToken(AParser, ')') then
|
||||
itf.SuperClass:=nm;
|
||||
AParser.NextToken;
|
||||
if not (ConsumeIdentifier(AParser, itf.Name) and ConsumeToken(AParser, ')')) then
|
||||
Exit;
|
||||
end else begin
|
||||
|
||||
itf.Name:=nm;
|
||||
// super-class
|
||||
if AParser.Token=':' then begin
|
||||
AParser.NextToken;
|
||||
@ -249,8 +261,8 @@ begin
|
||||
ParseInstVars(AParser, itf.Vars);
|
||||
end;
|
||||
|
||||
if not ParseMethods(AParser, itf.Methods, '@end') then Exit;
|
||||
if AParser.Token='@end' then AParser.NextToken;
|
||||
if not ParseMethods(AParser, itf.Methods, objcend) then Exit;
|
||||
if AParser.Token<>objcend then ErrorExpect(AParser, objcend);
|
||||
|
||||
Result:=itf;
|
||||
finally
|
||||
@ -268,11 +280,17 @@ begin
|
||||
p := TObjCProtocol.Create(AParser.TokenPos);
|
||||
try
|
||||
AParser.NextToken;
|
||||
if not ConsumeIdentifier(AParser, p.Name) then Exit;
|
||||
p.isForward:= AParser.Token=';';
|
||||
if not ConsumeIdentifier(AParser, nm) then Exit;
|
||||
p.Names.Add(nm);
|
||||
p.isForward:= (AParser.Token=';') or (AParser.Token=',');
|
||||
if p.isForward then begin
|
||||
while AParser.Token<>';' do begin
|
||||
AParser.NextToken;
|
||||
ConsumeIdentifier(AParser, nm);
|
||||
p.Names.Add(nm);
|
||||
end;
|
||||
Result:=p;
|
||||
AParser.NextToken;
|
||||
if AParser.Token<>';' then ErrorExpect(AParser, ';');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
@ -286,8 +304,8 @@ begin
|
||||
if AParser.Token='>' then AParser.NextToken;
|
||||
end;
|
||||
|
||||
if ParseMethods(AParser, p.Methods, '@end') then Result:=p;
|
||||
if AParser.Token='@end' then AParser.NextToken;
|
||||
if ParseMethods(AParser, p.Methods, objcend) then Result:=p;
|
||||
if AParser.Token<>objcend then ErrorExpect(AParser, objcend);
|
||||
finally
|
||||
if not Assigned(Result) then p.Free;
|
||||
end;
|
||||
@ -295,6 +313,7 @@ end;
|
||||
|
||||
var
|
||||
PrevParseNextEntity : function (AParser: TTextParser): TEntity = nil;
|
||||
PrevNamePart : function (AParser: TTextParser): TNamePart = nil;
|
||||
|
||||
function ParseNextObjCEntity(AParser: TTextParser): TEntity;
|
||||
var
|
||||
@ -377,25 +396,36 @@ begin
|
||||
m.Name.Add(nm+':');
|
||||
AParser.NextToken;
|
||||
|
||||
while AParser.Token<>';' do begin
|
||||
prm:=ConsumeToken(AParser, '(') and
|
||||
ParseName(APArser, atype, atname) and
|
||||
ConsumeToken(AParser, ')') and
|
||||
ConsumeIdentifier(AParser, aname);
|
||||
while (AParser.Token<>';') and (AParser.Token<>',') do begin
|
||||
if AParser.Token='(' then begin
|
||||
prm:=ConsumeToken(AParser, '(') and
|
||||
ParseName(APArser, atype, atname) and
|
||||
ConsumeToken(AParser, ')');
|
||||
end else begin
|
||||
prm:=True;
|
||||
atype:=nil;
|
||||
atname:=nil;
|
||||
end;
|
||||
if not prm then Exit;
|
||||
ConsumeIdentifier(AParser, aname);
|
||||
m.AddArg(atype, atname, aname);
|
||||
|
||||
// the next name starts
|
||||
if AParser.TokenType=tt_Ident then ConsumeIdentifier(AParser, nm) else nm:='';
|
||||
if AParser.Token<>';' then begin
|
||||
if (AParser.Token<>';') and (AParser.Token<>',') then begin
|
||||
if not ConsumeToken(AParser,':') then Exit;
|
||||
m.Name.Add(nm+':');
|
||||
end;
|
||||
end;
|
||||
AParser.NextToken;
|
||||
end else begin
|
||||
end else
|
||||
m.Name.Add(nm);
|
||||
if not ConsumeToken(AParser, ';') then Exit;
|
||||
|
||||
if AParser.Token=',' then begin
|
||||
AParser.NextToken;
|
||||
if ConsumeToken(AParser,'...') then m.VarParams:=True
|
||||
else ErrorExpect(AParser, '...');
|
||||
end;
|
||||
if not ConsumeToken(AParser, ';') then Exit;
|
||||
|
||||
Result:=m;
|
||||
finally
|
||||
@ -403,7 +433,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function ParseMethods(AParser: TTextParser; MethodsList: TList; const EndToken: AnsiString = '@end'): Boolean;
|
||||
function ParseMethods(AParser: TTextParser; MethodsList: TList; const EndToken: AnsiString): Boolean;
|
||||
var
|
||||
m : TObjCMethod;
|
||||
p : TObjCProperty;
|
||||
@ -484,6 +514,7 @@ begin
|
||||
inherited Create(AOffset);
|
||||
Protocols := TStringList.Create;
|
||||
Methods := TList.Create;
|
||||
Names := TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TObjCProtocol.Destroy;
|
||||
@ -493,6 +524,7 @@ begin
|
||||
for i:=0 to Methods.Count-1 do TObject(Methods[i]).Free;
|
||||
Methods.Free;
|
||||
Protocols.Free;
|
||||
Names.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -521,7 +553,7 @@ begin
|
||||
Result:=nil;
|
||||
if AParser.Token<>'@property' then Exit;
|
||||
AParser.NextToken;
|
||||
p := TObjCProperty.Create;
|
||||
p := TObjCProperty.Create(AParser.TokenPos);
|
||||
try
|
||||
if AParser.Token='(' then begin
|
||||
AParser.NextToken;
|
||||
@ -556,9 +588,25 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function ParseObjCNamePart(AParser: TTextParser): TNamePart;
|
||||
var
|
||||
p : AnsiString;
|
||||
begin
|
||||
// skipping protocol adopted type definition
|
||||
if AParser.Token='<' then begin
|
||||
Result:=nil;
|
||||
AParser.NextToken;
|
||||
if not (ConsumeIdentifier(AParser, p) and ConsumeToken(AParser,'>')) then Exit;
|
||||
end;
|
||||
Result:=PrevNamePart(AParser);
|
||||
end;
|
||||
|
||||
initialization
|
||||
PrevParseNextEntity:=ParseNextEntity;
|
||||
ParseNextEntity:=ParseNextObjCEntity;
|
||||
|
||||
PrevNamePart:=ParseNamePart;
|
||||
ParseNamePart:=ParseObjCNamePart;
|
||||
|
||||
end.
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user