chelper: improved objc interface parsing and code generation

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

components/chelper/ctopasconvert.pas

@@ -18,7 +18,6 @@
 }
 unit ctopasconvert;
 
-
 {$mode objfpc}{$H+}
 
 interface
@@ -50,6 +49,8 @@ type
 
     CustomDefines     : AnsiString;
 
+    // obj-c
+    RemoveLastUnderscores : Boolean;
 
     constructor Create;
     destructor Destroy; override;
@@ -142,7 +143,7 @@ type
     procedure WriteExp(x: TExpression);
     procedure WritePreprocessor(cent: TCPrepDefine);
 
-    function GetObjCMethodName(names: TStrings): AnsiString;
+    function GetPasObjCMethodName(names: TStrings): AnsiString;
     procedure WriteObjCMethod(m: TObjCMethod);
     procedure WriteObjCInterface(cent: TObjCInterface);
 
@@ -590,40 +591,40 @@ begin
   end;
 end;
 
-function TCodeConvertor.GetObjCMethodName(names:TStrings):AnsiString;
+function TCodeConvertor.GetPasObjCMethodName(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]:='_';
+  if cfg.RemoveLastUnderscores then begin
+    i:=length(Result);
+    while (i>0) and (Result[i]='_') do dec(i);
+    Result:=Copy(Result, 1, i);
+  end;
 end;
 
 procedure TCodeConvertor.WriteObjCMethod(m: TObjCMethod);
 var
-  ret : AnsiString;
+  ret     : AnsiString;
-  i   : INteger;
+  i       : Integer;
+  PNames  : array of AnsiString;
+  PTypes  : array of AnsiString;
 begin
   if m.RetType=nil then ret:='id' else ret:=GetPasTypeName(m.RetType, m.RetName);
-  if ret='' then wr.W('procedure ')
+  SetLength(PNames, length(m.Args));
-  else wr.W('function ');
+  SetLength(PTypes, length(m.Args));
-  wr.W( GetObjCMethodName(m.Name) );
+  if length(m.Args)>0 then
-
-  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))
+      if m.Args[i].Name=''
-      else wr.W(m.Args[i].Name);
+        then PNames[i]:=cfg.ParamPrefix+IntToStr(i)
-      wr.W(': ');
+        else PNames[i]:=m.Args[i].Name;
-      wr.W(GetPasTypeName(m.Args[i].RetType, m.Args[i].TypeName));
+      PTypes[i]:=GetPasTypeName(m.Args[i].RetType, m.Args[i].TypeName);
-      if i<length(m.Args)-1 then wr.W('; ');
     end;
-    wr.W(')');
-  end;
 
-  if ret<>'' then wr.W(': '+ ret);
+  DefFuncWrite(wr, GetPasObjCMethodName(m.Name), ret, PNames, PTypes);
   wr.W(';');
-
   wr.W(' message ''');
   for i:=0 to m.Name.Count-1 do wr.W(m.Name[i]);
   wr.Wln(''';');
@@ -633,6 +634,11 @@ procedure TCodeConvertor.WriteObjCInterface(cent:TObjCInterface);
 var
   i     : Integer;
   m     : TObjCMethod;
+  sc    : TObjCScope;
+  v     : TObjCInstVar;
+  sect  : AnsiString;
+const
+  sectname : array [TObjCScope] of AnsiString = ('private', 'protected', 'public', 'protected');
 begin
   SetPasSection(wr, 'type');
   if cent.isCategory then begin
@@ -647,16 +653,33 @@ begin
       wr.W(cent.Protocols[cent.Protocols.Count-1]);
     end;
     if (cent.SuperClass<>'') or (cent.Protocols.Count>0) then wr.Wln(')');
+
+    sect:='';
+    sc:=os_Public;
+    for i:=0 to cent.Vars.Count-1 do begin
+      v:=TObjCInstVar(cent.Vars[i]);
+      if (sect='') or (v.scope<>sc) then begin
+        if sect<>'' then wr.DecIdent;
+        sc:=v.scope;
+        sect:=sectname[sc];
+        wr.Wln(sect);
+        wr.IncIdent;
+      end;
+      WriteFuncOrVar(v.v, false, true);
+    end;
+    if sect<>'' then wr.DecIdent;
   end;
 
-  wr.Wln('public');
+  if cent.Methods.Count>0 then begin
-  wr.IncIdent;
+    wr.Wln('public');
-  for i:=0 to cent.Methods.Count-1 do begin
+    wr.IncIdent;
-    m:=TObjCMethod(cent.Methods[i]);
+    for i:=0 to cent.Methods.Count-1 do begin
-    WriteObjCMethod(m)
+      m:=TObjCMethod(cent.Methods[i]);
+      WriteObjCMethod(m)
+    end;
+    wr.DecIdent;
+    wr.Wln('end;')
   end;
-  wr.DecIdent;
-  wr.Wln('end;')
 end;
 
 procedure TCodeConvertor.PushWriter;

components/chelper/objcparsing.pas

@@ -1,3 +1,21 @@
+{ The unit is part of Lazarus Chelper package
+
+  Copyright (C) 2010 Dmitry Boyarintsev skalogryz dot lists at gmail.com
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
 unit
   objcparsing;
 
@@ -38,6 +56,17 @@ type
     procedure AddArg(const ArgType: TEntity; ArgTypeName: TNamePart; const Name: AnsiString);
   end;
 
+  TObjCScope = (os_Private, os_Protected, os_Public, os_Package);
+
+  { TObjCInstVar }
+
+  TObjCInstVar = class(TEntity)
+  public
+    scope  : TObjCScope;
+    v      : TVarFuncEntity;
+    destructor Destroy; override;
+  end;
+
   { TObjCInterface }
 
   TObjCInterface = class(TEntity)
@@ -46,10 +75,7 @@ type
     SuperClass  : AnsiString;
     isCategory  : Boolean;
     Protocols   : TStringList;
-    ProtVars    : TList;
+    Vars        : TList;
-    PrivVars    : TList;
-    PubVars     : TList;
-    PackVars    : TList;
     Methods     : TList;
     constructor Create(AOffset: Integer=-1); override;
     destructor Destroy; override;
@@ -106,37 +132,40 @@ begin
   Result:=cl;
 end;
 
-function ParseInstVars(AParser: TTextParser; itf: TObjCInterface): Boolean;
+function ParseInstVars(AParser: TTextParser; Vars: TList): Boolean;
 var
-  vars  : TList;
   v     : TVarFuncEntity;
+  iv    : TObjCInstVar;
   s     : AnsiString;
+  scope : TObjCScope;
 begin
   Result:=True;
   if AParser.Token<>'{' then Exit;
 
   Result:=False;
   AParser.NextToken;
-  vars:=itf.ProtVars;
 
+  scope:=os_Protected;
   while AParser.Token<>'}' do begin
     if isObjCKeyword(AParser.Token) then begin
       s:=GetObjCKeyword(APArser.Token);
-      if s='protected' then vars:=itf.ProtVars
+      if s='protected' then scope:=os_Protected
-      else if s='private' then vars:=itf.PrivVars
+      else if s='private' then scope:=os_Private
-      else if s='public' then vars:=itf.PubVars
+      else if s='public' then scope:=os_Public
-      else if s='package' then vars:=itf.PackVars
+      else if s='package' then scope:=os_Package
       else begin
         ErrorExpect(AParser,'}');
         Exit;
       end;
       AParser.NextToken;
     end else begin
-      v:=TVarFuncEntity.Create(APArser.TokenPos);
+      v:=TVarFuncEntity.Create(AParser.TokenPos);
       if not ParseNames(AParser, v.RetType, v.Names) then Exit;
-      vars.Add(v);
+      iv:=TObjCInstVar.Create(v.Offset);
-      if AParser.Token=';' then
+      iv.v:=v;
-        AParser.NextToken;
+      iv.scope:=scope;
+      Vars.Add(iv);
+      if AParser.Token=';' then AParser.NextToken;
     end;
   end;
   AParser.NextToken;
@@ -191,7 +220,7 @@ begin
       end;
 
       //writeln('parsing vars1 ', AParser.Token);
-      ParseInstVars(AParser, itf);
+      ParseInstVars(AParser, itf.Vars);
       //writeln('parsing vars2 ', AParser.Token);
     end;
 
@@ -250,10 +279,7 @@ end;
 
 constructor TObjCInterface.Create(AOffset:Integer);
 begin
-  ProtVars := TList.Create;
+  Vars := TList.Create;
-  PrivVars := TList.Create;
-  PubVars  := TList.Create;
-  PackVars := TList.Create;
   Methods  := TList.Create;
   Protocols := TStringList.Create;
   inherited Create(AOffset);
@@ -263,18 +289,10 @@ destructor TObjCInterface.Destroy;
 var
   i : Integer;
 begin
-  for i:=0 to ProtVars.Count-1 do TObject(ProtVars[i]).Free;
+  for i:=0 to Vars.Count-1 do TObject(Vars[i]).Free;
-  for i:=0 to PrivVars.Count-1 do TObject(PrivVars[i]).Free;
+  Vars.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;
@@ -388,6 +406,15 @@ begin
   Args[i].TypeName:=ArgTypeName;
 end;
 
+{ TObjCInstVar }
+
+
+destructor TObjCInstVar.Destroy;
+begin
+  v.Free;
+  inherited Destroy;
+end;
+
 initialization
   PrevParseNextEntity:=ParseNextEntity;
   ParseNextEntity:=ParseNextObjCEntity;