diff --git a/components/chelper/cconvert.lpi b/components/chelper/cconvert.lpi
index 532cd8c58..6ad4e6435 100644
--- a/components/chelper/cconvert.lpi
+++ b/components/chelper/cconvert.lpi
@@ -31,12 +31,17 @@
-
+
+
+
+
+
+
diff --git a/components/chelper/cconvert.lpr b/components/chelper/cconvert.lpr
index 2affa914e..26c8ab4bf 100644
--- a/components/chelper/cconvert.lpr
+++ b/components/chelper/cconvert.lpr
@@ -22,7 +22,8 @@ program cconvert;
uses
SysUtils,Classes,
- ctopasconvert,cparserutils,cconvconfig;
+ ctopasconvert,cparsertypes,cparserutils,cconvconfig, objcparsing,
+ objctopasconvert;
var
ConfigFile : AnsiString = '';
diff --git a/components/chelper/cparsertypes.pas b/components/chelper/cparsertypes.pas
index d7d64afb7..b6d330ff9 100755
--- a/components/chelper/cparsertypes.pas
+++ b/components/chelper/cparsertypes.pas
@@ -20,12 +20,7 @@ unit cparsertypes;
interface
-{$ifdef fpc}{$mode delphi}{$h+}
-{$else}
-{$warn unsafe_code off}
-{$warn unsafe_type off}
-{$warn unsafe_cast off}
-{$endif}
+{$ifdef fpc}{$mode delphi}{$h+}{$endif}
uses
Classes, SysUtils, TextParsingUtils;
@@ -232,7 +227,11 @@ type
end;
// parsing function
-function ParseNextEntity(AParser: TTextParser): TEntity;
+var
+ ParseNextEntity: function (AParser: TTextParser): TEntity = nil;
+
+function ParseNextCEntity(AParser: TTextParser): TEntity;
+
function ParseCExpression(AParser: TTextParser; var ExpS: AnsiString): Boolean;
procedure ParseCNumeric(const S: AnsiString; var idx: integer; var NumStr: AnsiSTring);
function ParseCString(const S: AnsiString; var idx: Integer; var CStr: AnsiString): Boolean;
@@ -280,6 +279,7 @@ type
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;
@@ -1455,7 +1455,7 @@ begin
end;
-function ParseNextEntity(AParser: TTextParser): TEntity;
+function ParseNextCEntity(AParser: TTextParser): TEntity;
var
s : AnsiString;
tt : TTokenType;
@@ -1465,7 +1465,7 @@ var
v : TVarFuncEntity;
begin
Result := nil;
- if not AParser.FindNextToken(s, tt) then Exit;
+ s:=AParser.Token;
if s = 'typedef' then begin
Result:=ParseTypeDef(AParser);
@@ -1507,6 +1507,16 @@ begin
else Parser.SetError('Token expected: '+Token);
end;
+function ConsumeIdentifier(Parser: TTextParser; var Id: AnsiString): Boolean;
+begin
+ Result:=Parser.TokenType=tt_Ident;
+ if Result then begin
+ id:=Parser.Token;
+ Parser.NextToken;
+ end else
+ Parser.SetError('Identifier expected');
+end;
+
function ParseCType(Parser: TTextParser): TEntity;
var
simple : TSimpleType;
@@ -2011,4 +2021,8 @@ begin
inherited Destroy;
end;
+initialization
+ ParseNextEntity:=@ParseNextCEntity;
+
+
end.
diff --git a/components/chelper/ctopasconvert.pas b/components/chelper/ctopasconvert.pas
index b8bc83895..5c19e6698 100644
--- a/components/chelper/ctopasconvert.pas
+++ b/components/chelper/ctopasconvert.pas
@@ -18,13 +18,15 @@
}
unit ctopasconvert;
+
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
- cparsertypes, TextParsingUtils, codewriter, cparserutils;
+ cparsertypes, TextParsingUtils, codewriter, cparserutils,
+ objcparsing;
type
@@ -140,6 +142,10 @@ type
procedure WriteExp(x: TExpression);
procedure WritePreprocessor(cent: TCPrepDefine);
+ function GetObjCMethodName(names: TStrings): AnsiString;
+ procedure WriteObjCMethod(m: TObjCMethod);
+ procedure WriteObjCInterface(cent: TObjCInterface);
+
procedure PushWriter;
procedure PopWriter;
public
@@ -279,6 +285,8 @@ begin
AParser.OnPrecompile:=@cmt.OnPrecompiler;
Result:=nil;
+ AParser.NextToken;
+
ent := ParseNextEntity(AParser);
entidx:=AParser.Index;
@@ -582,6 +590,75 @@ begin
end;
end;
+function TCodeConvertor.GetObjCMethodName(names:TStrings):AnsiString;
+var
+ i : Integer;
+begin
+ Result:='';
+ for i:=0 to names.Count-1 do Result:=Result+names[i];
+ for i:=1 to length(Result) do if Result[i]=':' then Result[i]:='_';
+end;
+
+procedure TCodeConvertor.WriteObjCMethod(m: TObjCMethod);
+var
+ ret : AnsiString;
+ i : INteger;
+begin
+ if m.RetType=nil then ret:='id' else ret:=GetPasTypeName(m.RetType, m.RetName);
+ if ret='' then wr.W('procedure ')
+ else wr.W('function ');
+ wr.W( GetObjCMethodName(m.Name) );
+
+ if length(m.Args)>0 then begin
+ wr.W('(');
+ for i:=0 to length(m.Args)-1 do begin
+ if m.Args[i].Name='' then wr.W(cfg.ParamPrefix+IntToStr(i))
+ else wr.W(m.Args[i].Name);
+ wr.W(': ');
+ wr.W(GetPasTypeName(m.Args[i].RetType, m.Args[i].TypeName));
+ if i'' then wr.W(': '+ ret);
+ wr.W(';');
+
+ wr.W(' message ''');
+ for i:=0 to m.Name.Count-1 do wr.W(m.Name[i]);
+ wr.Wln(''';');
+end;
+
+procedure TCodeConvertor.WriteObjCInterface(cent:TObjCInterface);
+var
+ i : Integer;
+ m : TObjCMethod;
+begin
+ SetPasSection(wr, 'type');
+ if cent.isCategory then begin
+ wr.W(cent.Name + ' = objccategory')
+ end else begin
+ wr.W(cent.Name + ' = objcclass');
+ if cent.SuperClass<>'' then wr.W('('+cent.SuperClass);
+ if cent.Protocols.Count>0 then begin
+ if cent.SuperClass='' then wr.W('(id, ')
+ else wr.W(', ');
+ for i:=0 to cent.Protocols.Count-2 do wr.W(cent.Protocols[i]+', ');
+ wr.W(cent.Protocols[cent.Protocols.Count-1]);
+ end;
+ if (cent.SuperClass<>'') or (cent.Protocols.Count>0) then wr.Wln(')');
+ end;
+
+ wr.Wln('public');
+ wr.IncIdent;
+ for i:=0 to cent.Methods.Count-1 do begin
+ m:=TObjCMethod(cent.Methods[i]);
+ WriteObjCMethod(m)
+ end;
+ wr.DecIdent;
+ wr.Wln('end;')
+end;
+
procedure TCodeConvertor.PushWriter;
begin
if not Assigned(fWriters) then fWriters:=TList.Create;
@@ -900,6 +977,8 @@ begin
WriteCommentToPas(cent as TComment)
else if cent is TCPrepDefine then
WritePreprocessor(cent as TCPrepDefine)
+ else if cent is TObjCInterface then
+ WriteObjCInterface(cent as TObjCInterface)
else begin
if DebugEntities then
wr.Wln(cent.ClassName);
diff --git a/components/chelper/objcparsing.pas b/components/chelper/objcparsing.pas
new file mode 100644
index 000000000..741658d43
--- /dev/null
+++ b/components/chelper/objcparsing.pas
@@ -0,0 +1,396 @@
+unit
+ objcparsing;
+
+interface
+
+{$ifdef fpc}{$mode delphi}{$h+}{$endif}
+
+uses
+ Classes, SysUtils, cparsertypes;
+
+type
+
+ { TObjCClasses }
+
+ TObjCClasses = class(TEntity)
+ Classes : TStringList;
+ constructor Create(AOffset: Integer=-1); override;
+ destructor Destroy; override;
+ end;
+
+ { TObjCMethod }
+
+ TObjCMethodArg = record
+ RetType : TEntity;
+ TypeName : TNamePart;
+ Name : AnsiString;
+ end;
+
+ TObjCMethod = class(TEntity)
+ public
+ isClassMethod : Boolean;
+ Name : TStringList;
+ RetType : TEntity;
+ RetName : TNamePart;
+ Args : array of TObjCMethodArg;
+ constructor Create(AOffset: Integer=-1); override;
+ destructor Destroy; override;
+ procedure AddArg(const ArgType: TEntity; ArgTypeName: TNamePart; const Name: AnsiString);
+ end;
+
+ { TObjCInterface }
+
+ TObjCInterface = class(TEntity)
+ public
+ Name : AnsiString;
+ SuperClass : AnsiString;
+ isCategory : Boolean;
+ Protocols : TStringList;
+ ProtVars : TList;
+ PrivVars : TList;
+ PubVars : TList;
+ PackVars : TList;
+ 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 ParseNextObjCEntity(AParser: TTextParser): TEntity;
+
+function isObjCKeyword(const token: AnsiString): Boolean; inline;
+function GetObjCKeyword(const token: AnsiString): AnsiString;
+
+implementation
+
+function isObjCKeyword(const token: AnsiString): Boolean; inline;
+begin
+ Result:=(token<>'') and (token[1]='@');
+end;
+
+function GetObjCKeyword(const token: AnsiString): AnsiString;
+begin
+ if isObjCKeyword(token) then Result:=Copy(token, 2, length(token)-1)
+ else Result:=token;
+end;
+
+function ParseClassList(AParser: TTextParser): TObjCClasses;
+var
+ cl : TObjCClasses;
+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);
+ AParser.NextToken;
+ if AParser.Token=',' then
+ AParser.NextToken
+ else if AParser.Token<>';' then begin
+ ErrorExpect(AParser,';');
+ cl.Free;
+ Exit;
+ end;
+ end;
+ Result:=cl;
+end;
+
+function ParseInstVars(AParser: TTextParser; itf: TObjCInterface): Boolean;
+var
+ vars : TList;
+ v : TVarFuncEntity;
+ s : AnsiString;
+begin
+ Result:=True;
+ if AParser.Token<>'{' then Exit;
+
+ Result:=False;
+ AParser.NextToken;
+ vars:=itf.ProtVars;
+
+ while AParser.Token<>'}' do begin
+ if isObjCKeyword(AParser.Token) then begin
+ s:=GetObjCKeyword(APArser.Token);
+ if s='protected' then vars:=itf.ProtVars
+ else if s='private' then vars:=itf.PrivVars
+ else if s='public' then vars:=itf.PubVars
+ else if s='package' then vars:=itf.PackVars
+ else begin
+ ErrorExpect(AParser,'}');
+ Exit;
+ end;
+ AParser.NextToken;
+ end else begin
+ v:=TVarFuncEntity.Create(APArser.TokenPos);
+ if not ParseNames(AParser, v.RetType, v.Names) then Exit;
+ vars.Add(v);
+ if AParser.Token=';' then
+ AParser.NextToken;
+ end;
+ end;
+ AParser.NextToken;
+
+ Result:=True;
+end;
+
+function ParseInterface(AParser: TTextParser): TObjCInterface;
+var
+ itf : TObjCInterface;
+ i : Integer;
+ nm : AnsiString;
+begin
+ Result:=nil;
+ if AParser.Token<>'@interface' then Exit;
+ i:=AParser.TokenPos;
+ AParser.NextToken;
+
+ if not ConsumeIdentifier(AParser, nm) then Exit;
+
+ 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
+ Exit;
+ end else begin
+
+ // super-class
+ if AParser.Token=':' then begin
+ AParser.NextToken;
+ if not ConsumeIdentifier(AParser, itf.SuperClass) then Exit;
+ //writeln('SuperClass = ', itf.SuperClass);
+ end;
+
+ // protocols
+ if AParser.Token='<' then 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
+ ErrorExpect(AParser, '>');
+ Exit;
+ end;
+ end;
+ AParser.NextToken;
+ end;
+
+ //writeln('parsing vars1 ', AParser.Token);
+ ParseInstVars(AParser, itf);
+ //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;
+ finally
+ if not Assigned(Result) then itf.Free;
+ end;
+end;
+
+function ParserProtocol(AParser: TTextParser): TEntity;
+begin
+ Result:=nil;
+end;
+
+var
+ PrevParseNextEntity : function (AParser: TTextParser): TEntity = nil;
+
+function ParseNextObjCEntity(AParser: TTextParser): TEntity;
+var
+ t : AnsiString;
+begin
+ if AParser.Token[1]='@' then 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);
+ end else begin
+ if Assigned(PrevParseNextEntity) then
+ Result:=PrevParseNextEntity(AParser)
+ else
+ Result:=nil;
+ end;
+end;
+
+{ TObjCClasses }
+
+constructor TObjCClasses.Create(AOffset:Integer);
+begin
+ inherited Create(AOffset);
+ Classes := TStringList.Create;
+end;
+
+destructor TObjCClasses.Destroy;
+begin
+ Classes.Free;
+ inherited Destroy;
+end;
+
+{ TObjCInterface }
+
+constructor TObjCInterface.Create(AOffset:Integer);
+begin
+ ProtVars := TList.Create;
+ PrivVars := TList.Create;
+ PubVars := TList.Create;
+ PackVars := TList.Create;
+ Methods := TList.Create;
+ Protocols := TStringList.Create;
+ inherited Create(AOffset);
+end;
+
+destructor TObjCInterface.Destroy;
+var
+ i : Integer;
+begin
+ for i:=0 to ProtVars.Count-1 do TObject(ProtVars[i]).Free;
+ for i:=0 to PrivVars.Count-1 do TObject(PrivVars[i]).Free;
+ for i:=0 to PubVars.Count-1 do TObject(PubVars[i]).Free;
+ for i:=0 to PackVars.Count-1 do TObject(PubVars[i]).Free;
+ PrivVars.Free;
+ PubVars.Free;
+ ProtVars.Free;
+ PackVars.Free;
+
+ for i:=0 to Methods.Count-1 do TObject(Methods[i]).Free;
+ Methods.Free;
+
+ Protocols.Free;
+ inherited Destroy;
+end;
+
+function ParseMethod(AParser: TTextParser): TObjCMethod;
+var
+ m : TObjCMethod;
+ nm : AnsiString;
+ atype : TEntity;
+ atname : TNamePart;
+ aname : Ansistring;
+ prm : Boolean;
+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
+ ConsumeToken(AParser, ')') and
+ ConsumeIdentifier(AParser, aname);
+ if not prm then Exit;
+ m.AddArg(atype, atname, aname);
+
+ if AParser.TokenType=tt_Ident then ConsumeIdentifier(AParser, nm) else nm:='';
+ if AParser.Token<>';' then begin
+ if not ConsumeToken(AParser,':') then Exit;
+ m.Name.Add(nm+':');
+ end;
+ end;
+ AParser.NextToken;
+ end else begin
+ m.Name.Add(nm);
+ if not ConsumeToken(AParser, ';') then Exit;
+ end;
+
+ //writeln('in method5: ', AParser.Token);
+ Result:=m;
+ finally
+ if not Assigned(Result) then m.Free;
+ end;
+end;
+
+function ParseMethods(AParser: TTextParser; MethodsList: TList; const EndToken: AnsiString = '@end'): Boolean;
+var
+ m : TObjCMethod;
+begin
+ Result:=False;
+ if not Assigned(MethodsList) or not Assigned(AParser) then Exit;
+ 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);
+ end;
+ Result:=True;
+end;
+
+{ TObjCMethod }
+
+constructor TObjCMethod.Create(AOffset:Integer);
+begin
+ inherited Create(AOffset);
+ Name := TStringList.Create;
+ RetType := TVarFuncEntity.Create;
+end;
+
+destructor TObjCMethod.Destroy;
+var
+ i : Integer;
+begin
+ Name.Free;
+ RetType.Free;
+ RetName.Free;
+ for i:=0 to length(Args)-1 do begin
+ Args[i].RetType.Free;
+ Args[i].TypeName.Free;
+ end;
+ inherited Destroy;
+end;
+
+procedure TObjCMethod.AddArg(const ArgType:TEntity;ArgTypeName:TNamePart;const Name:AnsiString);
+var
+ i : Integer;
+begin
+ i:=length(Args);
+ SetLength(Args, i+1);
+ Args[i].Name:=Name;
+ Args[i].RetType:=ArgType;
+ Args[i].TypeName:=ArgTypeName;
+end;
+
+initialization
+ PrevParseNextEntity:=ParseNextEntity;
+ ParseNextEntity:=ParseNextObjCEntity;
+
+end.
+