diff --git a/bindings/pascocoa/parser/ObjCParserTypes.pas b/bindings/pascocoa/parser/ObjCParserTypes.pas
index d5c558d24..0d31442a5 100755
--- a/bindings/pascocoa/parser/ObjCParserTypes.pas
+++ b/bindings/pascocoa/parser/ObjCParserTypes.pas
@@ -293,6 +293,17 @@ type
end;
{ TClassDef }
+
+ { TClassesForward }
+
+ TClassesForward = class(TEntity)
+ protected
+ function DoParse(AParser: TTextParser): Boolean; override;
+ public
+ _Classes : TStringList;
+ constructor Create(AOwner: TEntity);
+ destructor Destroy; override;
+ end;
TClassDef = class(TEntity)
protected
@@ -953,7 +964,7 @@ var
begin
Result := false;
AParser.FindNextToken(s, tt);
- if s <> '@interface' then begin
+ if s <> '@interface' then begin
AParser.SetError(ErrExpectStr('@interface', s));
Exit;
end;
@@ -1040,10 +1051,20 @@ begin
ent := TEnumTypeDef.Create(Self);
if not ent.Parse(AParser) then Exit;
AParser.FindNextToken(s, tt); // skipping last ';'
+ end else if s = 'struct' then begin
+ APArser.index := APArser.TokenPos;
+ ent := TStructTypeDef.Create(SElf);
+ if not ent.Parse(AParser) then Exit;
+ AParser.FindNextToken(s, tt); //? skipping last ';'?
+ if s <> ';' then AParser.Index := AParser.TokenPos;
end else if s = '@interface' then begin
AParser.Index := AParser.TokenPos;
ent := TClassDef.Create(Self);
if not ent.Parse(AParser) then Exit;
+ end else if s = '@class' then begin
+ AParser.Index := AParser.TokenPos;
+ ent := TClassesForward.create(Self);
+ if not ent.Parse(AParser) then Exit;
end else begin
// anything else is skipped, though should not!
ent := TSkip.Create(Self);
@@ -1924,4 +1945,37 @@ begin
end;
end;
+{ TClassesForward }
+
+function TClassesForward.DoParse(AParser: TTextParser): Boolean;
+var
+ s : AnsiString;
+ tt : TTokenType;
+begin
+ AParser.FindNextToken(s, tt);
+ if s <> '@class' then begin
+ AParser.SetError( ErrExpectStr('@class', s));
+ Exit;
+ end;
+
+ while s <> ';' do begin
+ AParser.FindNextToken(s, tt);
+ if tt = tt_Ident then
+ _Classes.Add(s);
+ end;
+ Result := true;
+end;
+
+constructor TClassesForward.Create(AOwner: TEntity);
+begin
+ inherited Create(AOwner);
+ _Classes:=TStringList.Create;
+end;
+
+destructor TClassesForward.Destroy;
+begin
+ _Classes.Free;
+ inherited Destroy;
+end;
+
end.
diff --git a/bindings/pascocoa/parser/ObjCParserUtils.pas b/bindings/pascocoa/parser/ObjCParserUtils.pas
index 6d5aa1fe4..0c8a2e5d1 100755
--- a/bindings/pascocoa/parser/ObjCParserUtils.pas
+++ b/bindings/pascocoa/parser/ObjCParserUtils.pas
@@ -219,7 +219,7 @@ begin
tp := TTypeDef(TObjCParameterDef(p)._Type._Type);
vtype := ObjCToDelphiType(tp._Name, tp._IsPointer);
end else begin
- prc := 'TProc' + TObjCParameterDef(p)._Name + IntToStr(ConvertSettings.CustomTypes.Count);
+ prc := 'TProc' + TClassDef(m.Owner)._ClassName + TObjCParameterDef(p)._Name + IntToStr(ConvertSettings.CustomTypes.Count);
ConvertSettings.AssignNewTypeName(prc, CToDelphiFuncType(TFunctionTypeDef(TObjCParameterDef(p)._Type._Type)), vtype);
tp := TTypeDef.Create(TObjCParameterDef(p)._Type);
tp._Name := vtype;
@@ -361,9 +361,9 @@ begin
for i := 0 to mtd.Items.Count - 1 do begin
obj := mtd.Items[i];
if not Assigned(obj) then Continue;
- if obj is TParamDescr then
- Result := Result + TParamDescr(obj)._Descr
- else if obj is TObjCParameterDef then
+ if obj is TParamDescr then begin
+ Result := Result + TParamDescr(obj)._Descr;
+ end else if obj is TObjCParameterDef then
Result := Result + '_';
end;
i := length(Result);
@@ -1295,20 +1295,28 @@ const
MtdPrefix = 'TMtd_';
MtdPostfix = '';
-procedure ObjCMethodToProcType(mtd: TClassMethodDef; var typeName: AnsiString; subs: TStrings);
+procedure ObjCMethodToProcType(mtd: TClassMethodDef; var typeName: AnsiString; subs: TStrings; isResultStruct: Boolean);
var
s : AnsiString;
ms : AnsiString;
restype : AnsiString;
begin
- typeName := MtdPrefix + mtd._Name + MtdPostFix;
+ //typeName := MtdPrefix + mtd._Name + MtdPostFix;
+ typeName := 'TmsgSendWrapper';
+
subs.Add('type');
ms := GetMethodParams(mtd, false);
if ms = '' then ms := 'param1: objc.id; param2: SEL'
else ms := 'param1: objc.id; param2: SEL' + ';' + ms;
- restype := GetMethodResultType(mtd);
- if IsMethodConstructor(mtd.Owner as TClassDef, mtd) then restype := 'objc.id';
-
+
+ if isResultStruct then begin
+ restype := '';
+ ms := 'result_param: Pointer; ' + ms;
+ end else begin
+ restype := GetMethodResultType(mtd);
+ if IsMethodConstructor(mtd.Owner as TClassDef, mtd) then restype := 'objc.id';
+ end;
+
s := Format(' %s = %s cdecl;',[typeName, GetProcFuncHead('', '', ms, restype, '' )]);
subs.Add(s);
end;
@@ -1356,7 +1364,7 @@ var
prms : AnsiString;
begin
cl := TClassDef(mtd.Owner);
- ObjCMethodToProcType(mtd, typeName, subs);
+ ObjCMethodToProcType(mtd, typeName, subs, false);
prms := GetMethodParams(mtd, true);
if prms <> '' then prms := ', ' + prms;
@@ -1402,6 +1410,7 @@ var
res : AnsiString;
callobj : AnsiString;
mnm : AnsiString;
+ prms : AnsiString;
begin
cl := TClassDef(mtd.Owner);
callobj := ClassMethodCaller[mtd._IsClassMethod];
@@ -1410,10 +1419,11 @@ begin
mnm := RefixName(mtd._Name);
//s := Format('vmethod(%s, sel_registerName(PChar(Str%s_%s)), %s)', [callobj, cl._ClassName, RefixName(mtd._Name), GetParamsNames(mtd)]);
tp := GetObjCVarType(res);
+ prms := GetMethodParams(mtd, true);
case tp of
- vt_Int, vt_Object: s := Format('objc_msgSend(%s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
- vt_FloatPoint: s := Format('objc_msgSend_fpret(%s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
- vt_Struct: s := Format('objc_msgSend_stret(@Result, %s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
+ vt_Int, vt_Object: s := Format('vmethod(%s, sel_registerName(PChar(Str%s_%s)), %s)', [callobj, cl._ClassName, mnm, prms]);
+ vt_FloatPoint: s := Format('vmethod(%s, sel_registerName(PChar(Str%s_%s)), %s)', [callobj, cl._ClassName, mnm, prms]);
+ vt_Struct: s := Format('vmethod(@Result, %s, sel_registerName(PChar(Str%s_%s)), %s)', [callobj, cl._ClassName, mnm, prms]);
end;
if (tp <> vt_Struct) and (ObjCResultToDelphiType(mtd.GetResultType) <> '') then begin
@@ -1425,13 +1435,17 @@ begin
end;
- ObjCMethodToProcType(mtd, typeName, subs);
+ ObjCMethodToProcType(mtd, typeName, subs, tp=vt_Struct);
subs.Add('var');
subs.Add(
Format(' vmethod: %s;', [typeName]));
subs.Add('begin');
- subs.Add(
- Format(' vmethod := %s(@objc_msgSend);', [typeName]));
+ case tp of
+ vt_Struct: subs.Add(Format(' vmethod := %s(@objc_msgSend_fpret);', [typeName]));
+ vt_FloatPoint: subs.Add(Format(' vmethod := %s(@objc_msgSend_stret);', [typeName]));
+ else
+ subs.Add( Format(' vmethod := %s(@objc_msgSend);', [typeName]));
+ end;
subs.Add(
Format(' %s;', [s]));
subs.Add('end;');
@@ -1452,41 +1466,28 @@ begin
res := GetMethodResultType(mtd);
tp := GetObjCVarType(res);
-{ if tp = vt_Object then begin
- subs.Add('var');
- subs.Add(' hnd: objc.id;');
- subs.Add('begin');
- subs.Add(' hnd := ' + Format('objc_msgSend(%s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, RefixName(mtd._Name) ]));
- subs.Add(' if Assigned(hnd) then begin ');
- subs.Add(' Result := ' + Format('%s.Create; ', [res]) );
- subs.Add(' Result.Handle := hnd;');
- subs.Add(' end else');
- subs.Add(' Result := nil;');
- subs.Add('end;');
- end else begin}
+ mnm := RefixName(mtd._Name);
+ case tp of
+ vt_Int, vt_Object:
+ s := Format('objc_msgSend(%s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
+ vt_FloatPoint:
+ s := Format('objc_msgSend_fpret(%s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
+ vt_Struct:
+ s := Format('objc_msgSend_stret(@Result, %s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
+ end;
+
+ if (tp <> vt_Struct) and (res <> '') then begin
+ if tp <> vt_FloatPoint then
+ s := Format('Result := %s(%s)', [res, s])
+ else
+ s := Format('Result := %s', [s]);
+ end;
+ s := s + ';';
- mnm := RefixName(mtd._Name);
- case tp of
- vt_Int, vt_Object: s := Format('objc_msgSend(%s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
- vt_FloatPoint: s := Format('objc_msgSend_fpret(%s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
- vt_Struct: s := Format('objc_msgSend_stret(@Result, %s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
- end;
-
- if (tp <> vt_Struct) and (res <> '') then begin
- if tp <> vt_FloatPoint then
- s := Format('Result := %s(%s)', [res, s])
- else
- s := Format('Result := %s', [s]);
- //s := 'Result := '+res+'('+s+')';
- //if res = 'objc.id' then s := 'Result := ' +s
- //else
- end;
- s := s + ';';
+ subs.Add('begin');
+ subs.Add(' ' + s);
+ subs.Add('end;');
- subs.Add('begin');
- subs.Add(' ' + s);
- subs.Add('end;');
- // end;
end;
procedure WriteOutMethodToImplementation(mtd: TClassMethodDef; subs: TStrings);
@@ -1683,6 +1684,7 @@ end;
procedure AppleHeaderFix(ent : TEntity);
var
i : Integer;
+ j : Integer;
obj : TEntity;
prm : TObjCParameterDef;
res : TObjCResultTypeDef;
@@ -1701,9 +1703,9 @@ begin
end else if (obj is TClassDef) and ((TClassDef(obj)._Category = '') and (TClassDef(obj)._ClassName = 'NSObject')) then begin
if TClassDef(obj)._SuperClass = '' then
TClassDef(obj)._SuperClass := 'TObject'
- end else if (obj is TParamDescr) then begin
+ {end else if (obj is TParamDescr) then begin
if IsPascalReserved(TParamDescr(obj)._Descr) then
- TParamDescr(obj)._Descr := '_'+TParamDescr(obj)._Descr
+ TParamDescr(obj)._Descr := '_'+TParamDescr(obj)._Descr}
end else if (obj is TClassMethodDef) and not IsMethodConstructor(TClassDef(obj.Owner ), TClassMethodDef(obj)) then begin
res := TClassMethodDef(obj).GetResultType;
if ConvertSettings.ObjCClassTypes.IndexOf( ObjCResultToDelphiType(res))>= 0 then
@@ -1721,7 +1723,7 @@ begin
end;
end;
- if IsPascalReserved(prm._Name) then
+ if IsPascalReserved(prm._Name) then
prm._Name := '_' + prm._Name;
end else if (obj is TStructField) then begin
@@ -1729,6 +1731,9 @@ begin
if ConvertSettings.ObjCClassTypes.IndexOf(TStructField(obj)._TypeName) >= 0 then begin
TStructField(obj)._TypeName := 'objc.id'
end;
+ end else if (obj is TClassesForward) then begin
+ for j := 0 to TClassesForward(obj)._Classes.Count - 1 do
+ ConvertSettings.ObjCClassTypes.Add( TClassesForward(obj)._Classes[j]);
end;
@@ -1774,12 +1779,31 @@ var
cl : TClassDef;
subs : TStringList;
consts : TStringList;
+ used : TStringList;
begin
subs := TStringList.Create;
consts := TStringList.Create;
try
st.AddStrings(ConvertSettings.ConvertPrefix);
+ used := TStringList.Create;
+ try
+ for i := 0 to hdr.Items.Count - 1 do begin
+ if (TObject(hdr.Items[i]) is TClassDef) then begin
+ cl := TClassDef(hdr.Items[i]);
+ if (cl._Category = '') then begin
+ WriteOutClassToConsts(cl, subs, consts);
+ used.Add(cl._ClassName);
+ end else if used.IndexOf(cl._Classname) >= 0 then begin
+ WriteOutClassToConsts(cl, subs, consts);
+ end;
+ end;
+ end;
+ finally
+ used.Free;
+ used := nil;
+ end;
+
if hdr.Items.Count <= 0 then Exit;
AppleHeaderFix(hdr);
@@ -1793,16 +1817,9 @@ begin
hdr.Items.Delete(0);
end;
- for i := 0 to hdr.Items.Count - 1 do begin
- if (TObject(hdr.Items[i]) is TClassDef) then begin
- cl := TClassDef(hdr.Items[i]);
- WriteOutClassToConsts(cl, subs, consts);
- end;
- end;
WriteOutHeaderSection(hdr, st);
WriteOutForwardSection(hdr, st);
-
for i := 0 to hdr.Items.Count - 1 do
if TObject(hdr.Items[i]) is TClassDef then
diff --git a/bindings/pascocoa/parser/default.ini b/bindings/pascocoa/parser/default.ini
index bf3736042..3ad111103 100755
--- a/bindings/pascocoa/parser/default.ini
+++ b/bindings/pascocoa/parser/default.ini
@@ -1,5 +1,5 @@
[common]
-ignoreincludes0=CoreFoundation/ Foundation/
+ignoreincludes0=CoreFoundation/
ignoreincludes1=setjmp.h stdarg.h stdbool.h limits.h stdarg.h
ignoreincludes2=AvailabilityMacros.h
ignoreincludes3=ApplicationServices/
@@ -7,6 +7,7 @@ ignoreincludes4=ApplicationServices/../FrameWorks/CoreGraphics.framework/Headers
ignoreincludes5=AvailabilityMacros.h
[TypeReplace]
+NSRect=CGRect
NSStringRef=CFStringRef
NSStringRef*=CFStringRef
NSArray=CFArrayRef
@@ -65,7 +66,7 @@ CGSize=struct
CGPoint=struct
CFTimeInterval=float
CGAffineTransform=struct
-
+NSRect=struct
NSPoint=struct
NSSize=struct
NSRange=struct
diff --git a/bindings/pascocoa/parser/objcparser.lpi b/bindings/pascocoa/parser/objcparser.lpi
index e9b10884b..de8748238 100755
--- a/bindings/pascocoa/parser/objcparser.lpi
+++ b/bindings/pascocoa/parser/objcparser.lpi
@@ -36,7 +36,7 @@
-
+
@@ -45,8 +45,8 @@
-
-
+
+
@@ -54,22 +54,58 @@
-
-
+
+
-
+
-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+