chelper: added parsing for objc2.0 properties

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1286 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/chelper/ctopasconvert.pas

@@ -145,6 +145,7 @@ type
 
     function GetPasObjCMethodName(names: TStrings): AnsiString;
     procedure WriteObjCMethod(m: TObjCMethod);
+    procedure WriteObjCMethods(list: TList);
     procedure WriteObjCInterface(cent: TObjCInterface);
     procedure WriteObjCProtocol(cent: TObjCProtocol);
 
@@ -632,6 +633,22 @@ begin
   wr.W(''';');
 end;
 
+procedure TCodeConvertor.WriteObjCMethods(list:TList);
+var
+  ent : TEntity;
+  i   : Integer;
+begin
+  if not Assigned(list) or (list.Count=0) then Exit;
+  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));
+    WriteLnCommentForOffset(ent.Offset);
+  end;
+end;
+
 procedure TCodeConvertor.WriteObjCInterface(cent:TObjCInterface);
 var
   i     : Integer;
@@ -675,7 +692,8 @@ begin
   if cent.Methods.Count>0 then begin
     wr.Wln('public');
     wr.IncIdent;
-    for i:=0 to cent.Methods.Count-1 do begin
+    for i:=0 to cent.Methods.Count-1 do
+      if TObject(cent.Methods[i]) is TObjCMethod then begin
         m:=TObjCMethod(cent.Methods[i]);
         WriteLnCommentsBeforeOffset(m.Offset);
         WriteObjCMethod(m);
@@ -689,7 +707,6 @@ end;
 procedure TCodeConvertor.WriteObjCProtocol(cent:TObjCProtocol);
 var
   i : Integer;
-  m : TObjCMethod;
 begin
   SetPasSection(wr, 'type');
   wr.W(cent.Name+'Protocol = objcprotocol');
@@ -701,12 +718,7 @@ begin
     wr.Wln(')');
   end;
   wr.IncIdent;
-  for i:=0 to cent.Methods.Count-1 do begin
+  WriteObjCMethods(cent.Methods);
-    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+''';');

components/chelper/objcparsing.pas

@@ -96,10 +96,23 @@ type
     destructor Destroy; override;
   end;
 
+  { TObjCProperty }
+
+  TObjCProperty = class(TEntity)
+  public
+    Name        : TNamePart;
+    RetType     : TEntity;
+    SetterName  : AnsiString;
+    GetterName  : AnsiString;
+    Props       : TStringList;
+    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 ParseProperty(AParser: TTextParser): TObjCProperty;
 function ParseMethods(AParser: TTextParser; MethodsList: TList; const EndToken: AnsiString): Boolean;
 function ParseProtocol(AParser: TTextParser): TEntity;
 
@@ -393,17 +406,24 @@ end;
 function ParseMethods(AParser: TTextParser; MethodsList: TList; const EndToken: AnsiString = '@end'): Boolean;
 var
   m   : TObjCMethod;
+  p   : TObjCProperty;
   opt : TObjCMethodOpt;
+  s   : AnsiString;
 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
+  while (AParser.Token<>EndToken) and (AParser.Token<>'') and (AParser.Token[1] in ['+','-','@']) do begin
     if isObjCKeyword(AParser.Token) then begin
-      if GetObjCKeyword(AParser.Token)='optional'
+      s:=GetObjCKeyword(AParser.Token);
-        then opt:=mo_Optional
+      if s='property' then begin
+        p:=ParseProperty(AParser);
+        MethodsList.Add(p);
+      end else begin
+        if s='optional' then opt:=mo_Optional
         else opt:=mo_Required;
-      AParser.NextToken
+        AParser.NextToken;
+      end;
     end else begin
       m:=ParseMethod(AParser);
       if not Assigned(m) then Exit;
@@ -476,6 +496,66 @@ begin
   inherited Destroy;
 end;
 
+{ TObjCProperty }
+
+constructor TObjCProperty.Create(AOffset:Integer);
+begin
+  inherited Create(AOffset);
+  Props:=TStringList.Create;
+end;
+
+destructor TObjCProperty.Destroy;
+begin
+  RetType.Free;
+  Name.Free;
+  Props.Free;
+  inherited Destroy;
+end;
+
+function ParseProperty(AParser: TTextParser): TObjCProperty;
+var
+  p   : TObjCProperty;
+  s   : AnsiString;
+  nm  : AnsiString;
+begin
+  Result:=nil;
+  if AParser.Token<>'@property' then Exit;
+  AParser.NextToken;
+  p := TObjCProperty.Create;
+  try
+    if AParser.Token='(' then begin
+      AParser.NextToken;
+      while AParser.Token<>')' do begin
+        s:=AParser.Token;
+        if (s='setter') or (s='getter') then begin
+          AParser.NextToken;
+          if not ConsumeToken(AParser, '=') and not ConsumeIdentifier(AParser, nm) then Exit;
+          if s='setter' then p.SetterName:=nm
+          else p.GetterName:=nm;
+        end else begin
+          p.Props.Add(nm);
+          AParser.NextToken;
+        end;
+        if AParser.Token=',' then AParser.NextToken;
+      end;
+      if AParser.Token=')' then
+        AParser.NextToken
+      else begin
+        ErrorExpect(AParser,')');
+        Exit;
+      end;
+      if ParseName(AParser, p.RetType, p.Name) then begin
+        Result:=p;
+        if APArser.Token=';' then AParser.NextToken;
+      end;
+
+    end;
+
+  finally
+    if not Assigned(Result) then p.Free;
+  end;
+end;
+
 initialization
   PrevParseNextEntity:=ParseNextEntity;
   ParseNextEntity:=ParseNextObjCEntity;