pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fixed config file usage, that prevented from using more than one config file; fixed result types not converted to objc.id, fixed file including

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@445 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2008-04-29 14:10:17 +00:00
parent dda68f13a0
commit ece0e03c29
5 changed files with 629 additions and 372 deletions
Download Patch File Download Diff File Expand all files Collapse all files

61
bindings/pascocoa/parser/ObjCParserTypes.pas
View File

@ -82,6 +82,7 @@ type
public public
owner : TEntity; owner : TEntity;
Items : TList; Items : TList;
TagComment : AnsiString;
constructor Create(AOwner: TEntity); constructor Create(AOwner: TEntity);
destructor Destroy; override; destructor Destroy; override;
function Parse(AParser: TTextParser): Boolean; virtual; function Parse(AParser: TTextParser): Boolean; virtual;
@ -238,11 +239,12 @@ type
{ TObjCParameterDef } { TObjCParameterDef }
TObjCResultTypeDef = class(TTypeDef) TObjCResultTypeDef = class(TEntity)
{updating} {updating}
protected protected
function DoParse(AParser: TTextParser): Boolean; override; function DoParse(AParser: TTextParser): Boolean; override;
public public
_Type : TEntity;
_isRef : Boolean; _isRef : Boolean;
_isConst : Boolean; // (const Sometype) _isConst : Boolean; // (const Sometype)
_Prefix : AnsiString; // reserved-word type descriptors _Prefix : AnsiString; // reserved-word type descriptors
@ -253,7 +255,7 @@ type
protected protected
function DoParse(AParser: TTextParser): Boolean; override; function DoParse(AParser: TTextParser): Boolean; override;
public public
_Res : TObjCResultTypeDef; _Type : TObjCResultTypeDef;
_Name : AnsiString; _Name : AnsiString;
end; end;
@ -1100,7 +1102,9 @@ begin
end else if (tt = tt_Ident) then begin end else if (tt = tt_Ident) then begin
// if type is not defined, that it's assumed to be obj-c 'id' // if type is not defined, that it's assumed to be obj-c 'id'
res := TObjCResultTypeDef.Create(Self); res := TObjCResultTypeDef.Create(Self);
res._Name := 'id'; res._Type := TTypeDef.Create(res);
TTypeDef(res._Type)._Name := 'id';
Items.Add(res); Items.Add(res);
AParser.Index := AParser.TokenPos; AParser.Index := AParser.TokenPos;
end else end else
@ -1141,10 +1145,10 @@ var
tt : TTokenType; tt : TTokenType;
begin begin
Result := false; Result := false;
_Res := TObjCResultTypeDef.Create(Self); _Type := TObjCResultTypeDef.Create(Self);
if not _Res.Parse(AParser) then Exit; if not _Type.Parse(AParser) then Exit;
Items.Add(_Res); Items.Add(_Type);
AParser.FindNextToken(_Name, tt); AParser.FindNextToken(_Name, tt);
if tt <> tt_Ident then begin if tt <> tt_Ident then begin
AParser.SetError(ErrExpectStr('Identifier', _Name)); AParser.SetError(ErrExpectStr('Identifier', _Name));
@ -1153,12 +1157,33 @@ begin
Result := true; Result := true;
end; end;
function isParamFuncPointer(AParser: TTextParser): Boolean;
var
i : Integer;
s : AnsiString;
tt : TTokenType;
begin
i := AParser.Index;
AParser.FindNextToken(s, tt);
Result := (tt = tt_Symbol) and (s = '(');
if not Result then Exit;
AParser.FindNextToken(s, tt);
Result := (tt = tt_Symbol) and (s = '*');
if not Result then Exit;
AParser.FindNextToken(s, tt);
Result := (tt = tt_Symbol) and (s = ')');
if not Result then Exit;
end;
{ TResultTypeDef } { TResultTypeDef }
function TObjCResultTypeDef.DoParse(AParser: TTextParser): Boolean; function TObjCResultTypeDef.DoParse(AParser: TTextParser): Boolean;
var var
s : AnsiString; s : AnsiString;
tt : TTokenType; tt : TTokenType;
fnt : TFunctionTypeDef;
begin begin
Result := false; Result := false;
AParser.FindNextToken(s, tt); AParser.FindNextToken(s, tt);
@ -1166,7 +1191,10 @@ begin
AParser.SetError(ErrExpectStr('"("', s)); AParser.SetError(ErrExpectStr('"("', s));
Exit; Exit;
end; end;
Result := inherited DoParse(AParser);
_Type := TTypeDef.Create(Self);
Result := _Type.Parse(AParser);
if not Result then Exit;
if Result then begin if Result then begin
AParser.FindNextToken(s, tt); AParser.FindNextToken(s, tt);
@ -1175,8 +1203,23 @@ begin
AParser.FindNextToken(s, tt); AParser.FindNextToken(s, tt);
end; end;
if s = '(' then begin // ptr funciton (*)?
AParser.Index := AParser.TokenPos;
if not isParamFuncPointer(APArser) then begin
AParser.SetError(ErrExpectStr(')', s));
Result := false;
Exit;
end;
fnt := TFunctionTypeDef.Create(Self);
fnt._ResultType := _Type;
Result := fnt.Parse(AParser);
_Type := fnt;
if not Result then Exit;
AParser.FindNextToken(s, tt);
end;
Result := s = ')'; Result := s = ')';
if not Result then if not Result then
AParser.SetError( ErrExpectStr(')', s)); AParser.SetError( ErrExpectStr(')', s));
end; end;
@ -1642,8 +1685,10 @@ begin
Exit; Exit;
end; end;
_Spec := _Spec + vl; _Spec := _Spec + vl;
if (s <> 'const') and (s <> 'volatile') then begin
if _Name = '' then _Name := s if _Name = '' then _Name := s
else _Name := _Name + ' ' + s; else _Name := _Name + ' ' + s;
end;
AParser.FindNextToken(s, tt); AParser.FindNextToken(s, tt);
end; {of while} end; {of while}

262
bindings/pascocoa/parser/ObjCParserUtils.pas
View File

@ -54,10 +54,14 @@ type
FloatTypes : TStringList; FloatTypes : TStringList;
StructTypes : TStringList; StructTypes : TStringList;
ObjCTypes : TStringList; ObjCClassTypes : TStringList;
CustomTypes : TStringList;
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
procedure AssignNewTypeName(const AName, TypeDefStr: AnsiString; var NewTypeName: AnsiString);
end; end;
var var
@ -70,13 +74,15 @@ procedure WriteOutIncludeFile(hdr: TObjCHeader; st: TStrings);
procedure WriteOutMainFramework(hdr: TObjCHeader; st: TStrings); procedure WriteOutMainFramework(hdr: TObjCHeader; st: TStrings);
function ObjCToDelphiType(const objcType: AnsiString; isPointer: Boolean): AnsiString; function ObjCToDelphiType(const objcType: AnsiString; isPointer: Boolean): AnsiString;
function ObjCResultToDelphiType(Res: TObjCResultTypeDef) : AnsiString;
function CToDelphiFuncType(AFuncType: TFunctionTypeDef): AnsiString;
function StrFromFile(const FileName: AnsiString): AnsiString; function StrFromFile(const FileName: AnsiString): AnsiString;
function IsMethodConstructor(cl: TClassDef; m: TClassMethodDef): Boolean; function IsMethodConstructor(cl: TClassDef; m: TClassMethodDef): Boolean;
function GetMethodStr(cl: TClassDef; m: TClassMethodDef; ForImplementation: Boolean): AnsiString; function GetMethodStr(cl: TClassDef; m: TClassMethodDef; ForImplementation: Boolean): AnsiString;
function GetProcFuncHead(const FuncName, OfClass, Params, ResType: AnsiString; const FuncDest: AnsiString = ''): AnsiString; function GetProcFuncHead(const FuncName, OfClass, Params, ResType: AnsiString; const FuncDest: AnsiString = ''): AnsiString;
function GetMethodParams(const m: TClassMethodDef): AnsiString; function GetMethodParams(const m: TClassMethodDef; NamesOnly: Boolean): AnsiString;
function GetMethodResultType(const m: TClassMethodDef): AnsiString; function GetMethodResultType(const m: TClassMethodDef): AnsiString;
function IsPascalReserved(const s: AnsiString): Boolean; function IsPascalReserved(const s: AnsiString): Boolean;
@ -101,7 +107,7 @@ begin
Result := vt_FloatPoint Result := vt_FloatPoint
else if ConvertSettings.StructTypes.IndexOf(TypeName) >= 0 then else if ConvertSettings.StructTypes.IndexOf(TypeName) >= 0 then
Result := vt_Struct Result := vt_Struct
else if ConvertSettings.ObjCTypes.IndexOf(TypeName) >= 0 then else if ConvertSettings.ObjCClassTypes.IndexOf(TypeName) >= 0 then
Result := vt_Object; Result := vt_Object;
end; end;
@ -171,33 +177,66 @@ end;
function GetMethodResultType(const m: TClassMethodDef): AnsiString; function GetMethodResultType(const m: TClassMethodDef): AnsiString;
var var
res : TObjCResultTypeDef; res : TObjCResultTypeDef;
tp : TTypeDef;
begin begin
res := m.GetResultType; res := m.GetResultType;
if not Assigned(res) then Result := '' if not Assigned(res) then Result := ''
else Result := ObjCToDelphiType(m.GetResultType._Name, m.GetResultType._IsPointer); else begin
if m.GetResultType._Type is TTypeDef then begin
tp := TTypeDef(m.GetResultType._Type);
Result := ObjCToDelphiType(tp._Name, tp._IsPointer);
end else begin
ConvertSettings.AssignNewTypeName('', CToDelphiFuncType(TFunctionTypeDef(m.GetResultType._Type)), Result);
end;
end;
end; end;
function GetMethodParams(const m: TClassMethodDef): AnsiString; function GetMethodParams(const m: TClassMethodDef; NamesOnly: Boolean): AnsiString;
var var
i : Integer; i : Integer;
p : TObject; p : TObject;
vname : AnsiString; vname : AnsiString;
vtype : AnsiString; vtype : AnsiString;
tp : TTypeDef;
prc : AnsiString;
begin begin
Result := ''; Result := '';
vname := ''; vname := '';
vtype := ''; vtype := '';
for i := 0 to m.Items.Count - 1 do begin for i := 0 to m.Items.Count - 1 do begin
p := TObject(m.Items[i]); p := TObject(m.Items[i]);
if p is TParamDescr then
vname := TParamDescr(p)._Descr
else if p is TObjCParameterDef then begin
if vname = '' then vname := TObjCParameterDef(p)._Name;
vtype := ObjCToDelphiType(TObjCParameterDef(p)._Res._Name, TObjCParameterDef(p)._Res._IsPointer);
if Result <> '' then Result := Result + '; ';
if Copy(vtype, 1, 5) = 'array' then Result := Result + 'const A'+vname + ': ' + vtype if p is TParamDescr then begin
else Result := Result + 'A'+vname + ': ' + vtype; if vname = '' then vname := TParamDescr(p)._Descr
end else if p is TObjCParameterDef then begin
vname := TObjCParameterDef(p)._Name;
if (TObjCParameterDef(p)._Type._Type) is TTypeDef then 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);
ConvertSettings.AssignNewTypeName(prc, CToDelphiFuncType(TFunctionTypeDef(TObjCParameterDef(p)._Type._Type)), vtype);
tp := TTypeDef.Create(TObjCParameterDef(p)._Type);
tp._Name := vtype;
TObjCParameterDef(p)._Type._Type.Free; // replace function type with typename
TObjCParameterDef(p)._Type._Type := tp;
end;
{if IsPascalReserved(vname) then }
vname := '_'+vname;
if not NamesOnly then begin
if Result <> '' then Result := Result + '; ';
if Copy(vtype, 1, 5) = 'array' then Result := Result + 'const '+vname + ': ' + vtype
else Result := Result + ''+vname + ': ' + vtype;
end else begin
if Result = '' then Result := vname
else Result := Result + ', ' + vname;
end;
vname := ''; vname := '';
end; end;
end; end;
@ -282,6 +321,14 @@ begin
end; end;
end; end;
function ObjCResultToDelphiType(Res: TObjCResultTypeDef) : AnsiString;
begin
if Res._Type is TTypeDef then
Result := ObjCToDelphiType( TTypeDef(Res._Type)._Name, TTypeDef(Res._Type)._IsPointer)
else begin
end;
end;
function IsMethodConstructor(cl: TClassDef; m: TClassMethodDef): Boolean; function IsMethodConstructor(cl: TClassDef; m: TClassMethodDef): Boolean;
var var
res : TObjCResultTypeDef; res : TObjCResultTypeDef;
@ -298,7 +345,10 @@ begin
if not Result then Exit; if not Result then Exit;
res := m.GetResultType; res := m.GetResultType;
l := res._Name; if res._Type is TTypeDef then
l := TTypeDef(res._Type)._Name
else
l := '!!!todo function';
Result := (l = 'id') or (l = cl._ClassName); Result := (l = 'id') or (l = cl._ClassName);
end; end;
@ -337,8 +387,8 @@ begin
nm := m._Name; nm := m._Name;
if ForImplementation if ForImplementation
then Result := GetProcFuncHead(nm, cl._ClassName, GetMethodParams(m), res, ft) then Result := GetProcFuncHead(nm, cl._ClassName, GetMethodParams(m, false), res, ft)
else Result := GetProcFuncHead(nm, '', GetMethodParams(m), res, ft); else Result := GetProcFuncHead(nm, '', GetMethodParams(m, false), res, ft);
if ft = '' then if ft = '' then
if m._IsClassMethod then if m._IsClassMethod then
@ -462,7 +512,7 @@ begin
if (dir = '#import') or (dir = '#include') then begin if (dir = '#import') or (dir = '#include') then begin
prm := GetIncludeFile(Prec._Params); prm := GetIncludeFile(Prec._Params);
if (prm <> '') and (prm <> ' .inc') and (ConvertSettings.IgnoreIncludes.IndexOf(prm) < 0) then if (prm <> '') and (prm <> ' .inc') then
Result := Format('{$include %s}', [prm]); Result := Format('{$include %s}', [prm]);
end else if (dir = '#if') then begin end else if (dir = '#if') then begin
@ -899,8 +949,9 @@ begin
fntype := '{todo: not implemented... see .h file for type}'; fntype := '{todo: not implemented... see .h file for type}';
end; end;
restype := ObjCToDelphiType(fntype, isptr); restype := ObjCToDelphiType(fntype, isptr);
Result := GetProcFuncHead('', '', CParamsListToPascalStr(AFuncType._ParamsList), restype); Result := GetProcFuncHead('', '', CParamsListToPascalStr(AFuncType._ParamsList), restype) + ' cdecl';
Result := Copy(Result, 1, length(Result) - 1); //Result := Copy(Result, 1, length(Result) - 1);
//Result := Result + '; cdecl';
end; end;
procedure WriteOutRecordField(AField: TStructField; const Prefix: AnsiString; subs: TStrings); procedure WriteOutRecordField(AField: TStructField; const Prefix: AnsiString; subs: TStrings);
@ -1019,7 +1070,7 @@ begin
case GetObjCVarType(FromType) of case GetObjCVarType(FromType) of
vt_FloatPoint: ConvertSettings.FloatTypes.Add(NewType); vt_FloatPoint: ConvertSettings.FloatTypes.Add(NewType);
vt_Object: ConvertSettings.ObjCTypes.Add(NewType); vt_Object: ConvertSettings.ObjCClassTypes.Add(NewType);
vt_Struct: ConvertSettings.StructTypes.Add(NewType); vt_Struct: ConvertSettings.StructTypes.Add(NewType);
end; end;
end; end;
@ -1118,6 +1169,7 @@ var
// cnt : Integer; // cnt : Integer;
s : AnsiString; s : AnsiString;
nm : AnsiString; nm : AnsiString;
cmt : AnsiString;
j : Integer; j : Integer;
obj : TObject; // or TEntity obj : TObject; // or TEntity
@ -1161,6 +1213,13 @@ begin
nm := TClassMethodDef(cl.Items[j])._Name; nm := TClassMethodDef(cl.Items[j])._Name;
i := mtds.IndexOf(nm); i := mtds.IndexOf(nm);
if Integer(mtds.Objects[i]) > 0 then s := s + ' overload;'; if Integer(mtds.Objects[i]) > 0 then s := s + ' overload;';
if Assigned(TClassMethodDef(cl.Items[j]).GetResultType) then begin
cmt := TClassMethodDef(cl.Items[j]).GetResultType.TagComment;
if cmt <> '' then
s := s + '{'+cmt+'}';
end;
subs.Add(SpacePrefix + s); subs.Add(SpacePrefix + s);
end else if obj is TPrecompiler then begin end else if obj is TPrecompiler then begin
WriteOutIfDefPrecompiler(TPrecompiler(obj), SpacePrefix, subs); WriteOutIfDefPrecompiler(TPrecompiler(obj), SpacePrefix, subs);
@ -1199,6 +1258,16 @@ begin
BeginSection('CLASSES', st); BeginSection('CLASSES', st);
BeginExcludeSection( GetIfDefFileName(hdr._FileName, 'C'), st); BeginExcludeSection( GetIfDefFileName(hdr._FileName, 'C'), st);
try try
if ConvertSettings.CustomTypes.Count > 0 then begin
with ConvertSettings do
for i := 0 to CustomTypes.Count - 1 do
CustomTypes[i] := ' ' + CustomTypes[i];
st.AddStrings(ConvertSettings.CustomTypes);
st.Add('');
ConvertSettings.CustomTypes.Clear;
end;
st.AddStrings(subs); st.AddStrings(subs);
finally finally
EndSection(st); EndSection(st);
@ -1234,7 +1303,7 @@ var
begin begin
typeName := MtdPrefix + mtd._Name + MtdPostFix; typeName := MtdPrefix + mtd._Name + MtdPostFix;
subs.Add('type'); subs.Add('type');
ms := GetMethodParams(mtd); ms := GetMethodParams(mtd, false);
if ms = '' then ms := 'param1: objc.id; param2: SEL' if ms = '' then ms := 'param1: objc.id; param2: SEL'
else ms := 'param1: objc.id; param2: SEL' + ';' + ms; else ms := 'param1: objc.id; param2: SEL' + ';' + ms;
restype := GetMethodResultType(mtd); restype := GetMethodResultType(mtd);
@ -1244,7 +1313,7 @@ begin
subs.Add(s); subs.Add(s);
end; end;
function GetParamsNames(mtd: TClassMethodDef): AnsiString; (*function GetParamsNames(mtd: TClassMethodDef): AnsiString;
var var
i : Integer; i : Integer;
obj : TObject; obj : TObject;
@ -1262,7 +1331,7 @@ begin
end; end;
end; end;
Result := Result + vname; Result := Result + vname;
end; end;*)
// procedure writes out constructor entity to the implementation section // procedure writes out constructor entity to the implementation section
@ -1288,7 +1357,7 @@ var
begin begin
cl := TClassDef(mtd.Owner); cl := TClassDef(mtd.Owner);
ObjCMethodToProcType(mtd, typeName, subs); ObjCMethodToProcType(mtd, typeName, subs);
prms := GetParamsNames(mtd); prms := GetMethodParams(mtd, true);
if prms <> '' then prms := ', ' + prms; if prms <> '' then prms := ', ' + prms;
if (Pos('init', mtd._Name) = 1) and (not mtd._IsClassMethod) then begin if (Pos('init', mtd._Name) = 1) and (not mtd._IsClassMethod) then begin
@ -1342,21 +1411,25 @@ begin
//s := Format('vmethod(%s, sel_registerName(PChar(Str%s_%s)), %s)', [callobj, cl._ClassName, RefixName(mtd._Name), GetParamsNames(mtd)]); //s := Format('vmethod(%s, sel_registerName(PChar(Str%s_%s)), %s)', [callobj, cl._ClassName, RefixName(mtd._Name), GetParamsNames(mtd)]);
tp := GetObjCVarType(res); tp := GetObjCVarType(res);
case tp of case tp of
vt_Int: s := Format('objc_msgSend(%s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]); 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_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_Struct: s := Format('objc_msgSend_stret(@Result, %s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
end; end;
if (ObjCToDelphiType(mtd.GetResultType._Name, mtd.GetResultType._IsPointer) <> '') and (tp <> vt_Struct) then if (tp <> vt_Struct) and (ObjCResultToDelphiType(mtd.GetResultType) <> '') then begin
s := 'Result := ' + s; if tp <> vt_FloatPoint then
s := Format('Result := %s(%s)', [res, s])
else
s := Format('Result := %s', [s]);
//s := 'Result := ' res(' + s+')';
end;
ObjCMethodToProcType(mtd, typeName, subs); ObjCMethodToProcType(mtd, typeName, subs);
subs.Add('var'); subs.Add('var');
subs.Add( subs.Add(
Format(' vmethod: %s;', [typeName])); Format(' vmethod: %s;', [typeName]));
subs.Add('begin'); subs.Add('begin');
subs.Add( subs.Add(
Format(' vmethod := %s(@objc_msgSend);', [typeName])); Format(' vmethod := %s(@objc_msgSend);', [typeName]));
subs.Add( subs.Add(
@ -1379,7 +1452,7 @@ begin
res := GetMethodResultType(mtd); res := GetMethodResultType(mtd);
tp := GetObjCVarType(res); tp := GetObjCVarType(res);
if tp = vt_Object then begin { if tp = vt_Object then begin
subs.Add('var'); subs.Add('var');
subs.Add(' hnd: objc.id;'); subs.Add(' hnd: objc.id;');
subs.Add('begin'); subs.Add('begin');
@ -1390,27 +1463,30 @@ begin
subs.Add(' end else'); subs.Add(' end else');
subs.Add(' Result := nil;'); subs.Add(' Result := nil;');
subs.Add('end;'); subs.Add('end;');
end else begin end else begin}
mnm := RefixName(mtd._Name); mnm := RefixName(mtd._Name);
case tp of case tp of
vt_Int: s := Format('objc_msgSend(%s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]); 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_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_Struct: s := Format('objc_msgSend_stret(@Result, %s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
end; end;
if (tp <> vt_Struct) and (res <> '') then begin if (tp <> vt_Struct) and (res <> '') then begin
if res = 'objc.id' then s := 'Result := ' +s if tp <> vt_FloatPoint then
else s := 'Result := '+res+'('+s+')' 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; end;
s := s + ';'; s := s + ';';
subs.Add('begin'); subs.Add('begin');
subs.Add(' ' + s); subs.Add(' ' + s);
subs.Add('end;'); subs.Add('end;');
end; // end;
end; end;
procedure WriteOutMethodToImplementation(mtd: TClassMethodDef; subs: TStrings); procedure WriteOutMethodToImplementation(mtd: TClassMethodDef; subs: TStrings);
@ -1609,6 +1685,8 @@ var
i : Integer; i : Integer;
obj : TEntity; obj : TEntity;
prm : TObjCParameterDef; prm : TObjCParameterDef;
res : TObjCResultTypeDef;
td : TTypeDef;
begin begin
// i := 0; // i := 0;
for i := 0 to ent.Items.Count - 1 do begin for i := 0 to ent.Items.Count - 1 do begin
@ -1625,20 +1703,37 @@ begin
TClassDef(obj)._SuperClass := 'TObject' 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 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
if res._Type is TTypeDef then begin
td := TTypeDef(res._Type);
res.tagComment := td._Name;
td._Name := Format('objc.id', [td._Name] );
end;
end else if (obj is TObjCParameterDef) then begin end else if (obj is TObjCParameterDef) then begin
prm := TObjCParameterDef(obj); prm := TObjCParameterDef(obj);
if ConvertSettings.ObjCTypes.IndexOf(prm._Res._Name) >= 0 then
prm._Res._Name := Format('objc.id {%s}', [prm._Res._Name] ); if ConvertSettings.ObjCClassTypes.IndexOf( ObjCResultToDelphiType(prm._Type) ) >= 0 then begin
if prm._Type._Type is TTypeDef then begin
TTypeDef(prm._Type._Type)._Name := Format('objc.id {%s}', [TTypeDef(prm._Type._Type)._Name] );
end;
end;
if IsPascalReserved(prm._Name) then if IsPascalReserved(prm._Name) then
prm._Name := '_' + prm._Name; prm._Name := '_' + prm._Name;
end else if (obj is TStructField) then begin end else if (obj is TStructField) then begin
if ConvertSettings.ObjCTypes.IndexOf(TStructField(obj)._TypeName) >= 0 then // should _TypeName to be removed?
prm._Res._Name := 'objc.id'; if ConvertSettings.ObjCClassTypes.IndexOf(TStructField(obj)._TypeName) >= 0 then begin
TStructField(obj)._TypeName := 'objc.id'
end; end;
end; end;
end;
// packing list, removing nil references. // packing list, removing nil references.
FastPack(ent.Items); FastPack(ent.Items);
@ -1708,6 +1803,7 @@ begin
WriteOutHeaderSection(hdr, st); WriteOutHeaderSection(hdr, st);
WriteOutForwardSection(hdr, st); WriteOutForwardSection(hdr, st);
for i := 0 to hdr.Items.Count - 1 do for i := 0 to hdr.Items.Count - 1 do
if TObject(hdr.Items[i]) is TClassDef then if TObject(hdr.Items[i]) is TClassDef then
FixAppleClassDef(TClassDef(hdr.Items[i])); FixAppleClassDef(TClassDef(hdr.Items[i]));
@ -1729,6 +1825,18 @@ end;
{ TConvertSettings } { TConvertSettings }
procedure TConvertSettings.AssignNewTypeName(const AName, TypeDefStr: AnsiString; var NewTypeName: AnsiString);
var
typeName : AnsiSTring;
begin
typeName := AName;
if typeName = '' then typeName := 'CnvType' + IntToStr(CustomTypes.Count);
NewTypeName := typeName;
CustomTypes.Add( Format('%s = %s;', [NewTypeName, TypeDefStr]) );
// todo: add! a new type!
end;
constructor TConvertSettings.Create; constructor TConvertSettings.Create;
begin begin
IgnoreTokens := TStringList.Create; IgnoreTokens := TStringList.Create;
@ -1745,16 +1853,17 @@ begin
StructTypes := TStringList.Create; StructTypes := TStringList.Create;
StructTypes.CaseSensitive := false; StructTypes.CaseSensitive := false;
ObjCTypes := TStringList.Create; ObjCClassTypes := TStringList.Create;
ObjCClassTypes.CaseSensitive := false;
ObjCTypes.CaseSensitive := false; CustomTypes := TStringList.Create;
end; end;
destructor TConvertSettings.Destroy; destructor TConvertSettings.Destroy;
begin begin
FloatTypes.Free; FloatTypes.Free;
StructTypes.Free; StructTypes.Free;
ObjCTypes.Free; ObjCClassTypes.Free;
IgnoreTokens.Free; IgnoreTokens.Free;
IgnoreIncludes.Free; IgnoreIncludes.Free;
@ -1762,6 +1871,7 @@ begin
PtrTypeReplace.Free; PtrTypeReplace.Free;
DefineReplace.Free; DefineReplace.Free;
ConvertPrefix.Free; ConvertPrefix.Free;
CustomTypes.Free;
inherited Destroy; inherited Destroy;
end; end;
@ -1777,15 +1887,17 @@ begin
end; end;
with ConvertSettings do begin with ConvertSettings do begin
DefineReplace['MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_2'] := 'MAC_OS_X_VERSION_10_2'; {DefineReplace['MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_2'] := 'MAC_OS_X_VERSION_10_2';
DefineReplace['MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_3'] := 'MAC_OS_X_VERSION_10_3'; DefineReplace['MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_3'] := 'MAC_OS_X_VERSION_10_3';
DefineReplace['MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_4'] := 'MAC_OS_X_VERSION_10_4'; DefineReplace['MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_4'] := 'MAC_OS_X_VERSION_10_4';
DefineReplace['MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_5'] := 'MAC_OS_X_VERSION_10_5'; DefineReplace['MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_5'] := 'MAC_OS_X_VERSION_10_5';
DefineReplace['__LP64__'] := 'LP64'; DefineReplace['__LP64__'] := 'LP64';}
TypeDefReplace['unsigned char'] := 'byte'; TypeDefReplace['unsigned char'] := 'byte';
TypeDefReplace['uint8_t'] := 'byte'; TypeDefReplace['uint8_t'] := 'byte';
PtrTypeReplace['uint8_t'] := 'PByte'; PtrTypeReplace['uint8_t'] := 'PByte';
PtrTypeReplace['unsigned char'] := 'PChar';
PtrTypeReplace['char'] := 'PChar';
TypeDefReplace['short'] := 'SmallInt'; TypeDefReplace['short'] := 'SmallInt';
TypeDefReplace['short int'] := 'SmallInt'; TypeDefReplace['short int'] := 'SmallInt';
@ -1795,50 +1907,72 @@ begin
TypeDefReplace['uint16_t'] := 'Word'; TypeDefReplace['uint16_t'] := 'Word';
TypeDefReplace['int'] := 'Integer'; TypeDefReplace['int'] := 'Integer';
TypeDefReplace['signed'] := 'Integer';
TypeDefReplace['signed int'] := 'Integer'; TypeDefReplace['signed int'] := 'Integer';
TypeDefReplace['int32_t'] := 'Integer'; TypeDefReplace['int32_t'] := 'Integer';
TypeDefReplace['NSInteger'] := 'Integer'; TypeDefReplace['NSInteger'] := 'Integer';
TypeDefReplace['unsigned'] := 'LongWord'; TypeDefReplace['unsigned'] := 'LongWord';
PtrTypeReplace['unsigned'] := 'PLongWord';
TypeDefReplace['unsigned int'] := 'LongWord'; TypeDefReplace['unsigned int'] := 'LongWord';
TypeDefReplace['uint32_t'] := 'LongWord'; TypeDefReplace['uint32_t'] := 'LongWord';
TypeDefReplace['NSUInteger'] := 'LongWord'; TypeDefReplace['NSUInteger'] := 'LongWord';
PtrTypeReplace['int'] := 'PInteger';
PtrTypeReplace['signed'] := 'PInteger';
PtrTypeReplace['signed int'] := 'PInteger';
PtrTypeReplace['int32_t'] := 'PInteger';
PtrTypeReplace['NSInteger'] := 'PInteger';
PtrTypeReplace['unsigned'] := 'PLongWord';
PtrTypeReplace['unsigned int'] := 'PLongWord';
PtrTypeReplace['uint32_t'] := 'PLongWord';
PtrTypeReplace['NSUInteger'] := 'PLongWord';
TypeDefReplace['long long'] := 'Int64'; TypeDefReplace['long long'] := 'Int64';
PtrTypeReplace['long long'] := 'PInt64'; TypeDefReplace['singned long long'] := 'Int64';
TypeDefReplace['signed long long'] := 'Int64';
PtrTypeReplace['signed long long'] := 'PInt64';
TypeDefReplace['unsigned long long'] := 'Int64'; TypeDefReplace['unsigned long long'] := 'Int64';
PtrTypeReplace['unsigned long long'] := 'PInt64';
TypeDefReplace['int64_t'] := 'Int64'; TypeDefReplace['int64_t'] := 'Int64';
PtrTypeReplace['int64_t'] := 'PInt64';
TypeDefReplace['uint64_t'] := 'Int64'; TypeDefReplace['uint64_t'] := 'Int64';
PtrTypeReplace['long long'] := 'PInt64';
PtrTypeReplace['singned long long'] := 'PInt64';
PtrTypeReplace['unsigned long long'] := 'PInt64';
PtrTypeReplace['int64_t'] := 'PInt64';
PtrTypeReplace['uint64_t'] := 'PInt64'; PtrTypeReplace['uint64_t'] := 'PInt64';
TypeDefReplace['float'] := 'Single'; TypeDefReplace['float'] := 'Single';
TypeDefReplace['CGFloat'] := 'Single'; TypeDefReplace['CGFloat'] := 'Single';
PtrTypeReplace['double'] := 'PDouble';
PtrTypeReplace['float'] := 'PSingle';
PtrTypeReplace['CGFloat'] := 'PSingle';
TypeDefReplace['Class'] := '_Class'; TypeDefReplace['Class'] := '_Class';
TypeDefReplace['SRefCon'] := 'Pointer'; TypeDefReplace['SRefCon'] := 'Pointer';
TypeDefReplace['va_list'] := 'array of const'; TypeDefReplace['va_list'] := 'array of const';
StructTypes.Add('Int64'); TypeDefReplace['uint8_t']:='byte';
StructTypes.Add('NSAffineTransformStruct'); TypeDefReplace['unsigned long long']:='Int64';
FloatTypes.Add('NSTimeInterval'); TypeDefReplace['long long']:='Int64';
TypeDefReplace['signed long long']:='Int64';
TypeDefReplace['unsigned']:='LongWord';
PtrTypeReplace['uint8_t']:='Pbyte';
PtrTypeReplace['unsigned long long']:='PInt64';
PtrTypeReplace['long long']:='Int64';
PtrTypeReplace['signed long long']:='PInt64';
PtrTypeReplace['unsigned']:='PLongWord';
IgnoreTokens.Add('DEPRECATED_IN_MAC_OS_X_VERSION_10_5_AND_LATER'); StructTypes.Add('Int64');
{ StructTypes.Add('NSAffineTransformStruct');
FloatTypes.Add('NSTimeInterval');
FloatTypes.Add('CFFloat');}
{IgnoreTokens.Add('DEPRECATED_IN_MAC_OS_X_VERSION_10_5_AND_LATER');
IgnoreTokens.Add('DEPRECATED_IN_MAC_OS_X_VERSION_10_4_AND_LATER'); IgnoreTokens.Add('DEPRECATED_IN_MAC_OS_X_VERSION_10_4_AND_LATER');
IgnoreTokens.Add('AVAILABLE_MAC_OS_X_VERSION_10_5_AND_LATER'); IgnoreTokens.Add('AVAILABLE_MAC_OS_X_VERSION_10_5_AND_LATER');
IgnoreTokens.Add('AVAILABLE_MAC_OS_X_VERSION_10_4_AND_LATER'); IgnoreTokens.Add('AVAILABLE_MAC_OS_X_VERSION_10_4_AND_LATER');
IgnoreTokens.Add('AVAILABLE_MAC_OS_X_VERSION_10_3_AND_LATER'); IgnoreTokens.Add('AVAILABLE_MAC_OS_X_VERSION_10_3_AND_LATER');
IgnoreTokens.Add('AVAILABLE_MAC_OS_X_VERSION_10_2_AND_LATER'); IgnoreTokens.Add('AVAILABLE_MAC_OS_X_VERSION_10_2_AND_LATER');}
end; end;
end; end;

250
bindings/pascocoa/parser/default.ini Executable file
View File

@ -0,0 +1,250 @@
[common]
ignoreincludes0=CoreFoundation/ Foundation/
ignoreincludes1=setjmp.h stdarg.h stdbool.h limits.h stdarg.h
ignoreincludes2=AvailabilityMacros.h
ignoreincludes3=ApplicationServices/
ignoreincludes4=ApplicationServices/../FrameWorks/CoreGraphics.framework/Headers/
ignoreincludes5=AvailabilityMacros.h
[TypeReplace]
NSStringRef=CFStringRef
NSStringRef*=CFStringRef
NSArray=CFArrayRef
NSArray*=CFArrayRef
NSAttributedString=CFAttributedStringRef
NSAttributesString*=CFAttributedStringRef
NSCalendar=CFCalendarRef
NSCalendar*=CFCalendarRef
NSCharacterSet=CFCharacterSetRef
NSCharacterSet*=CFCharacterSetRef
NSData=CFDataRef
NSData*=CFDataRef
NSDate=CFDateRef
NSDate*=CFDateRef
NSDictionary=CFDictionaryRef
NSDictionary*=CFDictionaryRef
NSError=CFErrorRef
NSError*=CFErrorRef
NSLocale=CFErrorRef
NSLocale*=CFErrorRef
NSMutableArray=CFMutableArrayRef
NSMutableArray*=CFMutableArrayRef
NSMutableAttributedString=CFMutableAttributedStringRef
NSMutableAttributedString*=CFMutableAttributedStringRef
NSMutableCharacterSetRef=CFMutableCharacterSetRef
NSMutableCharacterSetRef*=CFMutableCharacterSetRef
NSMutableData = CFMutableDataRef
NSMutableDictionary = CFMutableDictionaryRef
NSMutableSet = CFMutableSetRef
NSMutableString = CFMutableStringRef
NSNumber = CFNumberRef
NSInputStream = CFReadStreamRef
NSTimer = CFRunLoopTimerRef
NSSet = CFSetRef
NSString = CFStringRef
NSTimeZone = CFTimeZoneRef
NSURL = CFURLRef
NSOutputStream = CFWriteStreamRef
AEDesc*=AEDescPtr
NSMutableData*= CFMutableDataRef
NSMutableDictionary*= CFMutableDictionaryRef
NSMutableSet*= CFMutableSetRef
NSMutableString* = CFMutableStringRef
NSNumber* = CFNumberRef
NSInputStream*= CFReadStreamRef
NSTimer*= CFRunLoopTimerRef
NSSet*= CFSetRef
NSString*= CFStringRef
NSTimeZone*= CFTimeZoneRef
NSURL*= CFURLRef
NSOutputStream*= CFWriteStreamRef
[TypeDefs]
CGRect=struct
CGSize=struct
CGPoint=struct
CFTimeInterval=float
CGAffineTransform=struct
NSPoint=struct
NSSize=struct
NSRange=struct
NSTimeInterval=float
NSAffineTransformStruct=struct
NSAffineTransform=objcclass
NSAppleEventDescriptor=objcclass
NSAppleEventManager=objcclass
NSAppleScript=objcclass
NSArchiver=objcclass
NSUnarchiver=objcclass
NSObject=objcclass
NSArray=objcclass
NSMutableArray=objcclass
NSAttributedString=objcclass
NSMutableAttributedString=objcclass
NSAutoreleasePool=objcclass
NSBundle=objcclass
NSCalendar=objcclass
NSDateComponents=objcclass
NSCalendarDate=objcclass
NSDate=objcclass
NSCharacterSet=objcclass
NSMutableCharacterSet=objcclass
NSClassDescription=objcclass
NSCoder=objcclass
NSComparisonPredicate=objcclass
NSCompoundPredicate=objcclass
NSConnection=objcclass
NSDistantObjectRequest=objcclass
NSData=objcclass
NSMutableData=objcclass
NSDateFormatter=objcclass
NSDecimalNumber=objcclass
NSDecimalNumberHandler=objcclass
NSNumber=objcclass
NSScanner=objcclass
NSDictionary=objcclass
NSMutableDictionary=objcclass
NSDistantObject=objcclass
NSDistributedLock=objcclass
NSDistributedNotificationCenter=objcclass
NSEnumerator=objcclass
NSError=objcclass
NSException=objcclass
NSAssertionHandler=objcclass
NSExpression=objcclass
NSFileHandle=objcclass
NSPipe=objcclass
NSFileManager=objcclass
NSDirectoryEnumerator=objcclass
NSFormatter=objcclass
NSGarbageCollector=objcclass
NSValue=objcclass
NSHashTable=objcclass
NSHost=objcclass
NSHTTPCookie=objcclass
NSHTTPCookieStorage=objcclass
NSIndexPath=objcclass
NSIndexSet=objcclass
NSMutableIndexSet=objcclass
NSInvocation=objcclass
NSKeyedArchiver=objcclass
NSKeyedUnarchiver=objcclass
NSSet=objcclass
NSLocale=objcclass
NSLock=objcclass
NSConditionLock=objcclass
NSRecursiveLock=objcclass
NSCondition=objcclass
NSMapTable=objcclass
NSMetadataQuery=objcclass
NSMetadataItem=objcclass
NSMetadataQueryAttributeValueTuple=objcclass
NSMetadataQueryResultGroup=objcclass
NSMethodSignature=objcclass
NSNetService=objcclass
NSNetServiceBrowser=objcclass
NSNotification=objcclass
NSNotificationCenter=objcclass
NSNotificationQueue=objcclass
NSNull=objcclass
NSNumberFormatter=objcclass
NSOperation=objcclass
NSInvocationOperation=objcclass
NSOperationQueue=objcclass
NSString=objcclass
NSPointerArray=objcclass
NSPointerFunctions=objcclass
NSPort=objcclass
NSMachPort=objcclass
NSMessagePort=objcclass
NSSocketPort=objcclass
NSPortCoder=objcclass
NSPortMessage=objcclass
NSPortNameServer=objcclass
NSMachBootstrapServer=objcclass
NSMessagePortNameServer=objcclass
NSSocketPortNameServer=objcclass
NSPredicate=objcclass
NSMutableSet=objcclass
NSProcessInfo=objcclass
NSPropertyListSerialization=objcclass
NSProtocolChecker=objcclass
NSProxy=objcclass
NSRunLoop=objcclass
NSScriptClassDescription=objcclass
NSScriptCoercionHandler=objcclass
NSScriptCommand=objcclass
NSScriptCommandDescription=objcclass
NSScriptExecutionContext=objcclass
NSScriptObjectSpecifier=objcclass
NSIndexSpecifier=objcclass
NSMiddleSpecifier=objcclass
NSNameSpecifier=objcclass
NSPositionalSpecifier=objcclass
NSPropertySpecifier=objcclass
NSRandomSpecifier=objcclass
NSRangeSpecifier=objcclass
NSRelativeSpecifier=objcclass
NSUniqueIDSpecifier=objcclass
NSWhoseSpecifier=objcclass
NSCloneCommand=objcclass
NSCloseCommand=objcclass
NSCountCommand=objcclass
NSCreateCommand=objcclass
NSDeleteCommand=objcclass
NSExistsCommand=objcclass
NSGetCommand=objcclass
NSMoveCommand=objcclass
NSQuitCommand=objcclass
NSSetCommand=objcclass
NSScriptSuiteRegistry=objcclass
NSScriptWhoseTest=objcclass
NSLogicalTest=objcclass
NSSpecifierTest=objcclass
NSCountedSet=objcclass
NSSortDescriptor=objcclass
NSSpellServer=objcclass
NSStream=objcclass
NSInputStream=objcclass
NSOutputStream=objcclass
NSMutableString=objcclass
NSSimpleCString=objcclass
NSConstantString=objcclass
NSTask=objcclass
NSThread=objcclass
NSTimer=objcclass
NSTimeZone=objcclass
NSUndoManager=objcclass
NSURL=objcclass
NSURLAuthenticationChallenge=objcclass
NSCachedURLResponse=objcclass
NSURLCache=objcclass
NSURLConnection=objcclass
NSURLCredential=objcclass
NSURLCredentialStorage=objcclass
NSURLDownload=objcclass
NSURLHandle=objcclass
NSURLProtectionSpace=objcclass
NSURLProtocol=objcclass
NSURLRequest=objcclass
NSMutableURLRequest=objcclass
NSURLResponse=objcclass
NSHTTPURLResponse=objcclass
NSUserDefaults=objcclass
NSValueTransformer=objcclass
NSXMLDocument=objcclass
NSXMLDTD=objcclass
NSXMLDTDNode=objcclass
NSXMLElement=objcclass
NSXMLNode=objcclass
NSXMLParser=objcclass
[TokenReplace]
DEPRECATED_IN_MAC_OS_X_VERSION_10_5_AND_LATER=""
DEPRECATED_IN_MAC_OS_X_VERSION_10_4_AND_LATER=""
AVAILABLE_MAC_OS_X_VERSION_10_5_AND_LATER=""
AVAILABLE_MAC_OS_X_VERSION_10_4_AND_LATER=""
AVAILABLE_MAC_OS_X_VERSION_10_3_AND_LATER=""
AVAILABLE_MAC_OS_X_VERSION_10_2_AND_LATER=""

269
bindings/pascocoa/parser/objcparser.lpi
View File

@ -11,12 +11,13 @@
</Flags> </Flags>
<MainUnit Value="0"/> <MainUnit Value="0"/>
<IconPath Value="./"/> <IconPath Value="./"/>
<TargetFileExt Value=".exe"/> <TargetFileExt Value=""/>
<UseAppBundle Value="False"/>
<ActiveEditorIndexAtStart Value="1"/> <ActiveEditorIndexAtStart Value="1"/>
</General> </General>
<VersionInfo> <VersionInfo>
<ProjectVersion Value=""/> <ProjectVersion Value=""/>
<Language Value=""/>
<CharSet Value=""/>
</VersionInfo> </VersionInfo>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
@ -30,270 +31,45 @@
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local> </local>
</RunParams> </RunParams>
<Units Count="36"> <Units Count="3">
<Unit0> <Unit0>
<Filename Value="objcparser.pas"/> <Filename Value="objcparser.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="objcparser"/> <UnitName Value="objcparser"/>
<CursorPos X="1" Y="409"/> <CursorPos X="69" Y="3"/>
<TopLine Value="388"/> <TopLine Value="1"/>
<EditorIndex Value="0"/> <EditorIndex Value="0"/>
<UsageCount Value="81"/> <UsageCount Value="26"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
<Filename Value="ObjCParserUtils.pas"/> <Filename Value="ObjCParserUtils.pas"/>
<UnitName Value="ObjCParserUtils"/> <UnitName Value="ObjCParserUtils"/>
<CursorPos X="1" Y="1353"/> <CursorPos X="44" Y="1705"/>
<TopLine Value="1334"/> <TopLine Value="1703"/>
<EditorIndex Value="1"/> <EditorIndex Value="1"/>
<UsageCount Value="37"/> <UsageCount Value="13"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit1> </Unit1>
<Unit2> <Unit2>
<Filename Value="ObjCParserTypes.pas"/> <Filename Value="ObjCParserTypes.pas"/>
<UnitName Value="ObjCParserTypes"/> <UnitName Value="ObjCParserTypes"/>
<CursorPos X="9" Y="517"/> <CursorPos X="30" Y="85"/>
<TopLine Value="517"/> <TopLine Value="64"/>
<EditorIndex Value="2"/> <EditorIndex Value="2"/>
<UsageCount Value="37"/> <UsageCount Value="13"/>
<Bookmarks Count="1">
<Item0 X="1" Y="626" ID="0"/>
</Bookmarks>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit2> </Unit2>
<Unit3>
<Filename Value="../foundation/foundation.pas"/>
<UnitName Value="foundation"/>
<CursorPos X="28" Y="10"/>
<TopLine Value="1"/>
<UsageCount Value="7"/>
</Unit3>
<Unit4>
<Filename Value="../appkit/AppKit.inc"/>
<CursorPos X="18" Y="156"/>
<TopLine Value="156"/>
<UsageCount Value="10"/>
</Unit4>
<Unit5>
<Filename Value="../../objc/objc.pas"/>
<UnitName Value="objc"/>
<CursorPos X="32" Y="38"/>
<TopLine Value="36"/>
<UsageCount Value="11"/>
</Unit5>
<Unit6>
<Filename Value="../../objc/objc-api.inc"/>
<CursorPos X="106" Y="9"/>
<TopLine Value="8"/>
<UsageCount Value="7"/>
</Unit6>
<Unit7>
<Filename Value="../appkit/NSActionCell.inc"/>
<CursorPos X="49" Y="34"/>
<TopLine Value="13"/>
<UsageCount Value="7"/>
</Unit7>
<Unit8>
<Filename Value="../appkit/NSCell.inc"/>
<CursorPos X="1" Y="48"/>
<TopLine Value="42"/>
<UsageCount Value="7"/>
</Unit8>
<Unit9>
<Filename Value="../foundation/NSGeometry.inc"/>
<CursorPos X="1" Y="46"/>
<TopLine Value="26"/>
<UsageCount Value="9"/>
</Unit9>
<Unit10>
<Filename Value="../foundation/NSObject.inc"/>
<CursorPos X="37" Y="302"/>
<TopLine Value="302"/>
<UsageCount Value="17"/>
<Loaded Value="True"/>
</Unit10>
<Unit11>
<Filename Value="pascodeutils.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="pascodeutils"/>
<CursorPos X="1" Y="13"/>
<TopLine Value="1"/>
<UsageCount Value="78"/>
</Unit11>
<Unit12>
<Filename Value="../appkit/NSWindow.inc"/>
<CursorPos X="37" Y="302"/>
<TopLine Value="302"/>
<UsageCount Value="19"/>
<Loaded Value="True"/>
</Unit12>
<Unit13>
<Filename Value="test.inc"/>
<CursorPos X="9" Y="18"/>
<TopLine Value="1"/>
<UsageCount Value="8"/>
</Unit13>
<Unit14>
<Filename Value="NSWindow.h"/>
<CursorPos X="35" Y="194"/>
<TopLine Value="172"/>
<UsageCount Value="23"/>
<SyntaxHighlighter Value="C++"/>
</Unit14>
<Unit15>
<Filename Value="../../objc/objc-runtime.inc"/>
<CursorPos X="1" Y="127"/>
<TopLine Value="127"/>
<UsageCount Value="11"/>
</Unit15>
<Unit16>
<Filename Value="headers/NSScreen.h"/>
<CursorPos X="1" Y="9"/>
<TopLine Value="1"/>
<UsageCount Value="9"/>
<SyntaxHighlighter Value="C++"/>
</Unit16>
<Unit17>
<Filename Value="../foundation/NSAutoreleasePool.inc"/>
<CursorPos X="16" Y="12"/>
<TopLine Value="12"/>
<UsageCount Value="8"/>
</Unit17>
<Unit18>
<Filename Value="../appkit/NSButton.inc"/>
<CursorPos X="23" Y="15"/>
<TopLine Value="12"/>
<UsageCount Value="8"/>
</Unit18>
<Unit19>
<Filename Value="../appkit/NSControl.inc"/>
<CursorPos X="21" Y="151"/>
<TopLine Value="139"/>
<UsageCount Value="12"/>
</Unit19>
<Unit20>
<Filename Value="headers/NSButton.h"/>
<CursorPos X="1" Y="23"/>
<TopLine Value="4"/>
<UsageCount Value="8"/>
<SyntaxHighlighter Value="C++"/>
</Unit20>
<Unit21>
<Filename Value="NSWindow.inc"/>
<CursorPos X="51" Y="447"/>
<TopLine Value="442"/>
<UsageCount Value="18"/>
</Unit21>
<Unit22>
<Filename Value="NSWindow2.h"/>
<IsPartOfProject Value="True"/>
<CursorPos X="44" Y="16"/>
<TopLine Value="11"/>
<UsageCount Value="59"/>
<SyntaxHighlighter Value="C++"/>
</Unit22>
<Unit23>
<Filename Value="../uikit/UIKit.h"/>
<CursorPos X="1" Y="31"/>
<TopLine Value="1"/>
<UsageCount Value="9"/>
<SyntaxHighlighter Value="C++"/>
</Unit23>
<Unit24>
<Filename Value="../appkit/NSAlert.inc"/>
<CursorPos X="1" Y="61"/>
<TopLine Value="38"/>
<UsageCount Value="9"/>
</Unit24>
<Unit25>
<Filename Value="../appkit/NSPanel.inc"/>
<CursorPos X="1" Y="34"/>
<TopLine Value="11"/>
<UsageCount Value="9"/>
</Unit25>
<Unit26>
<Filename Value="../appkit/NSView.inc"/>
<CursorPos X="5" Y="136"/>
<TopLine Value="121"/>
<UsageCount Value="12"/>
</Unit26>
<Unit27>
<Filename Value="headersMacOS/NSWindow.inc"/>
<CursorPos X="37" Y="302"/>
<TopLine Value="302"/>
<UsageCount Value="11"/>
</Unit27>
<Unit28>
<Filename Value="../appkit/appkit.pas"/>
<UnitName Value="appkit"/>
<CursorPos X="1" Y="7"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
</Unit28>
<Unit29>
<Filename Value="NSFontPanelUnit.pas"/>
<UnitName Value="NSFontPanelUnit"/>
<CursorPos X="25" Y="93"/>
<TopLine Value="79"/>
<UsageCount Value="9"/>
</Unit29>
<Unit30>
<Filename Value="objc.pas"/>
<UnitName Value="objc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="9"/>
</Unit30>
<Unit31>
<Filename Value="/usr/local/share/fpcsrc/rtl/objpas/sysutils/finah.inc"/>
<CursorPos X="10" Y="28"/>
<TopLine Value="18"/>
<UsageCount Value="9"/>
</Unit31>
<Unit32>
<Filename Value="/usr/local/share/fpcsrc/rtl/objpas/sysutils/fina.inc"/>
<CursorPos X="1" Y="41"/>
<TopLine Value="34"/>
<UsageCount Value="9"/>
</Unit32>
<Unit33>
<Filename Value="NSAlert.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="9"/>
</Unit33>
<Unit34>
<Filename Value="NSAffineTransform.h"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="9"/>
<SyntaxHighlighter Value="C++"/>
</Unit34>
<Unit35>
<Filename Value="NSAffineTransform.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="9"/>
</Unit35>
</Units> </Units>
<JumpHistory Count="4" HistoryIndex="3"> <JumpHistory Count="2" HistoryIndex="1">
<Position1> <Position1>
<Filename Value="ObjCParserUtils.pas"/> <Filename Value="ObjCParserUtils.pas"/>
<Caret Line="1830" Column="49" TopLine="1823"/> <Caret Line="1708" Column="49" TopLine="1699"/>
</Position1> </Position1>
<Position2> <Position2>
<Filename Value="ObjCParserUtils.pas"/> <Filename Value="ObjCParserUtils.pas"/>
<Caret Line="1" Column="1" TopLine="1"/> <Caret Line="1707" Column="93" TopLine="1694"/>
</Position2> </Position2>
<Position3>
<Filename Value="ObjCParserUtils.pas"/>
<Caret Line="94" Column="12" TopLine="83"/>
</Position3>
<Position4>
<Filename Value="ObjCParserUtils.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position4>
</JumpHistory> </JumpHistory>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
@ -302,22 +78,17 @@
<Generate Value="Faster"/> <Generate Value="Faster"/>
</CodeGeneration> </CodeGeneration>
<Other> <Other>
<Verbosity>
<ShowNotes Value="False"/>
</Verbosity>
<CompilerPath Value="$(CompPath)"/> <CompilerPath Value="$(CompPath)"/>
</Other> </Other>
</CompilerOptions> </CompilerOptions>
<Debugging> <Debugging>
<BreakPoints Count="2"> <Exceptions Count="2">
<Item1> <Item1>
<Source Value="C:/Games/CodeTest2/Sources/examples/codecompletion.lpr"/> <Name Value="ECodetoolError"/>
<Line Value="47"/>
</Item1> </Item1>
<Item2> <Item2>
<Source Value="../../LazTest4/consolethreads.pas"/> <Name Value="EFOpenError"/>
<Line Value="18"/>
</Item2> </Item2>
</BreakPoints> </Exceptions>
</Debugging> </Debugging>
</CONFIG> </CONFIG>

123
bindings/pascocoa/parser/objcparser.pas
View File

@ -33,7 +33,15 @@ type
var var
updIni : AnsiString = ''; updIni : AnsiString = '';
noConvert : Boolean = false; doOutput : Boolean = false;
doparseAll : Boolean = false;
const
TokenReplaceSec = 'TokenReplace';
TypeDefsSec = 'TypeDefs';
TypeReplaceSec = 'TypeReplace';
IgnoreIncludesSec = 'IgnoreIncludes';
CommonSec = 'Common';
function FindMax(const c: array of Integer; len: Integer): Integer; function FindMax(const c: array of Integer; len: Integer): Integer;
var var
@ -110,16 +118,16 @@ var
i : Integer; i : Integer;
begin begin
if Entity is TClassDef then begin if Entity is TClassDef then begin
Ini.WriteString('TypeDefs', TClassDef(Entity)._ClassName, 'objcclass'); Ini.WriteString(TypeDefsSec, TClassDef(Entity)._ClassName, 'objcclass');
end else if Entity is TStructTypeDef then begin end else if Entity is TStructTypeDef then begin
Ini.WriteString('TypeDefs', TStructTypeDef(Entity)._Name, 'struct'); Ini.WriteString(TypeDefsSec, TStructTypeDef(Entity)._Name, 'struct');
end else if Entity is TTypeNameDef then begin end else if Entity is TTypeNameDef then begin
if Assigned(Sets) then begin if Assigned(Sets) then begin
cnv := AnsiLowerCase(ObjCToDelphiType(TTypeNameDef(Entity)._Inherited, false )); cnv := AnsiLowerCase(ObjCToDelphiType(TTypeNameDef(Entity)._Inherited, false ));
if (cnv = 'float') or (cnv = 'double') then if (cnv = 'float') or (cnv = 'double') then
Ini.WriteString('TypeDefs', TTypeNameDef(Entity)._TypeName, 'float') Ini.WriteString(TypeDefsSec, TTypeNameDef(Entity)._TypeName, 'float')
else if (cnv = 'Int64') then else if (cnv = 'Int64') then
Ini.WriteString('TypeDefs', TTypeNameDef(Entity)._TypeName, 'struct') Ini.WriteString(TypeDefsSec, TTypeNameDef(Entity)._TypeName, 'struct')
end; end;
end; end;
@ -204,13 +212,13 @@ var
f : Text; f : Text;
err : AnsiString; err : AnsiString;
begin begin
err := ''; { err := '';
writeln('would you like to parse all current directory files .h to inc?'); writeln('would you like to parse all current directory files .h to inc?');
readln(ch); readln(ch);
if (ch <> 'Y') and (ch <> 'y') then begin if (ch <> 'Y') and (ch <> 'y') then begin
writeln('as you wish, bye!'); writeln('as you wish, bye!');
Exit; Exit;
end; end;}
pth := IncludeTrailingPathDelimiter( GetCurrentDir); pth := IncludeTrailingPathDelimiter( GetCurrentDir);
writeln('looking for .h files in ', pth); writeln('looking for .h files in ', pth);
@ -227,6 +235,7 @@ begin
incs := pth + Copy(srch.Name,1, length(srch.Name) - length(ExtractFileExt(srch.Name))); incs := pth + Copy(srch.Name,1, length(srch.Name) - length(ExtractFileExt(srch.Name)));
incs := incs + '.inc'; incs := incs + '.inc';
//writeln(incs); //writeln(incs);
if doOutput then begin
assignfile(f, incs); rewrite(f); assignfile(f, incs); rewrite(f);
try try
for i := 0 to st.Count - 1 do for i := 0 to st.Count - 1 do
@ -234,6 +243,8 @@ begin
finally finally
closefile(f); closefile(f);
end; end;
end;
st.Clear; st.Clear;
writeln(' converted!'); writeln(' converted!');
end else begin end else begin
@ -293,17 +304,25 @@ var
values : TStringList; values : TStringList;
a, b : AnsiString; a, b : AnsiString;
i : Integer; i : Integer;
IniName : AnsiString;
begin begin
// uikit.ini // uikit.ini
if not FileExists(FileName) then begin if not FileExists(FileName) then begin
writeln('//ini file is not found'); writeln('//ini file is not found');
Exit; Exit;
end; end;
ini := TIniFile.Create(FileName); {$ifndef fpc}
if ExtractFileName(FileName) = FileName then
IniName := IncludeTrailingPathDelimiter( GetCurrentDir) + FileName
else
IniName := FileName;
{$else}
IniName := FileName;
{$endif}
ini := TIniFile.Create(IniName);
values := TStringList.Create; values := TStringList.Create;
try try
values.Clear; values.Clear;
{ ini.ReadSection('TypeReplace', values); { ini.ReadSection('TypeReplace', values);
for i := 0 to values.Count - 1 do begin for i := 0 to values.Count - 1 do begin
a := values.ValueFromIndex[i]; a := values.ValueFromIndex[i];
@ -314,22 +333,49 @@ begin
end;} end;}
values.Clear; values.Clear;
a := ini.ReadString(CommonSec, 'mainunit', '');
if a <> '' then begin
b := '{%mainunit '+ a + '}';
for i := 0 to ConvertSettings.ConvertPrefix.Count - 1 do
if Pos(ConvertSettings.ConvertPrefix[i], '{%mainunit') = 1 then begin
ConvertSettings.ConvertPrefix[i] := b;
a := '';
Break;
end;
if a <> '' then
ConvertSettings.ConvertPrefix.Add(b);
end;
a := ini.ReadString(CommonSec, 'ignoreincludes', '');
ini.ReadSection('Common', values);
for i := 0 to values.Count - 1 do begin
if Pos('ignoreincludes', values[i]) = 1 then begin
b := ini.ReadString(CommonSec,values[i], '');
AddSpaceSeparated(b, ConvertSettings.IgnoreIncludes);
end;
end;
{ini.ReadSectionValues(IgnoreIncludesSec, values);
for i := 0 to values.Count - 1 do begin
ConvertSettings.IgnoreIncludes.AddStrings(values);
end;}
//ini.ReadSectionValues('ReplaceToken', values); //ini.ReadSectionValues('ReplaceToken', values);
ini.ReadSection('ReplaceToken', values); ini.ReadSection(TokenReplaceSec, values);
for i := 0 to values.Count - 1 do begin for i := 0 to values.Count - 1 do begin
a := Values[i]; a := Values[i];
b := ini.ReadString('ReplaceToken', a, ''); b := ini.ReadString(TokenReplaceSec, a, '');
if b ='' then if b ='' then
Settings.IgnoreTokens.Add(a); Settings.IgnoreTokens.Add(a);
end; end;
values.Clear; values.Clear;
ini.ReadSection('TypeDefs', values); ini.ReadSection(TypeDefsSec, values);
for i := 0 to values.Count - 1 do begin for i := 0 to values.Count - 1 do begin
a := Values[i]; a := Values[i];
b := AnsiLowerCase(ini.ReadString('TypeDefs', a, '')); b := AnsiLowerCase(ini.ReadString(TypeDefsSec, a, ''));
if b = 'objcclass' then if b = 'objcclass' then
Settings.ObjCTypes.Add(a) Settings.ObjCClassTypes.Add(a)
else if b = 'struct' then else if b = 'struct' then
Settings.StructTypes.Add(a) Settings.StructTypes.Add(a)
else if b = 'float' then else if b = 'float' then
@ -337,10 +383,10 @@ begin
end; end;
values.Clear; values.Clear;
ini.ReadSection('TypeReplace', values); ini.ReadSection(TypeReplaceSec, values);
for i := 0 to values.Count - 1 do begin for i := 0 to values.Count - 1 do begin
a := Values[i]; a := Values[i];
b := ini.ReadString('TypeReplace', a, ''); b := ini.ReadString(TypeReplaceSec, a, '');
if isNameofPointer(a) then if isNameofPointer(a) then
Settings.PtrTypeReplace[ Copy(a, 1, length(a) - 1)] := b Settings.PtrTypeReplace[ Copy(a, 1, length(a) - 1)] := b
else else
@ -369,35 +415,40 @@ begin
for i := 1 to ParamCount do begin for i := 1 to ParamCount do begin
if isParamValue(ParamStr(i), prm, vlm) then begin if isParamValue(ParamStr(i), prm, vlm) then begin
prm := AnsiLowerCase(prm); prm := AnsiLowerCase(prm);
if prm = 'mu' then prm := 'mainunit' if prm = 'noout' then doOutput:=false
else if prm = 'ii' then prm := 'ignoreinclude'; else if prm = 'all' then doparseAll:=true
else if prm = 'ini' then begin
ReadIniFile(Settings, vlm);
end else
Params.Values[prm] := vlm; Params.Values[prm] := vlm;
end else end else
FileName := ParamStr(i); FileName := ParamStr(i);
end; end;
vlm := Params.Values['ini']; vlm := Params.Values['uini'];
if vlm <> '' then
ReadIniFile(Settings, vlm);
vlm := Params.Values['mainunit'];
if vlm <> '' then
Settings.ConvertPrefix.Add ('{%mainunit '+vlm+'}');
vlm := Params.Values['ignoreinclude'];
if vlm <> '' then
AddSpaceSeparated(vlm, Settings.IgnoreIncludes);
vlm := Params.Values['updini'];
if vlm <> '' then if vlm <> '' then
updIni := vlm; updIni := vlm;
finally finally
Params.Free; Params.Free;
end; end;
Result := true; Result := true;
end; end;
procedure TypeHelp;
begin
writeln('Obj-C parser usage:');
writeln('objcparser [switches] objcheaderfilename');
writeln('');
writeln('keys:');
writeln(' -ini=filename.ini config file to use for pascal file generation');
writeln(' multiple "-ini" switches are allowed');
writeln(' -uini=filename.ini config file to update the data');
writeln(' -noout prevents from .inc files generated');
writeln(' -all parses headers (*.h) in the current directory');
end;
var var
inpf : AnsiString = ''; inpf : AnsiString = '';
st : TStrings = nil; st : TStrings = nil;
@ -406,20 +457,26 @@ var
begin begin
doOutput := true;
try try
GetConvertSettings(ConvertSettings, inpf); GetConvertSettings(ConvertSettings, inpf);
if not FileExists(inpf) then begin if doParseAll then begin
ParseAll; ParseAll;
Exit; Exit;
end else if not FileExists(inpf) then begin
TypeHelp;
Exit;
end; end;
st := TStringList.Create; st := TStringList.Create;
try try
if not ReadAndParseFile(inpf, st, err) then if not ReadAndParseFile(inpf, st, err) then
writeln('Error: ', err) writeln('Error: ', err)
else else begin
if doOutput then
for i := 0 to st.Count - 1 do for i := 0 to st.Count - 1 do
writeln(st[i]); writeln(st[i]);
end;
except except
end; end;
st.Free; st.Free;