You've already forked lazarus-ccr
+ started of pascal code generation for objc20 properties
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@711 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@@ -439,12 +439,13 @@ type
|
|||||||
|
|
||||||
TObjCClassProperty = class(TEntity)
|
TObjCClassProperty = class(TEntity)
|
||||||
protected
|
protected
|
||||||
|
function DoParse(AParser: TTextParser): Boolean; override;
|
||||||
|
public
|
||||||
_Attribs : TObjCPropertyAttributes;
|
_Attribs : TObjCPropertyAttributes;
|
||||||
_Getter : AnsiString;
|
_Getter : AnsiString;
|
||||||
_Setter : AnsiString;
|
_Setter : AnsiString;
|
||||||
_Type : TEntity;
|
_Type : TEntity;
|
||||||
_Name : AnsiString;
|
_Name : AnsiString;
|
||||||
function DoParse(AParser: TTextParser): Boolean; override;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TClassDef = class(TEntity)
|
TClassDef = class(TEntity)
|
||||||
@@ -2901,6 +2902,7 @@ begin
|
|||||||
Result := true;
|
Result := true;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
|
|
||||||
finalization
|
finalization
|
||||||
|
@@ -98,6 +98,16 @@ function GetObjCVarType(const TypeName: AnsiString):TObjcConvertVarType; //): Bo
|
|||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
|
function GetterSetterName(const PropName: AnsiString; etterName: AnsiString; isSetter: Boolean): AnsiString;
|
||||||
|
begin
|
||||||
|
if etterName = '' then begin
|
||||||
|
if isSetter then Result := 'set'+PropName
|
||||||
|
else Result := 'get'+PropName;
|
||||||
|
end else
|
||||||
|
Result := etterName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure WriteOutRecordField(AField: TStructField; const Prefix: AnsiString; subs: TStrings); forward;
|
procedure WriteOutRecordField(AField: TStructField; const Prefix: AnsiString; subs: TStrings); forward;
|
||||||
procedure WriteOutRecord(struct: TEntityStruct; const Prefix, RecPrefix : AnsiString; subs: TStrings); forward;
|
procedure WriteOutRecord(struct: TEntityStruct; const Prefix, RecPrefix : AnsiString; subs: TStrings); forward;
|
||||||
|
|
||||||
@@ -1165,20 +1175,29 @@ var
|
|||||||
|
|
||||||
mtds : TStringList; // name of methods
|
mtds : TStringList; // name of methods
|
||||||
restype: TObjCResultTypeDef;
|
restype: TObjCResultTypeDef;
|
||||||
|
|
||||||
// over : TStringList; // overloaded names
|
// over : TStringList; // overloaded names
|
||||||
|
|
||||||
|
isProtEmpty : Boolean;
|
||||||
|
protidx : Integer;
|
||||||
|
pr : TObjCClassProperty;
|
||||||
const
|
const
|
||||||
SpacePrefix = ' ';
|
SpacePrefix = ' ';
|
||||||
begin
|
begin
|
||||||
|
isProtEmpty := true;
|
||||||
|
|
||||||
subs.Add('');
|
subs.Add('');
|
||||||
subs.Add(' { '+cl._ClassName +' }');
|
subs.Add(' { '+cl._ClassName +' }');
|
||||||
subs.Add('');
|
subs.Add('');
|
||||||
s := ' ' + cl._ClassName + ' = class';
|
s := ' ' + cl._ClassName + ' = class';
|
||||||
if cl._SuperClass <> '' then begin
|
if cl._SuperClass <> '' then begin
|
||||||
subs.Add(s + '('+cl._SuperClass+')');
|
subs.Add(s + '('+cl._SuperClass+')');
|
||||||
|
protidx := subs.Count;
|
||||||
subs.Add(' public');
|
subs.Add(' public');
|
||||||
subs.Add(' class function getClass: objc.id; override;');
|
subs.Add(' class function getClass: objc.id; override;');
|
||||||
end else begin
|
end else begin
|
||||||
subs.Add(s + '{from category '+ cl._Category +'}');
|
subs.Add(s + '{from category '+ cl._Category +'}');
|
||||||
|
protidx := subs.Count;
|
||||||
subs.Add(' public');
|
subs.Add(' public');
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@@ -1218,6 +1237,24 @@ begin
|
|||||||
WriteOutIfDefPrecompiler(TPrecompiler(obj), SpacePrefix, subs);
|
WriteOutIfDefPrecompiler(TPrecompiler(obj), SpacePrefix, subs);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
for j := 0 to cl.Items.Count - 1 do begin
|
||||||
|
obj := TObject(cl.Items[j]);
|
||||||
|
if obj is TObjCClassProperty then begin
|
||||||
|
pr := obj as TObjCClassProperty;
|
||||||
|
subs.Add(' property ' + pr._Name+';');
|
||||||
|
|
||||||
|
if isProtEmpty then begin
|
||||||
|
subs.Insert(protidx, ' protected'); inc(protidx);
|
||||||
|
isProtEmpty := false;
|
||||||
|
end;
|
||||||
|
subs.Insert(protidx, ' function '+GetterSetterName(pr._Name, pr._Getter, false)+';');
|
||||||
|
inc(protidx);
|
||||||
|
subs.Insert(protidx, ' procedure '+GetterSetterName(pr._Name, pr._Setter, true) +';');
|
||||||
|
inc(protidx);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
finally
|
finally
|
||||||
mtds.Free;
|
mtds.Free;
|
||||||
end;
|
end;
|
||||||
|
@@ -21,8 +21,7 @@ uses
|
|||||||
SysUtils,
|
SysUtils,
|
||||||
ObjCParserUtils,
|
ObjCParserUtils,
|
||||||
ObjCParserTypes,
|
ObjCParserTypes,
|
||||||
gnuccFeatures,
|
gnuccFeatures;
|
||||||
ObjCToPas in 'ObjCToPas.pas';
|
|
||||||
|
|
||||||
type
|
type
|
||||||
// this object is used only for precomile directives handling
|
// this object is used only for precomile directives handling
|
||||||
|
Reference in New Issue
Block a user