diff --git a/components/chelper/ctopasconvert.pas b/components/chelper/ctopasconvert.pas index 5c19e6698..868ff1fbd 100644 --- a/components/chelper/ctopasconvert.pas +++ b/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; - i : INteger; + ret : AnsiString; + 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 ') - else wr.W('function '); - wr.W( GetObjCMethodName(m.Name) ); - - if length(m.Args)>0 then begin - wr.W('('); + SetLength(PNames, length(m.Args)); + SetLength(PTypes, length(m.Args)); + if length(m.Args)>0 then 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); + 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'); - wr.IncIdent; - for i:=0 to cent.Methods.Count-1 do begin - m:=TObjCMethod(cent.Methods[i]); - WriteObjCMethod(m) + if cent.Methods.Count>0 then begin + 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; - wr.DecIdent; - wr.Wln('end;') end; procedure TCodeConvertor.PushWriter; diff --git a/components/chelper/objcparsing.pas b/components/chelper/objcparsing.pas index 741658d43..bb19af0a2 100644 --- a/components/chelper/objcparsing.pas +++ b/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; - PrivVars : TList; - PubVars : TList; - PackVars : TList; + Vars : 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 - else if s='private' then vars:=itf.PrivVars - else if s='public' then vars:=itf.PubVars - else if s='package' then vars:=itf.PackVars + if s='protected' then scope:=os_Protected + else if s='private' then scope:=os_Private + else if s='public' then scope:=os_Public + 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); - if AParser.Token=';' then - AParser.NextToken; + iv:=TObjCInstVar.Create(v.Offset); + iv.v:=v; + 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; - PrivVars := TList.Create; - PubVars := TList.Create; - PackVars := TList.Create; + Vars := 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 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 Vars.Count-1 do TObject(Vars[i]).Free; + Vars.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;