2009-02-25 19:40:38 +00:00
|
|
|
{ * This file is part of ObjCParser tool
|
2009-01-17 22:24:04 +00:00
|
|
|
* Copyright (C) 2008-2009 by Dmitry Boyarintsev under the GNU LGPL
|
|
|
|
* license version 2.0 or 2.1. You should have received a copy of the
|
2009-02-25 19:40:38 +00:00
|
|
|
* LGPL license along with at http://www.gnu.org/
|
2008-03-25 08:24:19 +00:00
|
|
|
}
|
|
|
|
|
2008-04-07 14:06:35 +00:00
|
|
|
unit ObjCParserUtils;
|
2008-03-25 08:24:19 +00:00
|
|
|
|
|
|
|
interface
|
2008-04-15 14:13:34 +00:00
|
|
|
|
2009-01-17 22:24:04 +00:00
|
|
|
{$ifdef fpc}
|
|
|
|
{$mode delphi}{$H+}
|
|
|
|
{$else}
|
|
|
|
{$warn unsafe_code off}
|
|
|
|
{$warn unsafe_type off}
|
|
|
|
{$warn unsafe_cast off}
|
|
|
|
{$endif}
|
2008-03-25 08:24:19 +00:00
|
|
|
|
|
|
|
uses
|
2009-02-16 11:50:17 +00:00
|
|
|
Classes, SysUtils, ObjCParserTypes, ObjCToPas;
|
2008-04-07 14:06:35 +00:00
|
|
|
|
|
|
|
type
|
|
|
|
{ TConvertSettings }
|
|
|
|
//todo: hash table
|
|
|
|
TReplace = class(TObject)
|
|
|
|
Src : AnsiString;
|
|
|
|
Dst : AnsiString;
|
|
|
|
end;
|
|
|
|
|
|
|
|
TReplaceItem = class(TObject)
|
|
|
|
ReplaceStr : AnsiString;
|
|
|
|
end;
|
|
|
|
|
|
|
|
TReplaceList = class(TObject)
|
|
|
|
private
|
|
|
|
fItems : TStringList;
|
|
|
|
protected
|
|
|
|
function GetReplace(const ARepl: AnsiString): AnsiString;
|
|
|
|
procedure SetReplace(const ARepl, AValue: AnsiString);
|
|
|
|
|
|
|
|
function GetCaseSense: Boolean;
|
|
|
|
procedure SetCaseSense(AValue: Boolean);
|
|
|
|
public
|
|
|
|
constructor Create;
|
|
|
|
destructor Destroy; override;
|
|
|
|
property Replace[const s: AnsiString]: AnsiString read GetReplace write SetReplace; default;
|
|
|
|
property CaseSensetive: Boolean read GetCaseSense write SetCaseSense;
|
|
|
|
end;
|
|
|
|
|
|
|
|
TConvertSettings = class(TObject)
|
|
|
|
public
|
|
|
|
IgnoreIncludes : TStringList;
|
|
|
|
DefineReplace : TReplaceList;
|
|
|
|
TypeDefReplace : TReplaceList; // replaces for C types
|
2008-04-25 13:47:19 +00:00
|
|
|
PtrTypeReplace : TReplaceList; // replaces for C types pointers
|
2008-04-29 14:10:17 +00:00
|
|
|
|
2008-04-15 14:13:34 +00:00
|
|
|
IgnoreTokens : TStringList;
|
2008-04-08 09:22:54 +00:00
|
|
|
|
|
|
|
ConvertPrefix : TStringList;
|
2008-04-29 14:10:17 +00:00
|
|
|
|
2008-04-22 08:07:37 +00:00
|
|
|
FloatTypes : TStringList;
|
|
|
|
StructTypes : TStringList;
|
2008-04-29 14:10:17 +00:00
|
|
|
ObjCClassTypes : TStringList;
|
|
|
|
|
|
|
|
CustomTypes : TStringList;
|
|
|
|
|
2008-04-07 14:06:35 +00:00
|
|
|
constructor Create;
|
|
|
|
destructor Destroy; override;
|
2008-04-29 14:10:17 +00:00
|
|
|
|
|
|
|
procedure AssignNewTypeName(const AName, TypeDefStr: AnsiString; var NewTypeName: AnsiString);
|
2008-04-07 14:06:35 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
|
|
ConvertSettings : TConvertSettings;
|
|
|
|
|
2008-04-22 08:07:37 +00:00
|
|
|
type
|
|
|
|
TObjcConvertVarType = (vt_Int, vt_FloatPoint, vt_Struct, vt_Object);
|
|
|
|
|
2008-03-25 08:24:19 +00:00
|
|
|
procedure WriteOutIncludeFile(hdr: TObjCHeader; st: TStrings);
|
2008-04-07 14:06:35 +00:00
|
|
|
procedure WriteOutMainFramework(hdr: TObjCHeader; st: TStrings);
|
2008-03-25 08:24:19 +00:00
|
|
|
|
2008-04-01 06:29:04 +00:00
|
|
|
function ObjCToDelphiType(const objcType: AnsiString; isPointer: Boolean): AnsiString;
|
2008-04-29 14:10:17 +00:00
|
|
|
function ObjCResultToDelphiType(Res: TObjCResultTypeDef) : AnsiString;
|
|
|
|
function CToDelphiFuncType(AFuncType: TFunctionTypeDef): AnsiString;
|
2008-03-25 08:24:19 +00:00
|
|
|
|
|
|
|
function StrFromFile(const FileName: AnsiString): AnsiString;
|
|
|
|
|
|
|
|
function IsMethodConstructor(cl: TClassDef; m: TClassMethodDef): Boolean;
|
|
|
|
function GetMethodStr(cl: TClassDef; m: TClassMethodDef; ForImplementation: Boolean): AnsiString;
|
|
|
|
function GetProcFuncHead(const FuncName, OfClass, Params, ResType: AnsiString; const FuncDest: AnsiString = ''): AnsiString;
|
2008-04-29 14:10:17 +00:00
|
|
|
function GetMethodParams(const m: TClassMethodDef; NamesOnly: Boolean): AnsiString;
|
2008-03-25 08:24:19 +00:00
|
|
|
function GetMethodResultType(const m: TClassMethodDef): AnsiString;
|
2008-04-01 06:29:04 +00:00
|
|
|
function IsPascalReserved(const s: AnsiString): Boolean;
|
2008-03-25 08:24:19 +00:00
|
|
|
|
2008-04-22 08:07:37 +00:00
|
|
|
function IsPascalFloatType(const TypeName: AnsiString): Boolean;
|
|
|
|
|
|
|
|
function GetObjCVarType(const TypeName: AnsiString):TObjcConvertVarType; //): Boolean; = (vt_Int, vt_FloatPoint, vt_Struct, vt_Object);
|
|
|
|
|
2008-03-25 08:24:19 +00:00
|
|
|
implementation
|
|
|
|
|
2009-02-16 20:30:58 +00:00
|
|
|
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;
|
|
|
|
|
|
|
|
|
2008-04-15 14:13:34 +00:00
|
|
|
procedure WriteOutRecordField(AField: TStructField; const Prefix: AnsiString; subs: TStrings); forward;
|
2009-01-17 22:24:04 +00:00
|
|
|
procedure WriteOutRecord(struct: TEntityStruct; const Prefix, RecPrefix : AnsiString; subs: TStrings); forward;
|
2008-04-15 14:13:34 +00:00
|
|
|
|
2008-04-22 08:07:37 +00:00
|
|
|
function GetObjCVarType(const TypeName: AnsiString):TObjcConvertVarType;
|
|
|
|
begin
|
|
|
|
Result := vt_Int;
|
|
|
|
if IsPascalFloatType(TypeName) then begin
|
|
|
|
Result := vt_FloatPoint;
|
|
|
|
Exit;
|
|
|
|
end;
|
2008-04-29 14:10:17 +00:00
|
|
|
|
2008-04-22 08:07:37 +00:00
|
|
|
if ConvertSettings.FloatTypes.IndexOf(TypeName) >= 0 then
|
|
|
|
Result := vt_FloatPoint
|
|
|
|
else if ConvertSettings.StructTypes.IndexOf(TypeName) >= 0 then
|
|
|
|
Result := vt_Struct
|
2008-04-29 14:10:17 +00:00
|
|
|
else if ConvertSettings.ObjCClassTypes.IndexOf(TypeName) >= 0 then
|
2008-04-22 08:07:37 +00:00
|
|
|
Result := vt_Object;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function IsPascalFloatType(const TypeName: AnsiString): Boolean;
|
|
|
|
var
|
|
|
|
nm : AnsiString;
|
|
|
|
begin
|
|
|
|
Result := false;
|
|
|
|
if TypeName = '' then Exit;
|
|
|
|
case TypeName[1] of
|
|
|
|
'd','D','f','F': begin
|
|
|
|
nm := AnsiLowerCase(typeName);
|
|
|
|
Result := (nm = 'double') or (TypeName = 'float');
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2008-04-22 11:13:59 +00:00
|
|
|
|
|
|
|
// 'result' is considered reserved word!
|
2008-04-01 06:29:04 +00:00
|
|
|
function IsPascalReserved(const s: AnsiString): Boolean;
|
|
|
|
var
|
|
|
|
ls : AnsiString;
|
|
|
|
begin
|
2008-04-22 11:13:59 +00:00
|
|
|
//todo: a hash table should be used!
|
|
|
|
Result := false;
|
2008-04-01 06:29:04 +00:00
|
|
|
if s = '' then Exit;
|
|
|
|
ls := AnsiLowerCase(s);
|
|
|
|
case ls[1] of
|
|
|
|
'a': Result := (ls = 'absolute') or (ls = 'abstract') or (ls = 'and') or (ls = 'array') or (ls = 'as') or (ls= 'asm') or (ls = 'assembler');
|
|
|
|
'b': Result := (ls = 'begin') or (ls = 'break');
|
|
|
|
'c': Result := (ls = 'cdecl') or (ls = 'class') or (ls = 'const') or (ls = 'constructor') or (ls = 'continue') or (ls = 'cppclass');
|
|
|
|
'd': Result := (ls = 'deprecated') or (ls = 'destructor') or (ls = 'div') or (ls = 'do') or (ls = 'downto');
|
|
|
|
'e': Result := (ls = 'else') or (ls = 'end') or (ls = 'except') or (ls = 'exit') or (ls = 'export') or (ls = 'exports') or (ls = 'external');
|
|
|
|
'f': Result := (ls = 'fail') or (ls = 'false') or (ls = 'far') or (ls = 'file') or (ls = 'finally') or (ls = 'for') or (ls = 'forward') or (ls = 'function');
|
|
|
|
'g': Result := (ls = 'goto');
|
|
|
|
'i':
|
|
|
|
Result := (ls = 'if') or (ls = 'implementation') or (ls = 'in') or (ls = 'index') or (ls = 'inherited') or (ls = 'initialization') or (ls = 'inline')
|
|
|
|
or (ls = 'interface') or (ls = 'interrupt') or (ls = 'is');
|
|
|
|
'l': Result := (ls = 'label') or (ls = 'library');
|
|
|
|
'm': Result := (ls = 'mod');
|
|
|
|
'n': Result := {(ls = 'name') or} (ls = 'near') or (ls = 'nil') or (ls = 'not');
|
|
|
|
'o': Result := (ls = 'object') or (ls = 'of') or (ls = 'on') or (ls = 'operator') or (ls = 'or') or (ls = 'otherwise');
|
|
|
|
'p':
|
|
|
|
Result := (ls = 'packed') or (ls = 'popstack') or (ls = 'private') or (ls = 'procedure') or (ls = 'program') or (ls = 'property')
|
|
|
|
or (ls = 'protected') or (ls = 'public');
|
2008-04-22 11:13:59 +00:00
|
|
|
'r': Result := (ls = 'raise') or (ls = 'record') or (ls = 'reintroduce') or (ls = 'repeat') or (ls = 'result');
|
2008-04-01 06:29:04 +00:00
|
|
|
's': Result := (ls = 'self') or (ls = 'set') or (ls = 'shl') or (ls = 'shr') or (ls = 'stdcall') or (ls = 'string');
|
|
|
|
't': Result := (ls = 'then') or (ls = 'to') or (ls = 'true') or (ls = 'try') or (ls = 'type');
|
|
|
|
'u': Result := (ls = 'unimplemented') or (ls = 'unit') or (ls = 'until') or (ls = 'uses');
|
|
|
|
'v': Result := (ls = 'var') or (ls = 'virtual');
|
|
|
|
'w': Result := (ls = 'while') or (ls = 'with');
|
|
|
|
'x': Result := (ls = 'xor');
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2008-04-15 14:13:34 +00:00
|
|
|
function FixIfReserved(const AName: AnsiString; NotUse: TStrings = nil): AnsiString;
|
|
|
|
begin
|
|
|
|
Result := AName;
|
|
|
|
if isPascalReserved(AName) then
|
|
|
|
Result := '_'+AName;
|
|
|
|
if Assigned(NotUse) then begin
|
|
|
|
while (NotUse.IndexOf(Result) >= 0) do
|
|
|
|
Result := '_' + Result;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2008-03-25 08:24:19 +00:00
|
|
|
function GetMethodResultType(const m: TClassMethodDef): AnsiString;
|
2008-04-01 06:29:04 +00:00
|
|
|
var
|
|
|
|
res : TObjCResultTypeDef;
|
2008-04-29 14:10:17 +00:00
|
|
|
tp : TTypeDef;
|
2008-03-25 08:24:19 +00:00
|
|
|
begin
|
2008-04-01 06:29:04 +00:00
|
|
|
res := m.GetResultType;
|
|
|
|
if not Assigned(res) then Result := ''
|
2008-04-29 14:10:17 +00:00
|
|
|
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;
|
2008-03-25 08:24:19 +00:00
|
|
|
end;
|
|
|
|
|
2008-04-29 14:10:17 +00:00
|
|
|
function GetMethodParams(const m: TClassMethodDef; NamesOnly: Boolean): AnsiString;
|
2008-03-25 08:24:19 +00:00
|
|
|
var
|
|
|
|
i : Integer;
|
|
|
|
p : TObject;
|
|
|
|
vname : AnsiString;
|
|
|
|
vtype : AnsiString;
|
2008-04-29 14:10:17 +00:00
|
|
|
|
|
|
|
tp : TTypeDef;
|
|
|
|
prc : AnsiString;
|
|
|
|
|
2008-03-25 08:24:19 +00:00
|
|
|
begin
|
|
|
|
Result := '';
|
|
|
|
vname := '';
|
|
|
|
vtype := '';
|
|
|
|
for i := 0 to m.Items.Count - 1 do begin
|
|
|
|
p := TObject(m.Items[i]);
|
2008-04-29 14:10:17 +00:00
|
|
|
|
|
|
|
if p is TParamDescr then begin
|
|
|
|
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
|
2008-04-30 13:51:19 +00:00
|
|
|
prc := 'TProc' + TClassDef(m.Owner)._ClassName + TObjCParameterDef(p)._Name + IntToStr(ConvertSettings.CustomTypes.Count);
|
2008-04-29 14:10:17 +00:00
|
|
|
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;
|
2008-04-17 13:58:59 +00:00
|
|
|
|
2008-04-29 14:10:17 +00:00
|
|
|
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;
|
2008-03-25 08:24:19 +00:00
|
|
|
vname := '';
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
function GetProcFuncHead(const FuncName, OfClass, Params, ResType, FuncDest: AnsiString): AnsiString;
|
|
|
|
begin
|
|
|
|
if FuncDest = '' then begin
|
|
|
|
if ResType = '' then Result := 'procedure '
|
|
|
|
else Result := 'function ';
|
|
|
|
end else
|
|
|
|
Result := FuncDest + ' ';
|
|
|
|
|
|
|
|
if OfClass <> '' then Result := Result + OfClass+'.';
|
|
|
|
Result := Result + FuncName;
|
|
|
|
if Params <> '' then
|
|
|
|
Result := Result + '('+Params+')';
|
2008-04-01 06:29:04 +00:00
|
|
|
if ResType <> '' then Result := Result+': '+ResType;
|
2008-03-25 08:24:19 +00:00
|
|
|
Result := Result + ';';
|
|
|
|
end;
|
|
|
|
|
|
|
|
function StrFromFile(const FileName: AnsiString): AnsiString;
|
|
|
|
var
|
|
|
|
fs : TFileStream;
|
|
|
|
begin
|
|
|
|
fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
|
|
|
|
try
|
|
|
|
SetLength(Result, fs.Size);
|
|
|
|
fs.Read(Result[1], fs.Size);
|
|
|
|
finally
|
|
|
|
fs.Free;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2008-04-01 06:29:04 +00:00
|
|
|
function ObjCToDelphiType(const objcType: AnsiString; isPointer: Boolean): AnsiString;
|
2008-03-25 08:24:19 +00:00
|
|
|
var
|
|
|
|
l : AnsiString;
|
2008-04-07 14:06:35 +00:00
|
|
|
r : AnsiString;
|
2008-03-25 08:24:19 +00:00
|
|
|
begin
|
|
|
|
Result := objcType;
|
|
|
|
l := AnsiLowerCase(objcType);
|
|
|
|
if l = '' then Exit;
|
|
|
|
case l[1] of
|
|
|
|
'v':
|
2008-04-01 06:29:04 +00:00
|
|
|
if l = 'void' then begin
|
|
|
|
if not isPointer then Result := ''
|
2008-04-25 13:47:19 +00:00
|
|
|
else begin
|
|
|
|
Result := 'Pointer';
|
|
|
|
Exit;
|
|
|
|
end;
|
2008-04-01 06:29:04 +00:00
|
|
|
end;
|
2008-03-25 08:24:19 +00:00
|
|
|
'i':
|
|
|
|
if l = 'id' then Result := 'objc.id'
|
|
|
|
else if l = 'int' then Result := 'Integer';
|
|
|
|
'b':
|
|
|
|
if l = 'bool' then Result := 'LongBool';
|
|
|
|
'l':
|
|
|
|
if l = 'long' then Result := 'Integer';
|
|
|
|
's':
|
|
|
|
if l = 'short' then Result := 'SmallInt';
|
|
|
|
'u':
|
|
|
|
if (l = 'unsigned long') or (l = 'usigned int') then
|
|
|
|
Result := 'LongWord'
|
|
|
|
else if (l = 'unsigned short') then
|
|
|
|
Result := 'Word';
|
|
|
|
'f':
|
|
|
|
if l = 'float' then Result := 'Single';
|
|
|
|
end;
|
2008-04-25 13:47:19 +00:00
|
|
|
|
2009-02-25 19:40:38 +00:00
|
|
|
|
2008-04-07 14:06:35 +00:00
|
|
|
if Result = objcType then begin
|
2008-04-25 13:47:19 +00:00
|
|
|
if isPointer then r := ConvertSettings.PtrTypeReplace[objcType]
|
|
|
|
else r := ConvertSettings.TypeDefReplace[objcType];
|
|
|
|
if r <> '' then
|
|
|
|
Result := r;
|
2008-04-07 14:06:35 +00:00
|
|
|
end;
|
2009-02-25 19:40:38 +00:00
|
|
|
|
2008-04-25 13:47:19 +00:00
|
|
|
if isPointer then begin
|
2008-04-16 14:33:21 +00:00
|
|
|
if ((objctype = 'char') or (objctype = 'const char')) then
|
|
|
|
Result := 'PChar'
|
2008-04-25 13:47:19 +00:00
|
|
|
end;
|
2008-04-22 08:07:37 +00:00
|
|
|
end;
|
2008-03-28 10:25:27 +00:00
|
|
|
|
2008-04-29 14:10:17 +00:00
|
|
|
function ObjCResultToDelphiType(Res: TObjCResultTypeDef) : AnsiString;
|
|
|
|
begin
|
|
|
|
if Res._Type is TTypeDef then
|
2009-02-25 19:40:38 +00:00
|
|
|
Result := ObjCToDelphiType( TTypeDef(Res._Type)._Name, TTypeDef(Res._Type)._IsPointer)
|
2008-04-29 14:10:17 +00:00
|
|
|
else begin
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2008-03-25 08:24:19 +00:00
|
|
|
function IsMethodConstructor(cl: TClassDef; m: TClassMethodDef): Boolean;
|
|
|
|
var
|
2008-04-01 06:29:04 +00:00
|
|
|
res : TObjCResultTypeDef;
|
2008-03-25 08:24:19 +00:00
|
|
|
l : AnsiString;
|
|
|
|
begin
|
|
|
|
Result := m._IsClassMethod;
|
|
|
|
if not Result then begin
|
|
|
|
//todo: C is case sensetive, so is it possible to have a initialing function name like
|
|
|
|
// 'InitWithSomething', rather than 'initWithSomething' (that is should be)???
|
|
|
|
//todo: to make sure, it's not a name,like 'Initialzation';
|
|
|
|
l := AnsiLowerCase(m._Name);
|
|
|
|
if Pos('init', l) = 1 then Result := true;
|
|
|
|
end;
|
|
|
|
if not Result then Exit;
|
|
|
|
|
|
|
|
res := m.GetResultType;
|
2008-04-29 14:10:17 +00:00
|
|
|
if res._Type is TTypeDef then
|
|
|
|
l := TTypeDef(res._Type)._Name
|
|
|
|
else
|
|
|
|
l := '!!!todo function';
|
2008-03-25 08:24:19 +00:00
|
|
|
Result := (l = 'id') or (l = cl._ClassName);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function GetMethodStr(cl: TClassDef; m: TClassMethodDef; ForImplementation: Boolean): AnsiString;
|
|
|
|
var
|
2008-04-01 06:29:04 +00:00
|
|
|
// i : integer;
|
2008-04-17 13:58:59 +00:00
|
|
|
nm : AnsiString;
|
2008-03-25 08:24:19 +00:00
|
|
|
ft : AnsiString;
|
2008-04-01 06:29:04 +00:00
|
|
|
res : AnsiString;
|
2008-03-25 08:24:19 +00:00
|
|
|
begin
|
2008-04-01 06:29:04 +00:00
|
|
|
res := GetMethodResultType(m);
|
|
|
|
if IsMethodConstructor(cl, m) then begin
|
|
|
|
ft := 'constructor';
|
|
|
|
res := '';
|
|
|
|
end else
|
|
|
|
ft := '';
|
|
|
|
|
2008-04-17 13:58:59 +00:00
|
|
|
nm := m._Name;
|
2008-03-25 08:24:19 +00:00
|
|
|
if ForImplementation
|
2008-04-29 14:10:17 +00:00
|
|
|
then Result := GetProcFuncHead(nm, cl._ClassName, GetMethodParams(m, false), res, ft)
|
|
|
|
else Result := GetProcFuncHead(nm, '', GetMethodParams(m, false), res, ft);
|
2008-04-23 07:59:44 +00:00
|
|
|
|
|
|
|
if ft = '' then
|
|
|
|
if m._IsClassMethod then
|
|
|
|
Result := 'class ' + Result;
|
2008-03-25 08:24:19 +00:00
|
|
|
end;
|
|
|
|
|
2008-03-27 15:28:02 +00:00
|
|
|
// returns define pas file name form Objective C name, like
|
|
|
|
// NSApplication.h -> NSAPPLICATION_PAS_H
|
|
|
|
// SomePath/SomePath/SomeFileName.h -> SOMEFILENAME_PAS_H
|
2008-03-28 13:03:13 +00:00
|
|
|
function GetIfDefFileName(const FileName, DefExt: AnsiString): AnsiString;
|
2008-03-25 08:24:19 +00:00
|
|
|
var
|
|
|
|
i : integer;
|
2008-04-01 06:29:04 +00:00
|
|
|
// s : AnsiString;
|
2008-03-25 08:24:19 +00:00
|
|
|
begin
|
2008-03-27 15:28:02 +00:00
|
|
|
//todo: don't like it...
|
2008-03-25 08:24:19 +00:00
|
|
|
Result := Copy(FileName, 1, length(FileName) - length(ExtractFileExt(FileName)));
|
|
|
|
Result := AnsiUpperCase(Result);
|
|
|
|
for i := 1 to length(Result) do
|
|
|
|
if Result[i] = '.' then
|
|
|
|
Result[i] := '_';
|
2008-03-28 13:03:13 +00:00
|
|
|
Result := Result + '_PAS_'+DefExt;
|
2008-03-25 08:24:19 +00:00
|
|
|
end;
|
|
|
|
|
2008-03-27 15:28:02 +00:00
|
|
|
// returns include pas file name form Objective C name, like
|
|
|
|
// <AppKit/NSApplication.h> -> NSApplication.inc
|
|
|
|
// "SomePath/SomePath/SomeFileName.h> -> SomeFileName.h
|
|
|
|
function GetIncludeFile(const s: AnsiString): AnsiString;
|
|
|
|
var
|
|
|
|
i : Integer;
|
2008-04-08 10:45:08 +00:00
|
|
|
vs : AnsiString;
|
|
|
|
pth : AnsiString;
|
2008-03-27 15:28:02 +00:00
|
|
|
begin
|
2008-04-08 10:45:08 +00:00
|
|
|
//todo: still, i don't like it...
|
|
|
|
Result :='';
|
|
|
|
i := 1;
|
|
|
|
ScanWhile(s, i, [#32, #9]);
|
|
|
|
vs := Copy(s, i, length(s) - i + 1);
|
|
|
|
if vs = '' then Exit;
|
|
|
|
|
|
|
|
|
|
|
|
if (vs[1] = '<') or (vs[1] = '"') then vs := Copy(vs, 2, length(vs) - 1);
|
|
|
|
if vs = '' then Exit;
|
|
|
|
|
|
|
|
i := length(vs);
|
|
|
|
if (vs[i] = '>') or (vs[i] = '"') then vs := Copy(vs, 1, length(vs) - 1);
|
|
|
|
if vs = '' then Exit;
|
|
|
|
|
|
|
|
pth := vs;
|
2008-04-15 14:13:34 +00:00
|
|
|
|
2008-04-08 10:45:08 +00:00
|
|
|
while (pth <> '') and (length(pth)>1) do begin
|
|
|
|
if ConvertSettings.IgnoreIncludes.IndexOf(pth) >= 0 then
|
|
|
|
Exit; // file must be excluded;
|
|
|
|
pth := ExtractFilePath(ExcludeTrailingPathDelimiter(pth));
|
|
|
|
end;
|
2008-04-15 14:13:34 +00:00
|
|
|
|
2008-04-08 10:45:08 +00:00
|
|
|
Result := ExtractFileName(vs);
|
|
|
|
Result := Copy(Result, 1, length(Result) - length(ExtractFileExt(vs))) + '.inc';
|
|
|
|
(*
|
2008-03-27 15:28:02 +00:00
|
|
|
Result := '';
|
|
|
|
if s = '' then Exit;
|
2008-04-01 06:29:04 +00:00
|
|
|
// i := length(s);
|
|
|
|
{ if (s[i] = '"') or (s[i] = '>') then
|
|
|
|
dec(i);}
|
2008-03-27 15:28:02 +00:00
|
|
|
i := length(s) - 1;
|
|
|
|
// dummy, but it works =)
|
|
|
|
while (i > 0) and (s[i] in ['.', 'A'..'Z', 'a'..'z', '0'..'9']) do dec(i);
|
|
|
|
|
2008-04-08 10:45:08 +00:00
|
|
|
Result := Copy(s, i + 1, length(s) - i);*)
|
2008-03-27 15:28:02 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
// returns pascal style of precomiler "if defined" section
|
|
|
|
// exclusion is done for Cocoa known precompiler definion, for ex:
|
|
|
|
// MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_3 -> MAC_OS_X_VERSION_10_3
|
|
|
|
// any other #ifdef excpresions would be passed "as is" even if are incorrect
|
|
|
|
// for pascal
|
2008-04-07 14:06:35 +00:00
|
|
|
function PrecompileIfDefToPascal(const prm: AnsiString; var isDef: Boolean): AnsiString;
|
2008-03-27 15:28:02 +00:00
|
|
|
var
|
|
|
|
i : Integer;
|
2008-04-07 14:06:35 +00:00
|
|
|
vs : AnsiString;
|
2008-03-27 15:28:02 +00:00
|
|
|
begin
|
2008-04-07 14:06:35 +00:00
|
|
|
i := 1;
|
|
|
|
ScanWhile(prm, i, [#32, #9]);
|
|
|
|
if prm[i] = '!' then begin
|
|
|
|
isDef := false;
|
|
|
|
inc(i);
|
|
|
|
ScanWhile(prm, i, [#32, #9]);
|
|
|
|
end else
|
|
|
|
isDef :=true;
|
|
|
|
vs := Copy(prm, i, length(prm) - i + 1);
|
|
|
|
|
2008-03-27 15:28:02 +00:00
|
|
|
// really slow... and... don't like this anyway!
|
2008-04-07 14:06:35 +00:00
|
|
|
vs := ConvertSettings.DefineReplace[vs];
|
|
|
|
if vs <> ''
|
|
|
|
then Result := vs
|
|
|
|
else Result := prm;
|
|
|
|
{ for i := 0 to ConvertSettings.DefineReplace.C
|
2008-03-27 15:28:02 +00:00
|
|
|
Result := prm;
|
|
|
|
i := Pos(VerExclude, prm);
|
|
|
|
if i > 0 then begin
|
|
|
|
i := i + length(VerExclude);
|
|
|
|
while (i <= length(Result)) and (Result[i] = ' ') do inc(i);
|
|
|
|
if i <= length(Result) then
|
|
|
|
Result := Copy(prm, i, length(Result) - i + 1);
|
2008-04-07 14:06:35 +00:00
|
|
|
end;}
|
2008-03-27 15:28:02 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
// converts TProcpmiler entity to pascal entity
|
|
|
|
// #import or #include -> {$Include Something.inc}
|
|
|
|
// #define SOMETHING -> {$define SOMETHING}
|
|
|
|
// #ifdef SOMETHING -> {$ifdef SOMETHING}
|
|
|
|
// etc...
|
|
|
|
function WriteOutPrecompToPascal(Prec: TPrecompiler): AnsiString;
|
|
|
|
var
|
|
|
|
dir : AnsiString;
|
2008-04-07 14:06:35 +00:00
|
|
|
prm : AnsiString;
|
|
|
|
isdef : Boolean;
|
|
|
|
const
|
|
|
|
isdefConst : array [Boolean] of AnsiString = ('ifndef', 'ifdef');
|
2008-03-27 15:28:02 +00:00
|
|
|
begin
|
|
|
|
dir := AnsiLowerCase(Prec._Directive);
|
2008-04-07 14:06:35 +00:00
|
|
|
if (dir = '#import') or (dir = '#include') then begin
|
|
|
|
|
|
|
|
prm := GetIncludeFile(Prec._Params);
|
2008-04-29 14:10:17 +00:00
|
|
|
if (prm <> '') and (prm <> ' .inc') then
|
2008-04-07 14:06:35 +00:00
|
|
|
Result := Format('{$include %s}', [prm]);
|
|
|
|
|
|
|
|
end else if (dir = '#if') then begin
|
|
|
|
prm := PrecompileIfDefToPascal(Prec._Params, isdef);
|
2008-04-22 08:07:37 +00:00
|
|
|
Result := Format('{.$%s %s}', [isdefConst[isdef], prm]);
|
2008-04-07 14:06:35 +00:00
|
|
|
end else if (dir = '#else') then
|
2008-04-22 08:07:37 +00:00
|
|
|
Result := '{.$else}'
|
2008-03-27 15:28:02 +00:00
|
|
|
else if (dir = '#endif') then
|
2008-04-22 08:07:37 +00:00
|
|
|
Result := '{.$endif}';
|
2008-03-27 15:28:02 +00:00
|
|
|
end;
|
|
|
|
|
2008-03-28 10:25:27 +00:00
|
|
|
procedure WriteOutCommentStr(const AComment, Prefix: AnsiString; Subs: TStrings);
|
|
|
|
var
|
|
|
|
i : Integer;
|
|
|
|
j : Integer;
|
|
|
|
k : Integer;
|
|
|
|
cmtln : AnsiString;
|
|
|
|
begin
|
|
|
|
i := 1;
|
|
|
|
while i <= length(AComment) do begin
|
|
|
|
// scan for multylined comments
|
|
|
|
cmtln := ScanTo(AComment, i, [#10, #13]);
|
|
|
|
if i < length(AComment) then begin
|
|
|
|
if (AComment[i] = #10) and (AComment[i+1] = #13) then inc(i)
|
|
|
|
else if (AComment[i] = #13) and (AComment[i+1] = #10) then inc(i);
|
|
|
|
end;
|
|
|
|
inc(i);
|
|
|
|
|
|
|
|
// break long comments into lines
|
|
|
|
j := 1;
|
|
|
|
while j <= length(cmtln) do begin
|
|
|
|
k := j;
|
|
|
|
inc(j, 80);
|
|
|
|
if j > length(cmtln) then j := length(cmtln);
|
|
|
|
ScanTo(cmtln, j, [#32, #10, #13, #9]);
|
|
|
|
subs.Add(Prefix + '// ' + Copy(cmtln, k, j - k));
|
|
|
|
inc(j);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure WriteOutIfComment(Items: TList; Index: Integer; const Prefix: AnsiString; Subs: TStrings);
|
|
|
|
var
|
|
|
|
j : integer;
|
|
|
|
begin
|
|
|
|
if (Index < 0) or (Index >= Items.Count) then Exit;
|
2009-01-26 09:17:47 +00:00
|
|
|
|
2008-03-28 10:25:27 +00:00
|
|
|
j := Index;
|
|
|
|
while (j >= 0) and (TObject(Items[j]) is TComment) do dec(j);
|
|
|
|
inc(j);
|
|
|
|
for j := j to index do
|
|
|
|
//if TObject(Items[Index]) is TComment then
|
|
|
|
WriteOutCommentStr( TComment(Items[j])._Comment, Prefix, Subs);
|
|
|
|
end;
|
|
|
|
|
2008-03-27 15:28:02 +00:00
|
|
|
// clears empty precompile statements, like
|
|
|
|
// {$ifdef SOMETHING}
|
|
|
|
// {$endif}
|
|
|
|
// and
|
|
|
|
// {$ifdef SOMETHING}
|
|
|
|
// {$else}
|
|
|
|
// {$endif}
|
|
|
|
// will be removed
|
|
|
|
procedure ClearEmptyPrecompile(subs: TStrings);
|
|
|
|
var
|
|
|
|
i : integer;
|
|
|
|
j : Integer;
|
|
|
|
begin
|
|
|
|
// don't like it either...
|
|
|
|
i := subs.Count - 1; if i < 0 then Exit;
|
|
|
|
j := i;
|
|
|
|
|
|
|
|
if Pos('{$endif', subs[i]) = 0 then Exit;
|
|
|
|
dec(i); if i < 0 then Exit;
|
|
|
|
|
|
|
|
if Pos('{$else', subs[i]) > 0 then
|
|
|
|
dec(i); if i < 0 then Exit;
|
|
|
|
|
|
|
|
if Pos('{$ifdef', subs[i]) > 0 then
|
|
|
|
for i := j downto i do
|
|
|
|
subs.Delete(i);
|
|
|
|
end;
|
|
|
|
|
2008-03-28 13:03:13 +00:00
|
|
|
procedure BeginSection(const SectionName: AnsiString; st: TStrings);
|
2008-03-25 08:24:19 +00:00
|
|
|
begin
|
2008-04-08 09:22:54 +00:00
|
|
|
st.Add('');
|
2008-03-25 08:24:19 +00:00
|
|
|
st.Add('{$ifdef '+SectionName+'}');
|
2008-03-28 13:03:13 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
procedure BeginExcludeSection(const DefineName: AnsiString; st: TStrings);
|
|
|
|
begin
|
|
|
|
st.Add('{$ifndef '+DefineName+'}');
|
|
|
|
st.Add('{$define '+DefineName+'}');
|
2008-04-08 09:22:54 +00:00
|
|
|
st.Add('');
|
2008-03-25 08:24:19 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
procedure EndSection(st: TStrings);
|
|
|
|
begin
|
|
|
|
st.Add('{$endif}');
|
|
|
|
end;
|
|
|
|
|
2008-03-27 15:28:02 +00:00
|
|
|
// todo: remove Prefix param...
|
2008-03-28 10:25:27 +00:00
|
|
|
procedure WriteOutIfDefPrecompiler(prec: TPrecompiler; const Prefix: AnsiString; subs: TStrings);
|
2008-03-27 15:28:02 +00:00
|
|
|
var
|
|
|
|
ppas : AnsiString;
|
|
|
|
isend : Boolean;
|
|
|
|
begin
|
|
|
|
ppas := WriteOutPrecompToPascal(prec);
|
2008-04-22 08:07:37 +00:00
|
|
|
isend := IsSubStr('{.$endif', ppas, 1);
|
|
|
|
if isend or IsSubStr('{.$ifndef', ppas, 1) or IsSubStr('{.$ifdef', ppas, 1) or IsSubStr('{.$else', ppas, 1) then
|
2008-03-27 15:28:02 +00:00
|
|
|
subs.Add(Prefix + ppas);
|
|
|
|
if isend then ClearEmptyPrecompile(subs);
|
|
|
|
end;
|
|
|
|
|
2008-04-08 09:22:54 +00:00
|
|
|
function GetClassConst(const ClassName, ConstName: AnsiString): AnsiString;
|
|
|
|
begin
|
|
|
|
Result := Format('Str%s_%s', [ClassName, ConstName]);
|
|
|
|
end;
|
|
|
|
|
2008-04-17 13:58:59 +00:00
|
|
|
|
|
|
|
function GetMethodConstName(mtd: TClassMethodDef): AnsiString;
|
|
|
|
var
|
|
|
|
i : Integer;
|
|
|
|
obj : TObject;
|
|
|
|
begin
|
|
|
|
Result := mtd._Name;
|
|
|
|
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
|
|
|
|
Result := Result + ':';
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
2008-04-23 07:59:44 +00:00
|
|
|
procedure WriteOutClassToConsts(cl : TClassDef; subs, conststr: TStrings);
|
2008-03-25 08:24:19 +00:00
|
|
|
var
|
|
|
|
i : Integer;
|
2008-04-01 06:29:04 +00:00
|
|
|
// j : Integer;
|
2008-03-25 08:24:19 +00:00
|
|
|
s : AnsiString;
|
|
|
|
ss : AnsiString;
|
|
|
|
mtd : TClassMethodDef;
|
2008-03-27 15:28:02 +00:00
|
|
|
obj : TObject;
|
2008-04-08 09:22:54 +00:00
|
|
|
cs : AnsiString;
|
2009-02-16 11:50:17 +00:00
|
|
|
objcname : AnsiString;
|
2008-03-25 08:24:19 +00:00
|
|
|
begin
|
2008-04-08 09:22:54 +00:00
|
|
|
cs := GetClassConst(cl._ClassName, cl._ClassName);
|
|
|
|
if conststr.IndexOf(cs) < 0 then begin
|
|
|
|
conststr.Add(cs);
|
|
|
|
s := Format(' %s = ''%s'';', [cs, cl._ClassName]);
|
2008-03-25 08:24:19 +00:00
|
|
|
subs.Add(s);
|
2008-04-08 09:22:54 +00:00
|
|
|
end;
|
|
|
|
|
2008-03-27 15:28:02 +00:00
|
|
|
for i := 0 to cl.Items.Count - 1 do begin
|
|
|
|
obj := TObject(cl.Items[i]);
|
|
|
|
if obj is TClassMethodDef then begin
|
2008-03-25 08:24:19 +00:00
|
|
|
mtd := TClassMethodDef(cl.Items[i]);
|
2008-04-08 09:22:54 +00:00
|
|
|
|
2009-02-16 11:50:17 +00:00
|
|
|
objcName := GetMethodConstName(mtd);
|
|
|
|
mtd._Name := ObjCToPasMethodName(mtd);
|
|
|
|
cs := GetClassConst(cl._ClassName, mtd._Name);
|
2008-04-08 09:22:54 +00:00
|
|
|
if conststr.IndexOf(cs) < 0 then begin
|
|
|
|
conststr.Add(cs);
|
2009-02-16 11:50:17 +00:00
|
|
|
ss := Format(' %s = ''%s'';', [cs, objcname]);
|
2008-04-08 09:22:54 +00:00
|
|
|
subs.add(ss);
|
|
|
|
end;
|
2008-04-23 07:59:44 +00:00
|
|
|
|
2008-03-27 15:28:02 +00:00
|
|
|
end;
|
|
|
|
end; {of for}
|
|
|
|
subs.Add('');
|
|
|
|
end;
|
|
|
|
|
2008-04-01 06:29:04 +00:00
|
|
|
procedure ParseDefine(const s: AnsiString; var DefWhat, DefTo: AnsiString);
|
|
|
|
var
|
|
|
|
i : Integer;
|
|
|
|
begin
|
|
|
|
i := 1;
|
|
|
|
ScanWhile(s, i, [#9, #32, #10, #13]);
|
|
|
|
if i < length(s) then begin
|
|
|
|
DefWhat := ScanTo(s, i, [#9, #32, #10, #13]);
|
|
|
|
ScanWhile(s, i, [#9, #32]);
|
|
|
|
DefTo := Copy(s, i, length(s) - i + 1);
|
|
|
|
end else
|
|
|
|
DefTo := '';
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure WriteOutPrecompDefine(const Prec: TPrecompiler; Prefix: AnsiString; st: TStrings);
|
|
|
|
var
|
|
|
|
a, b: AnsiString;
|
|
|
|
begin
|
|
|
|
if Prec._Directive = '#define' then begin
|
|
|
|
ParseDefine(Prec._Params, a, b);
|
|
|
|
if b <> ''
|
|
|
|
then st.Add(Prefix + Format('%s = %s;', [a, b]))
|
|
|
|
else st.Add(Prefix + Format('{$define %s}', [a]));
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2008-03-28 13:03:13 +00:00
|
|
|
procedure WriteOutPrecompInclude(Prec: TPrecompiler; st: TStrings);
|
2008-03-27 15:28:02 +00:00
|
|
|
var
|
|
|
|
dlph : AnsiString;
|
|
|
|
begin
|
|
|
|
dlph := WriteOutPrecompToPascal(Prec);
|
2008-04-07 14:06:35 +00:00
|
|
|
if IsSubStr('{$include', dlph, 1) then
|
|
|
|
st.Add(dlph);
|
2008-03-27 15:28:02 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
function GetPascalEnumValue(const Name, Param: AnsiString): AnsiString;
|
|
|
|
begin
|
|
|
|
Result := Name;
|
2008-03-28 10:25:27 +00:00
|
|
|
if Param <> '' then
|
|
|
|
Result := Result + ' = ' + Param
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
function ReplaceStr(const sub, subrep, s: AnsiString): AnsiString;
|
|
|
|
var
|
|
|
|
i : Integer;
|
|
|
|
j : Integer;
|
|
|
|
begin
|
|
|
|
i := Pos(sub, s);
|
|
|
|
if i = 0 then begin
|
|
|
|
Result := s;
|
|
|
|
Exit;
|
|
|
|
end;
|
|
|
|
j := i + length(sub);
|
|
|
|
Result := Copy(s, 1, i - 1) + subrep + Copy(s, j, length(s) - j + 1);
|
2008-03-27 15:28:02 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
function GetPascalConstValue(const Vl: AnsiString): AnsiString;
|
2008-04-17 13:58:59 +00:00
|
|
|
var
|
|
|
|
ws : AnsiString;
|
2008-03-27 15:28:02 +00:00
|
|
|
begin
|
2008-04-17 13:58:59 +00:00
|
|
|
Result := Vl;
|
2008-03-28 10:25:27 +00:00
|
|
|
//todo: improve! check at h2pas
|
2008-04-23 10:02:36 +00:00
|
|
|
repeat ws := Result; Result := ReplaceStr('<<', 'shl', ws); until Result = ws;
|
2008-04-17 13:58:59 +00:00
|
|
|
repeat ws := Result; Result := ReplaceStr('>>', 'shr', ws); until Result = ws;
|
2008-04-23 10:02:36 +00:00
|
|
|
repeat ws := Result; Result := ReplaceStr('||', 'or', ws); until Result = ws;
|
|
|
|
repeat ws := Result; Result := ReplaceStr('|', 'or', ws); until Result = ws;
|
2008-04-17 13:58:59 +00:00
|
|
|
repeat ws := Result; Result := ReplaceStr('&&', 'and', ws); until Result = ws;
|
2008-04-23 10:02:36 +00:00
|
|
|
repeat ws := Result; Result := ReplaceStr('&', 'and', ws); until Result = ws;
|
2008-03-27 15:28:02 +00:00
|
|
|
end;
|
|
|
|
|
2008-03-28 10:25:27 +00:00
|
|
|
procedure WriteOutEnumValues(enm: TEnumTypeDef; const Prefix: AnsiString; st: TStrings);
|
2008-03-27 15:28:02 +00:00
|
|
|
var
|
|
|
|
vl : TEnumValue;
|
|
|
|
s : AnsiString;
|
|
|
|
i : Integer;
|
|
|
|
j : Integer;
|
|
|
|
begin
|
|
|
|
j := st.Count;
|
2008-03-28 10:25:27 +00:00
|
|
|
for i := 0 to enm.Items.Count - 1 do begin
|
2008-03-27 15:28:02 +00:00
|
|
|
if TObject(enm.Items[i]) is TEnumValue then begin
|
|
|
|
vl := TEnumValue(enm.Items[i]);
|
|
|
|
if st.Count > j then st[st.Count-1]:=st[st.Count-1]+', ';
|
|
|
|
s := GetPascalEnumValue(vl._Name, GetPascalConstValue(vl._Value));
|
|
|
|
s := Prefix + s;
|
|
|
|
st.Add(s);
|
|
|
|
end;
|
2008-03-28 10:25:27 +00:00
|
|
|
end;
|
2008-03-27 15:28:02 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
function Min(a, b: Integer): Integer;
|
|
|
|
begin
|
|
|
|
if a < b then Result := a
|
|
|
|
else Result := b;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure MatchFixes(const Name: AnsiString; var prefix, postfix: AnsiString);
|
|
|
|
var
|
|
|
|
i : integer;
|
|
|
|
ni, pi: integer;
|
2008-04-01 06:29:04 +00:00
|
|
|
// nc, pc: AnsiChar;
|
2008-03-27 15:28:02 +00:00
|
|
|
begin
|
|
|
|
for i := 1 to Min(length(Name), length(prefix)) do
|
|
|
|
if Name[i] <> prefix[i] then begin
|
|
|
|
prefix := Copy(prefix, 1, i - 1);
|
|
|
|
Break;
|
|
|
|
end;
|
|
|
|
|
|
|
|
ni := length(Name);
|
|
|
|
pi := length(postfix);
|
|
|
|
for i := 1 to Min(length(Name), length(postfix)) do begin
|
|
|
|
if Name[ni] <> postfix[pi] then begin // this cause a bug
|
|
|
|
postfix := Copy(Name, ni + 1, length(Name) - ni);
|
|
|
|
Break;
|
|
|
|
end;
|
|
|
|
dec(ni);
|
|
|
|
dec(pi);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function EvaluateEnumName(enm: TEnumTypeDef): AnsiString;
|
|
|
|
var
|
|
|
|
prefix : AnsiString;
|
|
|
|
postfix : AnsiSTring;
|
|
|
|
vl : TEnumValue;
|
|
|
|
known : integer;
|
|
|
|
i : Integer;
|
|
|
|
begin
|
|
|
|
known := 0;
|
2008-03-28 10:25:27 +00:00
|
|
|
Result := '';
|
2008-03-27 15:28:02 +00:00
|
|
|
for i := 0 to enm.Items.Count - 1 do begin
|
|
|
|
if TObject(enm.Items[i]) is TEnumValue then begin
|
|
|
|
vl := TEnumValue(enm.Items[i]);
|
|
|
|
if known = 0 then begin
|
|
|
|
prefix := vl._Name;
|
|
|
|
postfix := vl._Name;
|
|
|
|
end else
|
|
|
|
MatchFixes(vl._Name, prefix, postfix);
|
|
|
|
inc(known)
|
2008-03-25 08:24:19 +00:00
|
|
|
end;
|
2008-03-27 15:28:02 +00:00
|
|
|
end;
|
|
|
|
if (known <= 1) or (length(Result) < 3) then Result := 'todoEnumName' // if only one enumaration or none, name cannot be defined...
|
|
|
|
else Result := prefix + postfix;
|
|
|
|
end;
|
|
|
|
|
2009-02-28 07:04:07 +00:00
|
|
|
procedure WriteOutVariableToHeader(v: TVariable; const SpacePrefix: String; Vars: TStrings);
|
2009-02-25 19:40:38 +00:00
|
|
|
var
|
|
|
|
tp : TTypeDef;
|
|
|
|
s : AnsiString;
|
|
|
|
begin
|
|
|
|
tp := TTypeDef(v._Type);
|
2009-02-26 13:17:21 +00:00
|
|
|
s := Format('%s : %s; external name ''%s''; ', [v._Name, ObjCToDelphiType(tp._Name, tp._IsPointer), v._Name] );
|
2009-02-25 19:40:38 +00:00
|
|
|
Vars.Add(SpacePrefix + s);
|
|
|
|
end;
|
|
|
|
|
|
|
|
function CParamsListToPascalStr(Params: TFunctionParamsList): AnsiString;
|
|
|
|
var
|
|
|
|
i : integer;
|
|
|
|
num : Integer;
|
|
|
|
prm : TFunctionParam;
|
|
|
|
vs : AnsiString;
|
|
|
|
begin
|
|
|
|
Result := '';
|
|
|
|
num := 1;
|
|
|
|
for i := 0 to Params.Items.Count - 1 do
|
|
|
|
if TObject(Params.Items[i]) is TFunctionParam then begin
|
|
|
|
prm := TFunctionParam(Params.Items[i]);
|
|
|
|
if prm._IsAny then Continue;
|
|
|
|
vs := ObjCToDelphiType( GetTypeNameFromEntity(prm._Type), IsTypeDefIsPointer(prm._Type));
|
|
|
|
if prm._Name = ''
|
|
|
|
then vs := '_param'+IntToStr(num) + ': ' + vs
|
|
|
|
else vs := prm._Name + ': ' + vs;
|
|
|
|
if Result <> '' then
|
|
|
|
Result := Result + '; ' + vs
|
|
|
|
else
|
|
|
|
Result := vs;
|
|
|
|
inc(num);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2009-02-28 07:04:07 +00:00
|
|
|
procedure WriteOutFunctionToHeader(f: TFunctionDef; st: TStrings);
|
2009-02-25 19:40:38 +00:00
|
|
|
var
|
|
|
|
restype : AnsiString;
|
|
|
|
fntype : AnsiString;
|
|
|
|
isptr : Boolean;
|
|
|
|
s : AnsiString;
|
|
|
|
begin
|
|
|
|
if not Assigned(f._ResultType) then begin
|
|
|
|
isptr := false;
|
|
|
|
fntype := 'int';
|
|
|
|
end else if (f._ResultType is TTypeDef) then begin
|
|
|
|
isptr := TTypeDef(f._ResultType)._IsPointer;
|
|
|
|
fntype := TTypeDef(f._ResultType)._Name;
|
|
|
|
end else begin
|
|
|
|
isptr := false;
|
|
|
|
fntype := '{todo: not implemented... see .h file for type}';
|
|
|
|
end;
|
|
|
|
|
|
|
|
restype := ObjCToDelphiType(fntype, isptr);
|
|
|
|
s:= GetProcFuncHead(f._Name, '', CParamsListToPascalStr(f._ParamsList), restype) + ' cdecl';
|
|
|
|
st.Add( s);
|
2009-02-26 13:17:21 +00:00
|
|
|
s := Format(' external name ''_%s'';', [f._Name]);
|
2009-02-25 19:40:38 +00:00
|
|
|
st.Add(s);
|
|
|
|
end;
|
|
|
|
|
2008-03-27 15:28:02 +00:00
|
|
|
procedure WriteOutEnumToHeader(enm: TEnumTypeDef; st: TStrings);
|
|
|
|
var
|
2008-04-07 14:06:35 +00:00
|
|
|
i : Integer;
|
|
|
|
// ent : TEnumValue;
|
|
|
|
obj : TObject;
|
|
|
|
pre : TEnumValue;
|
|
|
|
vl : TEnumValue;
|
|
|
|
vls : AnsiString;
|
|
|
|
vli : Integer;
|
2008-03-27 15:28:02 +00:00
|
|
|
begin
|
2008-04-07 14:06:35 +00:00
|
|
|
if enm._Name = '' then begin
|
|
|
|
// unnamed enums are written out as constants
|
|
|
|
pre := nil;
|
|
|
|
st.Add('const');
|
|
|
|
vli := 1;
|
|
|
|
for i := 0 to enm.Items.Count - 1 do begin
|
|
|
|
obj := TObject(enm.Items[i]);
|
|
|
|
if obj is TEnumValue then begin
|
|
|
|
vl := TEnumValue(obj);
|
|
|
|
if vl._Value = '' then begin
|
|
|
|
if not Assigned(pre) then begin
|
|
|
|
vls := '0';
|
|
|
|
pre := vl;
|
|
|
|
end else begin
|
|
|
|
vls := pre._Name + ' + ' + IntToStr(vli);
|
|
|
|
inc(vli);
|
|
|
|
end;
|
|
|
|
end else begin
|
|
|
|
vls := vl._Value;
|
|
|
|
vli := 1;
|
|
|
|
pre := vl;
|
|
|
|
end;
|
|
|
|
st.Add(Format(' %s = %s;', [vl._Name, GetPascalConstValue(vls)]));
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
st.Add('');
|
|
|
|
//st.Add('type');
|
|
|
|
end else begin
|
|
|
|
st.Add('type');
|
|
|
|
// named enums are written out as delphi enumerations
|
|
|
|
st.Add(Format(' %s = (', [enm._Name] ));
|
|
|
|
WriteOutEnumValues(enm, ' ', st );
|
|
|
|
st.Add(' );');
|
|
|
|
st.Add('');
|
|
|
|
end;
|
2008-03-25 08:24:19 +00:00
|
|
|
end;
|
|
|
|
|
2008-04-15 14:13:34 +00:00
|
|
|
procedure WriteOutUnion(AField: TUnionTypeDef; const Prefix: AnsiString; subs: TStrings);
|
|
|
|
var
|
|
|
|
i : integer;
|
|
|
|
n : integer;
|
|
|
|
c : Integer;
|
|
|
|
s : AnsiString;
|
|
|
|
begin
|
|
|
|
n := 0;
|
|
|
|
subs.Add(Prefix + 'case Integer of');
|
|
|
|
for i := 0 to AField.Items.Count - 1 do begin
|
|
|
|
if TObject(AField.Items[i]) is TStructField then begin
|
|
|
|
subs.Add(Prefix + Format('%d: (', [n]));
|
|
|
|
c := subs.Count;
|
|
|
|
WriteOutRecordField(TStructField(AField.Items[i]), Prefix + ' ', subs);
|
|
|
|
subs[subs.Count-1] := subs[subs.Count-1] + ');';
|
|
|
|
|
|
|
|
if subs.Count - 1 = c then begin
|
|
|
|
s := subs[subs.Count - 1];
|
|
|
|
Delete(s, 1, length(Prefix + ' '));
|
|
|
|
subs.Delete(subs.Count - 1);
|
2008-04-25 13:47:19 +00:00
|
|
|
subs[subs.Count - 1] := subs[subs.Count - 1] + s;
|
2008-04-15 14:13:34 +00:00
|
|
|
end;
|
|
|
|
|
2008-04-25 13:47:19 +00:00
|
|
|
inc(n);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function CToDelphiFuncType(AFuncType: TFunctionTypeDef): AnsiString;
|
|
|
|
var
|
|
|
|
restype : AnsiString;
|
|
|
|
fntype : AnsiString;
|
|
|
|
isptr : Boolean;
|
|
|
|
begin
|
|
|
|
if not Assigned(AFuncType._ResultType) then begin
|
|
|
|
isptr := false;
|
|
|
|
fntype := 'int';
|
|
|
|
end else if (AFuncType._ResultType is TTypeDef) then begin
|
|
|
|
isptr := TTypeDef(AFuncType._ResultType)._IsPointer;
|
|
|
|
fntype := TTypeDef(AFuncType._ResultType)._Name;
|
|
|
|
end else begin
|
|
|
|
isptr := false;
|
|
|
|
fntype := '{todo: not implemented... see .h file for type}';
|
2008-04-15 14:13:34 +00:00
|
|
|
end;
|
2008-04-25 13:47:19 +00:00
|
|
|
restype := ObjCToDelphiType(fntype, isptr);
|
2008-04-29 14:10:17 +00:00
|
|
|
Result := GetProcFuncHead('', '', CParamsListToPascalStr(AFuncType._ParamsList), restype) + ' cdecl';
|
|
|
|
//Result := Copy(Result, 1, length(Result) - 1);
|
|
|
|
//Result := Result + '; cdecl';
|
2008-04-15 14:13:34 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
procedure WriteOutRecordField(AField: TStructField; const Prefix: AnsiString; subs: TStrings);
|
|
|
|
var
|
|
|
|
pastype : AnsiString;
|
2008-04-22 08:07:37 +00:00
|
|
|
nm : AnsiString;
|
2008-04-23 07:59:44 +00:00
|
|
|
i : Integer;
|
2008-04-25 13:47:19 +00:00
|
|
|
|
2008-04-15 14:13:34 +00:00
|
|
|
begin
|
|
|
|
//todo:!
|
2008-04-23 07:59:44 +00:00
|
|
|
if Assigned(AField._Type) then begin
|
|
|
|
if (AField._Type is TUnionTypeDef) then
|
|
|
|
WriteOutUnion(TUnionTypeDef(AField._Type), Prefix, subs)
|
2009-01-17 22:24:04 +00:00
|
|
|
else if AField._Type is TEntityStruct then begin
|
2008-04-23 07:59:44 +00:00
|
|
|
i := subs.Count;
|
2009-01-17 22:24:04 +00:00
|
|
|
WriteOutRecord(TEntityStruct(AField._Type), Prefix, 'packed', subs);
|
2008-04-23 07:59:44 +00:00
|
|
|
if i < subs.Count then begin
|
|
|
|
nm := subs[i];
|
|
|
|
Delete(nm, 1, length(Prefix));
|
|
|
|
nm := Prefix + Format('%s : %s', [AField._Name, nm]);
|
|
|
|
subs[i] := nm;
|
|
|
|
end;
|
2008-04-29 14:10:17 +00:00
|
|
|
end else begin
|
2008-04-25 13:47:19 +00:00
|
|
|
|
|
|
|
if (AField._Type is TFunctionTypeDef) then
|
|
|
|
pastype := CToDelphiFuncType(AField._Type as TFunctionTypeDef)
|
|
|
|
else
|
|
|
|
pastype := ObjCToDelphiType(AField._TypeName, IsTypePointer(AField._Type, false));
|
|
|
|
|
2008-04-23 07:59:44 +00:00
|
|
|
nm := FixIfReserved(AField._Name);
|
|
|
|
if (AField._IsArray) and (AField._ArraySize <> '') then
|
|
|
|
subs.Add(Prefix + Format('%s : array [0..%s-1] of %s;', [nm, AField._ArraySize, pastype]))
|
|
|
|
else
|
|
|
|
subs.Add(Prefix + Format('%s : %s; ', [nm, pastype]));
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure WriteOutBitFields(const prefix, fieldname: AnsiString; var Index: Integer; subs: TStrings; bitsize: Integer);
|
|
|
|
var
|
|
|
|
ts : AnsiString;
|
|
|
|
begin
|
|
|
|
while bitsize > 0 do begin
|
|
|
|
if bitsize > 16 then begin
|
|
|
|
ts := 'LongWord';
|
|
|
|
dec(bitsize, 32);
|
|
|
|
end else if bitsize > 8 then begin
|
|
|
|
ts := 'Word';
|
|
|
|
dec(bitsize, 16);
|
|
|
|
end else begin
|
|
|
|
ts := 'Byte';
|
|
|
|
dec(bitsize, 8);
|
|
|
|
end;
|
|
|
|
|
|
|
|
subs.Add(Prefix + Format('%s : %s;', [fieldname + IntToStr(index), ts]));
|
|
|
|
inc(index);
|
2008-04-15 14:13:34 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2009-01-17 22:24:04 +00:00
|
|
|
procedure WriteOutRecord(struct: TEntityStruct; const Prefix, RecPrefix : AnsiString; subs: TStrings);
|
2008-04-15 14:13:34 +00:00
|
|
|
var
|
2008-04-23 07:59:44 +00:00
|
|
|
i : integer;
|
|
|
|
bits : Integer;
|
|
|
|
sf : TStructField;
|
|
|
|
bitfname : AnsiString;
|
|
|
|
bitfx : Integer;
|
2008-04-15 14:13:34 +00:00
|
|
|
begin
|
2008-04-23 07:59:44 +00:00
|
|
|
bitfname := '_bitflags';
|
|
|
|
bitfx := 1;
|
|
|
|
|
2008-04-15 14:13:34 +00:00
|
|
|
subs.Add(Prefix + Format('%s record ', [RecPrefix]));
|
2008-04-23 07:59:44 +00:00
|
|
|
bits := 0;
|
2008-04-15 14:13:34 +00:00
|
|
|
for i := 0 to struct.Items.Count - 1 do
|
2008-04-23 07:59:44 +00:00
|
|
|
if Assigned(struct.ITems[i]) and (TObject(struct.Items[i]) is TStructField) then begin
|
|
|
|
sf := TStructField(struct.Items[i]);
|
|
|
|
if sf._BitSize <> 0 then
|
|
|
|
inc(bits, sf._BitSize)
|
|
|
|
else begin
|
|
|
|
if bits > 0 then begin
|
|
|
|
WriteOutBitFields(Prefix+' ', bitfname, bitfx, subs, bits);
|
|
|
|
bits :=0;
|
|
|
|
end;
|
|
|
|
WriteOutRecordField(sf, Prefix + ' ', subs);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
if bits > 0 then
|
|
|
|
WriteOutBitFields(Prefix+' ', bitfname, bitfx, subs, bits);
|
2008-04-15 14:13:34 +00:00
|
|
|
subs.Add(Prefix + 'end;');
|
|
|
|
end;
|
|
|
|
|
2009-01-17 22:24:04 +00:00
|
|
|
procedure WriteOutTypeDefRecord(struct: TEntityStruct; const Prefix, RecPrefix : AnsiString; subs: TStrings);
|
2008-04-15 14:13:34 +00:00
|
|
|
var
|
|
|
|
i : integer;
|
|
|
|
s : AnsiString;
|
|
|
|
begin
|
|
|
|
i := subs.Count;
|
2008-04-22 11:13:59 +00:00
|
|
|
if not isEmptyStruct(struct) then begin
|
|
|
|
WriteOutRecord(struct, Prefix, RecPrefix, subs);
|
|
|
|
s := subs[i];
|
|
|
|
Delete(s, 1, length(Prefix));
|
|
|
|
s := Prefix + struct._Name + ' = ' + s;
|
|
|
|
subs[i] := s;
|
|
|
|
end else begin
|
|
|
|
subs.Add(Prefix + struct._Name + ' = Pointer;');
|
|
|
|
end;
|
2008-04-15 14:13:34 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
function WriteOutTypeDefName(const NewType, FromType: AnsiSTring; isPointer: Boolean): AnsiString;
|
2008-04-25 13:47:19 +00:00
|
|
|
var
|
|
|
|
wrType: AnsiString;
|
2008-04-15 14:13:34 +00:00
|
|
|
begin
|
2008-04-25 13:47:19 +00:00
|
|
|
wrType := ObjCToDelphiType(fromType, isPointer);
|
|
|
|
Result := Format('%s = %s;', [NewType, wrType]);
|
|
|
|
{else
|
|
|
|
Result := Format('%s = ^%s;', [NewType, wrType]);}
|
2008-04-22 08:07:37 +00:00
|
|
|
|
|
|
|
case GetObjCVarType(FromType) of
|
|
|
|
vt_FloatPoint: ConvertSettings.FloatTypes.Add(NewType);
|
2008-04-29 14:10:17 +00:00
|
|
|
vt_Object: ConvertSettings.ObjCClassTypes.Add(NewType);
|
2008-04-22 08:07:37 +00:00
|
|
|
vt_Struct: ConvertSettings.StructTypes.Add(NewType);
|
|
|
|
end;
|
2008-04-15 14:13:34 +00:00
|
|
|
end;
|
|
|
|
|
2008-03-28 10:25:27 +00:00
|
|
|
procedure WriteOutTypeDefToHeader(typedef: TTypeNameDef; const Prefix: AnsiString; subs: TStrings);
|
2008-04-07 14:06:35 +00:00
|
|
|
var
|
|
|
|
vs : AnsiString;
|
|
|
|
tmp : AnsiString;
|
2008-03-28 10:25:27 +00:00
|
|
|
begin
|
2008-04-07 14:06:35 +00:00
|
|
|
vs := ConvertSettings.TypeDefReplace[typedef._Inherited];
|
|
|
|
if vs = '' then vs := typedef._Inherited;
|
|
|
|
if not Assigned(typedef._Type) or (typedef._Type is TTypeDef) then begin
|
|
|
|
subs.Add('type');
|
2008-04-15 14:13:34 +00:00
|
|
|
subs.Add(Prefix + WriteOutTypeDefName(typedef._TypeName, vs, IsTypePointer(typedef._Type, false)));
|
|
|
|
end else if typedef._Type is TEnumTypeDef then begin
|
|
|
|
tmp := TEnumTypeDef(typedef._Type)._Name;
|
|
|
|
TEnumTypeDef(typedef._Type)._Name := typedef._TypeName;
|
|
|
|
WriteOutEnumToHeader(TEnumTypeDef(typedef._Type), subs);
|
|
|
|
TEnumTypeDef(typedef._Type)._Name := tmp;
|
2009-01-17 22:24:04 +00:00
|
|
|
end else if typedef._Type is TEntityStruct then begin
|
2008-04-15 14:13:34 +00:00
|
|
|
subs.Add('type');
|
2009-01-17 22:24:04 +00:00
|
|
|
if TEntityStruct(typedef._Type)._Name <> '' then begin
|
|
|
|
WriteOutTypeDefRecord(typedef._Type as TEntityStruct, ' ', 'packed ', subs);
|
|
|
|
subs.Add(Prefix + WriteOutTypeDefName(typedef._TypeName, TEntityStruct(typedef._Type)._Name, IsTypePointer(typedef._Type, false)));
|
|
|
|
ConvertSettings.StructTypes.Add(TEntityStruct(typedef._Type)._Name);
|
2008-04-15 14:13:34 +00:00
|
|
|
end else begin
|
2009-01-17 22:24:04 +00:00
|
|
|
TEntityStruct(typedef._Type)._Name := typedef._TypeName;
|
|
|
|
WriteOutTypeDefRecord(typedef._Type as TEntityStruct, ' ', 'packed ', subs);
|
2008-04-22 08:07:37 +00:00
|
|
|
ConvertSettings.StructTypes.Add(typedef._TypeName);
|
2008-04-07 14:06:35 +00:00
|
|
|
end;
|
|
|
|
end;
|
2008-04-15 14:13:34 +00:00
|
|
|
|
2008-04-07 14:06:35 +00:00
|
|
|
subs.Add('');
|
2008-03-28 10:25:27 +00:00
|
|
|
end;
|
|
|
|
|
2008-03-25 08:24:19 +00:00
|
|
|
procedure WriteOutHeaderSection(hdr: TObjCHeader; st: TStrings);
|
|
|
|
var
|
|
|
|
i : Integer;
|
|
|
|
subs : TStringList;
|
|
|
|
consts : TStringList;
|
2009-02-28 07:04:07 +00:00
|
|
|
cmt : TStringList;
|
|
|
|
|
|
|
|
PasSection : String;
|
|
|
|
|
|
|
|
procedure StartSection(NewSection: String);
|
|
|
|
begin
|
|
|
|
if NewSection = PasSection then Exit;
|
|
|
|
st.Add('');
|
|
|
|
if NewSection <> '' then st.Add(NewSection);
|
|
|
|
PasSection := NewSection;
|
|
|
|
end;
|
|
|
|
|
2008-03-28 10:25:27 +00:00
|
|
|
const
|
|
|
|
SpacePrefix = ' ';
|
2008-03-25 08:24:19 +00:00
|
|
|
begin
|
2009-02-28 07:04:07 +00:00
|
|
|
PasSection := '';
|
|
|
|
|
2008-03-28 13:03:13 +00:00
|
|
|
BeginSection('HEADER', st);
|
|
|
|
BeginExcludeSection( GetIfDefFileName(hdr._FileName, 'H'), st);
|
2008-03-25 08:24:19 +00:00
|
|
|
subs := TStringList.Create;
|
|
|
|
consts := TStringList.Create;
|
2009-02-28 07:04:07 +00:00
|
|
|
cmt := TStringList.Create;
|
2008-03-25 08:24:19 +00:00
|
|
|
try
|
2008-04-23 10:02:36 +00:00
|
|
|
for i := 0 to hdr.Items.Count - 1 do
|
|
|
|
if Assigned(hdr.Items[i]) then
|
2008-04-23 07:59:44 +00:00
|
|
|
if (TObject(hdr.Items[i]) is TPrecompiler) then begin
|
2008-04-07 14:06:35 +00:00
|
|
|
WriteOutIfDefPrecompiler(TPrecompiler(hdr.Items[i]), SpacePrefix, st);
|
2008-03-28 13:03:13 +00:00
|
|
|
WriteOutPrecompInclude(TPrecompiler(hdr.Items[i]), st);
|
2008-04-01 06:29:04 +00:00
|
|
|
WriteOutPrecompDefine(TPrecompiler(hdr.Items[i]), ' ', subs);
|
2008-03-27 15:28:02 +00:00
|
|
|
end;
|
2008-03-25 08:24:19 +00:00
|
|
|
|
|
|
|
if subs.Count > 0 then begin
|
|
|
|
st.Add('const');
|
|
|
|
st.AddStrings(subs);
|
|
|
|
subs.Clear;
|
2008-04-23 10:02:36 +00:00
|
|
|
end;
|
2008-04-07 14:06:35 +00:00
|
|
|
|
2008-03-27 15:28:02 +00:00
|
|
|
for i := 0 to hdr.Items.Count - 1 do
|
|
|
|
if Assigned(hdr.Items[i]) then begin
|
2009-02-28 07:04:07 +00:00
|
|
|
|
|
|
|
if (TObject(hdr.Items[i]) is TEnumTypeDef) then begin
|
|
|
|
WriteOutEnumToHeader(TEnumTypeDef(hdr.Items[i]), st);
|
|
|
|
PasSection := 'const';
|
|
|
|
end else if (TObject(hdr.Items[i]) is TPrecompiler) then begin
|
2009-01-26 09:17:47 +00:00
|
|
|
WriteOutIfDefPrecompiler(TPrecompiler(hdr.Items[i]), SpacePrefix, st)
|
2009-02-28 07:04:07 +00:00
|
|
|
end else if (TObject(hdr.Items[i]) is TTypeNameDef) then begin
|
|
|
|
WriteOutTypeDefToHeader(TTypeNameDef(hdr.Items[i]), SpacePrefix, st);
|
|
|
|
//hack. MUST CHANGE CODE
|
|
|
|
PasSection := 'type';
|
|
|
|
end else if (TObject(hdr.Items[i]) is TSkip) then
|
|
|
|
st.Add('//'+ TSkip(hdr.Items[i])._Skip)
|
|
|
|
else if (TObject(hdr.Items[i]) is TComment) then begin
|
2009-01-26 09:17:47 +00:00
|
|
|
//WriteOutIfComment(hdr.Items, i, SpacePrefix, subs);
|
2009-02-28 07:04:07 +00:00
|
|
|
WriteOutCommentStr( TComment(hdr.Items[i])._Comment, SpacePrefix, st);
|
|
|
|
end else if (TObject(hdr.Items[i]) is TVariable) then begin
|
|
|
|
StartSection('var');
|
|
|
|
WriteOutVariableToHeader(TVariable(hdr.Items[i]), SpacePrefix, st)
|
|
|
|
end else if (TObject(hdr.Items[i]) is TFunctionDef) then begin
|
|
|
|
StartSection('');
|
|
|
|
WriteOutFunctionToHeader(TFunctionDef(hdr.Items[i]), st);
|
|
|
|
end;
|
2008-03-27 15:28:02 +00:00
|
|
|
end; {of if}
|
2008-04-07 14:06:35 +00:00
|
|
|
|
2008-06-09 08:12:20 +00:00
|
|
|
st.add('');
|
2009-02-28 07:04:07 +00:00
|
|
|
{ if subs.Count > 0 then begin
|
2008-04-07 14:06:35 +00:00
|
|
|
//if subs[0] <> 'const' then st.Add('type');
|
2008-03-27 15:28:02 +00:00
|
|
|
st.AddStrings(subs);
|
|
|
|
subs.Clear;
|
2009-02-28 07:04:07 +00:00
|
|
|
end;}
|
2009-02-25 19:40:38 +00:00
|
|
|
|
|
|
|
|
2008-03-25 08:24:19 +00:00
|
|
|
finally
|
2008-03-28 13:03:13 +00:00
|
|
|
EndSection(st);
|
2008-03-25 08:24:19 +00:00
|
|
|
EndSection(st);
|
2008-04-08 09:22:54 +00:00
|
|
|
subs.Add('');
|
2008-03-25 08:24:19 +00:00
|
|
|
subs.Free;
|
|
|
|
consts.Free;
|
2009-02-28 07:04:07 +00:00
|
|
|
cmt.Free;
|
2008-03-25 08:24:19 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure WriteOutClassToClasses(cl: TClassDef; subs: TStrings);
|
|
|
|
var
|
2008-03-27 15:28:02 +00:00
|
|
|
i : Integer;
|
2008-04-01 06:29:04 +00:00
|
|
|
// cnt : Integer;
|
2008-03-25 08:24:19 +00:00
|
|
|
s : AnsiString;
|
2008-04-17 13:58:59 +00:00
|
|
|
nm : AnsiString;
|
2008-04-29 14:10:17 +00:00
|
|
|
cmt : AnsiString;
|
2008-03-25 08:24:19 +00:00
|
|
|
j : Integer;
|
2008-03-27 15:28:02 +00:00
|
|
|
obj : TObject; // or TEntity
|
2009-01-17 22:24:04 +00:00
|
|
|
|
2008-03-27 15:28:02 +00:00
|
|
|
mtds : TStringList; // name of methods
|
2009-01-17 22:24:04 +00:00
|
|
|
restype: TObjCResultTypeDef;
|
2009-02-16 20:30:58 +00:00
|
|
|
|
2008-04-01 06:29:04 +00:00
|
|
|
// over : TStringList; // overloaded names
|
2009-02-16 20:30:58 +00:00
|
|
|
|
|
|
|
isProtEmpty : Boolean;
|
|
|
|
protidx : Integer;
|
|
|
|
pr : TObjCClassProperty;
|
2008-03-27 15:28:02 +00:00
|
|
|
const
|
|
|
|
SpacePrefix = ' ';
|
2008-03-25 08:24:19 +00:00
|
|
|
begin
|
2009-02-16 20:30:58 +00:00
|
|
|
isProtEmpty := true;
|
|
|
|
|
2008-04-08 09:22:54 +00:00
|
|
|
subs.Add('');
|
2008-03-25 08:24:19 +00:00
|
|
|
subs.Add(' { '+cl._ClassName +' }');
|
|
|
|
subs.Add('');
|
|
|
|
s := ' ' + cl._ClassName + ' = class';
|
|
|
|
if cl._SuperClass <> '' then begin
|
|
|
|
subs.Add(s + '('+cl._SuperClass+')');
|
2009-02-16 20:30:58 +00:00
|
|
|
protidx := subs.Count;
|
2008-03-25 08:24:19 +00:00
|
|
|
subs.Add(' public');
|
2008-04-25 13:47:19 +00:00
|
|
|
subs.Add(' class function getClass: objc.id; override;');
|
2008-03-25 08:24:19 +00:00
|
|
|
end else begin
|
|
|
|
subs.Add(s + '{from category '+ cl._Category +'}');
|
2009-02-16 20:30:58 +00:00
|
|
|
protidx := subs.Count;
|
2008-03-25 08:24:19 +00:00
|
|
|
subs.Add(' public');
|
|
|
|
end;
|
2008-03-27 15:28:02 +00:00
|
|
|
|
|
|
|
mtds := TStringList.Create;
|
|
|
|
try
|
|
|
|
for j := 0 to cl.Items.Count - 1 do begin
|
|
|
|
obj := TObject(cl.Items[j]);
|
|
|
|
if obj is TClassMethodDef then begin
|
2008-04-17 13:58:59 +00:00
|
|
|
nm := TClassMethodDef(obj)._Name;
|
|
|
|
i := mtds.indexOf(nm);
|
2008-03-27 15:28:02 +00:00
|
|
|
if i < 0 then
|
2008-04-17 13:58:59 +00:00
|
|
|
mtds.Add(nm)
|
2008-03-27 15:28:02 +00:00
|
|
|
else
|
|
|
|
mtds.Objects[i] := TObject(Integer(mtds.Objects[i]) + 1);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
for j := 0 to cl.Items.Count - 1 do begin
|
|
|
|
obj := TObject(cl.Items[j]);
|
|
|
|
if obj is TClassMethodDef then begin
|
2008-03-28 10:25:27 +00:00
|
|
|
WriteOutIfComment(cl.Items, j - 1, ' ', subs);
|
2008-03-27 15:28:02 +00:00
|
|
|
s := GetMethodStr(cl, TClassMethodDef(cl.Items[j]), false);
|
2008-04-17 13:58:59 +00:00
|
|
|
nm := TClassMethodDef(cl.Items[j])._Name;
|
|
|
|
i := mtds.IndexOf(nm);
|
2008-03-27 15:28:02 +00:00
|
|
|
if Integer(mtds.Objects[i]) > 0 then s := s + ' overload;';
|
2009-01-17 22:24:04 +00:00
|
|
|
|
|
|
|
|
|
|
|
restype := TClassMethodDef(cl.Items[j]).GetResultType;
|
|
|
|
if Assigned(restype) then begin
|
2008-04-29 14:10:17 +00:00
|
|
|
cmt := TClassMethodDef(cl.Items[j]).GetResultType.TagComment;
|
|
|
|
if cmt <> '' then
|
|
|
|
s := s + '{'+cmt+'}';
|
|
|
|
end;
|
2009-02-16 20:30:58 +00:00
|
|
|
|
2008-03-27 15:28:02 +00:00
|
|
|
subs.Add(SpacePrefix + s);
|
|
|
|
end else if obj is TPrecompiler then begin
|
2008-03-28 10:25:27 +00:00
|
|
|
WriteOutIfDefPrecompiler(TPrecompiler(obj), SpacePrefix, subs);
|
2008-03-27 15:28:02 +00:00
|
|
|
end;
|
2008-03-25 08:24:19 +00:00
|
|
|
end;
|
2009-02-16 20:30:58 +00:00
|
|
|
|
|
|
|
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;
|
|
|
|
|
2008-03-27 15:28:02 +00:00
|
|
|
finally
|
|
|
|
mtds.Free;
|
|
|
|
end;
|
2009-02-16 20:30:58 +00:00
|
|
|
|
2008-03-25 08:24:19 +00:00
|
|
|
subs.Add(' end;');
|
|
|
|
subs.Add('');
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure WriteOutClassesSection(hdr: TObjCHeader; st: TStrings);
|
|
|
|
var
|
2008-03-27 15:28:02 +00:00
|
|
|
i : integer;
|
2008-03-25 08:24:19 +00:00
|
|
|
subs : TStringList;
|
|
|
|
begin
|
|
|
|
subs := TStringList.Create;
|
|
|
|
try
|
2008-03-28 13:03:13 +00:00
|
|
|
for i := 0 to hdr.Items.Count - 1 do
|
2008-04-01 06:29:04 +00:00
|
|
|
if Assigned(hdr.Items[i]) and (TObject(hdr.Items[i]) is TPrecompiler) then
|
2008-04-22 08:07:37 +00:00
|
|
|
WriteOutPrecompInclude(TPrecompiler(hdr.Items[i]), subs);
|
2008-03-28 13:03:13 +00:00
|
|
|
|
2008-03-25 08:24:19 +00:00
|
|
|
for i := 0 to hdr.Items.Count - 1 do
|
2008-04-07 14:06:35 +00:00
|
|
|
if Assigned(hdr.Items[i]) then begin
|
|
|
|
if TObject(hdr.Items[i]) is TPrecompiler then
|
|
|
|
WriteOutIfDefPrecompiler(TPrecompiler(hdr.Items[i]), ' ', subs)
|
|
|
|
else if (TObject(hdr.Items[i]) is TClassDef) then begin
|
|
|
|
WriteOutIfComment(hdr.Items, i - 1, ' ', subs);
|
|
|
|
WriteOutClassToClasses(TClassDef(hdr.Items[i]), subs);
|
|
|
|
end;
|
2008-03-28 10:25:27 +00:00
|
|
|
end;
|
2008-03-25 08:24:19 +00:00
|
|
|
|
2008-04-17 13:58:59 +00:00
|
|
|
if subs.Count = 0 then Exit;
|
|
|
|
BeginSection('CLASSES', st);
|
|
|
|
BeginExcludeSection( GetIfDefFileName(hdr._FileName, 'C'), st);
|
|
|
|
try
|
2008-04-29 14:10:17 +00:00
|
|
|
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;
|
|
|
|
|
2008-03-25 08:24:19 +00:00
|
|
|
st.AddStrings(subs);
|
2008-04-17 13:58:59 +00:00
|
|
|
finally
|
|
|
|
EndSection(st);
|
|
|
|
EndSection(st);
|
2008-03-25 08:24:19 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
finally
|
|
|
|
subs.Free;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function isAnyParam(mtd: TClassMethodDef): boolean;
|
|
|
|
var
|
|
|
|
i : integer;
|
|
|
|
begin
|
|
|
|
Result := false;
|
|
|
|
for i := 0 to mtd.Items.Count - 1 do
|
2008-04-01 06:29:04 +00:00
|
|
|
if TObject(mtd.Items[i]) is TObjCParameterDef then begin
|
2008-03-25 08:24:19 +00:00
|
|
|
Result := true;
|
|
|
|
Exit;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
const
|
|
|
|
MtdPrefix = 'TMtd_';
|
|
|
|
MtdPostfix = '';
|
|
|
|
|
2008-04-30 13:51:19 +00:00
|
|
|
procedure ObjCMethodToProcType(mtd: TClassMethodDef; var typeName: AnsiString; subs: TStrings; isResultStruct: Boolean);
|
2008-03-25 08:24:19 +00:00
|
|
|
var
|
|
|
|
s : AnsiString;
|
2008-04-07 14:06:35 +00:00
|
|
|
ms : AnsiString;
|
2008-04-22 08:07:37 +00:00
|
|
|
restype : AnsiString;
|
2008-03-25 08:24:19 +00:00
|
|
|
begin
|
2008-04-30 13:51:19 +00:00
|
|
|
//typeName := MtdPrefix + mtd._Name + MtdPostFix;
|
|
|
|
typeName := 'TmsgSendWrapper';
|
|
|
|
|
2008-03-25 08:24:19 +00:00
|
|
|
subs.Add('type');
|
2008-04-29 14:10:17 +00:00
|
|
|
ms := GetMethodParams(mtd, false);
|
2008-04-07 14:06:35 +00:00
|
|
|
if ms = '' then ms := 'param1: objc.id; param2: SEL'
|
|
|
|
else ms := 'param1: objc.id; param2: SEL' + ';' + ms;
|
2008-04-30 13:51:19 +00:00
|
|
|
|
|
|
|
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;
|
|
|
|
|
2008-04-22 08:07:37 +00:00
|
|
|
s := Format(' %s = %s cdecl;',[typeName, GetProcFuncHead('', '', ms, restype, '' )]);
|
2008-04-07 14:06:35 +00:00
|
|
|
subs.Add(s);
|
2008-03-25 08:24:19 +00:00
|
|
|
end;
|
|
|
|
|
2008-04-29 14:10:17 +00:00
|
|
|
(*function GetParamsNames(mtd: TClassMethodDef): AnsiString;
|
2008-03-25 08:24:19 +00:00
|
|
|
var
|
|
|
|
i : Integer;
|
|
|
|
obj : TObject;
|
|
|
|
vname : AnsiString;
|
|
|
|
begin
|
|
|
|
vname := '';
|
|
|
|
Result := '';
|
|
|
|
for i := 0 to mtd.Items.Count - 1 do begin
|
|
|
|
obj := TObject(mtd.Items[i]);
|
|
|
|
if obj is TParamDescr then begin
|
|
|
|
if vName <> '' then Result := Result + vname + ', ';
|
2008-04-17 13:58:59 +00:00
|
|
|
vname := 'A'+TParamDescr(obj)._Descr;
|
2008-04-01 06:29:04 +00:00
|
|
|
end else if obj is TObjCParameterDef then begin
|
2008-04-17 13:58:59 +00:00
|
|
|
if vname = '' then vname := 'A'+TObjCParameterDef(obj)._Name;
|
2008-03-25 08:24:19 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
Result := Result + vname;
|
2008-04-29 14:10:17 +00:00
|
|
|
end;*)
|
2008-03-25 08:24:19 +00:00
|
|
|
|
2008-04-07 14:06:35 +00:00
|
|
|
|
|
|
|
// procedure writes out constructor entity to the implementation section
|
|
|
|
// with the followind structure
|
|
|
|
// assignes object's ClassID usinng GetClass method
|
|
|
|
// creates ObjC object calling objc_method Alloc
|
|
|
|
// adds procedure type and variable of objC init??? method, to wrap obj_SendMsg
|
|
|
|
// initialize ObjC object structure calling init??? method
|
|
|
|
|
2009-02-16 11:50:17 +00:00
|
|
|
{function RefixName(const mtdName: AnsiString): AnsiString;
|
2008-04-22 08:07:37 +00:00
|
|
|
begin
|
|
|
|
Result := mtdName;
|
|
|
|
if mtdName = '' then Exit;
|
|
|
|
if mtdName[length(mtdName)] = '_' then
|
|
|
|
Result := Copy(mtdName, 1, length(mtdName) - 1);
|
2009-02-16 11:50:17 +00:00
|
|
|
end;}
|
2008-04-22 08:07:37 +00:00
|
|
|
|
2008-04-07 14:06:35 +00:00
|
|
|
procedure WriteOutConstructorMethod(mtd: TClassMethodDef; subs: TStrings);
|
2008-03-25 08:24:19 +00:00
|
|
|
var
|
2008-04-07 14:06:35 +00:00
|
|
|
typeName : AnsiString;
|
2008-03-25 08:24:19 +00:00
|
|
|
cl : TClassDef;
|
2008-04-22 08:07:37 +00:00
|
|
|
prms : AnsiString;
|
2008-04-07 14:06:35 +00:00
|
|
|
begin
|
|
|
|
cl := TClassDef(mtd.Owner);
|
2008-04-30 13:51:19 +00:00
|
|
|
ObjCMethodToProcType(mtd, typeName, subs, false);
|
2008-04-29 14:10:17 +00:00
|
|
|
prms := GetMethodParams(mtd, true);
|
2008-04-22 08:07:37 +00:00
|
|
|
if prms <> '' then prms := ', ' + prms;
|
2008-04-23 07:59:44 +00:00
|
|
|
|
|
|
|
if (Pos('init', mtd._Name) = 1) and (not mtd._IsClassMethod) then begin
|
|
|
|
//todo: check if object is allocated with 'alloc...' or 'init...' or else =)
|
|
|
|
subs.Add('var');
|
|
|
|
subs.Add(
|
|
|
|
Format(' vmethod: %s;', [typeName]));
|
|
|
|
subs.Add('begin');
|
|
|
|
subs.Add(' ClassID := getClass();');
|
|
|
|
subs.Add(' allocbuf := objc_msgSend(ClassID, sel_registerName(PChar(Str_alloc)), []);');
|
|
|
|
subs.Add(
|
|
|
|
Format(' vmethod := %s(@objc_msgSend);', [typeName]));
|
|
|
|
subs.Add(
|
2009-02-16 11:50:17 +00:00
|
|
|
Format(' Handle := vmethod(allocbuf, sel_registerName(PChar(Str%s_%s))%s);', [cl._ClassName, mtd._Name, prms]));
|
2008-04-23 07:59:44 +00:00
|
|
|
subs.Add('end;');
|
|
|
|
end else begin
|
|
|
|
subs.Add('var');
|
|
|
|
subs.Add(
|
|
|
|
Format(' vmethod: %s;', [typeName]));
|
|
|
|
subs.Add('begin');
|
|
|
|
subs.Add(' ClassID := getClass();');
|
|
|
|
subs.Add(
|
|
|
|
Format(' vmethod := %s(@objc_msgSend);', [typeName]));
|
|
|
|
subs.Add(
|
2009-02-16 11:50:17 +00:00
|
|
|
Format(' Handle := vmethod(ClassID, sel_registerName(PChar(Str%s_%s))%s);', [cl._ClassName, mtd._Name, prms]));
|
2008-04-23 07:59:44 +00:00
|
|
|
subs.Add('end;');
|
|
|
|
end;
|
2008-04-07 14:06:35 +00:00
|
|
|
end;
|
|
|
|
|
2008-04-23 10:02:36 +00:00
|
|
|
const
|
|
|
|
ClassMethodCaller : array [ Boolean] of AnsiString = (
|
2008-04-25 13:47:19 +00:00
|
|
|
'Handle', 'getClass'
|
2008-04-23 10:02:36 +00:00
|
|
|
);
|
|
|
|
|
2008-04-07 14:06:35 +00:00
|
|
|
// writes out a method to implementation section
|
|
|
|
procedure WriteOutMethod(mtd: TClassMethodDef; subs: TStrings);
|
|
|
|
var
|
|
|
|
s : AnsiString;
|
|
|
|
typeName : AnsiString;
|
|
|
|
cl : TClassDef;
|
2008-04-25 13:47:19 +00:00
|
|
|
tp : TObjcConvertVarType;
|
|
|
|
res : AnsiString;
|
2008-04-17 13:58:59 +00:00
|
|
|
callobj : AnsiString;
|
2008-04-25 13:47:19 +00:00
|
|
|
mnm : AnsiString;
|
2008-04-30 13:51:19 +00:00
|
|
|
prms : AnsiString;
|
2008-04-07 14:06:35 +00:00
|
|
|
begin
|
|
|
|
cl := TClassDef(mtd.Owner);
|
2008-04-23 10:02:36 +00:00
|
|
|
callobj := ClassMethodCaller[mtd._IsClassMethod];
|
2008-04-23 07:59:44 +00:00
|
|
|
|
2008-04-25 13:47:19 +00:00
|
|
|
res := GetMethodResultType(mtd);
|
2009-02-16 11:50:17 +00:00
|
|
|
mnm :=mtd._Name; //RefixName(mtd._Name);
|
2008-04-25 13:47:19 +00:00
|
|
|
//s := Format('vmethod(%s, sel_registerName(PChar(Str%s_%s)), %s)', [callobj, cl._ClassName, RefixName(mtd._Name), GetParamsNames(mtd)]);
|
|
|
|
tp := GetObjCVarType(res);
|
2008-04-30 13:51:19 +00:00
|
|
|
prms := GetMethodParams(mtd, true);
|
2008-04-25 13:47:19 +00:00
|
|
|
case tp of
|
2008-04-30 13:51:19 +00:00
|
|
|
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]);
|
2008-04-25 13:47:19 +00:00
|
|
|
end;
|
|
|
|
|
2008-04-29 14:10:17 +00:00
|
|
|
if (tp <> vt_Struct) and (ObjCResultToDelphiType(mtd.GetResultType) <> '') then begin
|
|
|
|
if tp <> vt_FloatPoint then
|
|
|
|
s := Format('Result := %s(%s)', [res, s])
|
|
|
|
else
|
|
|
|
s := Format('Result := %s', [s]);
|
|
|
|
//s := 'Result := ' res(' + s+')';
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
2008-04-30 13:51:19 +00:00
|
|
|
ObjCMethodToProcType(mtd, typeName, subs, tp=vt_Struct);
|
2008-04-07 14:06:35 +00:00
|
|
|
subs.Add('var');
|
|
|
|
subs.Add(
|
|
|
|
Format(' vmethod: %s;', [typeName]));
|
|
|
|
subs.Add('begin');
|
2008-04-30 13:51:19 +00:00
|
|
|
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;
|
2008-04-07 14:06:35 +00:00
|
|
|
subs.Add(
|
|
|
|
Format(' %s;', [s]));
|
|
|
|
subs.Add('end;');
|
|
|
|
end;
|
|
|
|
|
|
|
|
// writes out a method to implementation section, that has no params
|
|
|
|
procedure WriteOutMethodNoParams(mtd: TClassMethodDef; subs: TStrings);
|
|
|
|
var
|
2008-04-17 13:58:59 +00:00
|
|
|
s : AnsiString;
|
|
|
|
res : AnsiString;
|
|
|
|
cl : TClassDef;
|
|
|
|
callobj : AnsiString;
|
2008-04-22 08:07:37 +00:00
|
|
|
tp : TObjcConvertVarType;
|
|
|
|
mnm : AnsiString;
|
2008-04-07 14:06:35 +00:00
|
|
|
begin
|
|
|
|
cl := TClassDef(mtd.owner);
|
2008-04-23 10:02:36 +00:00
|
|
|
callobj := ClassMethodCaller[mtd._IsClassMethod];
|
2008-04-07 14:06:35 +00:00
|
|
|
res := GetMethodResultType(mtd);
|
2008-04-22 08:07:37 +00:00
|
|
|
tp := GetObjCVarType(res);
|
|
|
|
|
2009-02-16 11:50:17 +00:00
|
|
|
//mnm := RefixName(mtd._Name);
|
|
|
|
mnm := mtd._Name;
|
2008-04-30 13:51:19 +00:00
|
|
|
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 + ';';
|
2008-04-23 07:59:44 +00:00
|
|
|
|
2008-04-30 13:51:19 +00:00
|
|
|
subs.Add('begin');
|
|
|
|
subs.Add(' ' + s);
|
|
|
|
subs.Add('end;');
|
2008-04-07 14:06:35 +00:00
|
|
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure WriteOutMethodToImplementation(mtd: TClassMethodDef; subs: TStrings);
|
|
|
|
var
|
|
|
|
cl : TClassDef;
|
2008-03-25 08:24:19 +00:00
|
|
|
typeName : AnsiString;
|
|
|
|
begin
|
2008-03-28 10:25:27 +00:00
|
|
|
typeName := '';
|
2008-03-25 08:24:19 +00:00
|
|
|
if not Assigned(mtd.Owner) or (not (TObject(mtd.Owner) is TClassDef)) then Exit; // method cannot be without owning class
|
|
|
|
cl := TClassDef(mtd.Owner);
|
|
|
|
|
2008-04-07 14:06:35 +00:00
|
|
|
subs.Add(GetMethodStr(cl, mtd, true));//writes out method header, like function NsType.NsName(params): Result
|
|
|
|
if IsMethodConstructor(cl, mtd) then
|
|
|
|
WriteOutConstructorMethod(mtd, subs)
|
|
|
|
else if not isAnyParam(mtd) then
|
|
|
|
WriteOutMethodNoParams(mtd, subs)
|
|
|
|
else
|
|
|
|
WriteOutMethod(mtd, subs);
|
2008-03-25 08:24:19 +00:00
|
|
|
subs.Add('');
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
procedure WriteOutClassToImplementation(cl: TClassDef; subs: TStrings);
|
|
|
|
var
|
|
|
|
i : integer;
|
2008-03-27 15:28:02 +00:00
|
|
|
obj : TObject;
|
2008-03-25 08:24:19 +00:00
|
|
|
begin
|
|
|
|
subs.Add('{ '+cl._ClassName + ' }');
|
|
|
|
|
|
|
|
if cl._Category <> '' then begin
|
|
|
|
subs.Add(' //todo: classes of category');
|
|
|
|
Exit;
|
|
|
|
end;
|
|
|
|
|
|
|
|
subs.Add('');
|
2008-04-25 13:47:19 +00:00
|
|
|
subs.Add('class ' + GetProcFuncHead('getClass', cl._ClassName, '', 'objc.id'));
|
2008-03-25 08:24:19 +00:00
|
|
|
subs.Add('begin');
|
2008-04-07 14:06:35 +00:00
|
|
|
subs.Add(
|
|
|
|
Format(' Result := objc_getClass(Str%s_%s);', [cl._ClassName, cl._ClassName]));
|
|
|
|
subs.Add('end;');
|
2008-03-25 08:24:19 +00:00
|
|
|
subs.Add('');
|
|
|
|
|
2008-03-27 15:28:02 +00:00
|
|
|
for i := 0 to cl.Items.Count - 1 do begin
|
|
|
|
obj := TObject(cl.Items[i]);
|
|
|
|
if obj is TClassMethodDef then
|
|
|
|
WriteOutMethodToImplementation ( TClassMethodDef(cl.Items[i]), subs)
|
|
|
|
else if obj is TPrecompiler then
|
2008-03-28 10:25:27 +00:00
|
|
|
WriteOutIfDefPrecompiler( TPrecompiler(obj), '', subs);
|
2008-03-27 15:28:02 +00:00
|
|
|
end;
|
2008-03-25 08:24:19 +00:00
|
|
|
end;
|
|
|
|
|
2008-04-23 07:59:44 +00:00
|
|
|
procedure WriteOutImplementationSection(hdr: TObjCHeader; st: TStrings; consts: TStringList);
|
2008-03-25 08:24:19 +00:00
|
|
|
var
|
|
|
|
i : Integer;
|
2008-04-17 13:58:59 +00:00
|
|
|
subs : TStringList;
|
2008-03-25 08:24:19 +00:00
|
|
|
begin
|
2008-04-17 13:58:59 +00:00
|
|
|
subs := TStringList.Create;
|
2008-03-25 08:24:19 +00:00
|
|
|
try
|
2008-04-23 07:59:44 +00:00
|
|
|
|
|
|
|
if consts.Count > 0 then begin
|
|
|
|
subs.add('const');
|
|
|
|
subs.AddStrings(consts);
|
|
|
|
end;
|
|
|
|
|
2008-03-25 08:24:19 +00:00
|
|
|
for i := 0 to hdr.Items.Count - 1 do
|
2008-04-17 13:58:59 +00:00
|
|
|
if Assigned(hdr.Items[i]) then
|
2008-03-27 15:28:02 +00:00
|
|
|
if (TObject(hdr.Items[i]) is TClassDef) then
|
2008-04-17 13:58:59 +00:00
|
|
|
WriteOutClassToImplementation(TClassDef(hdr.Items[i]), subs);
|
|
|
|
|
|
|
|
if subs.Count = 0 then Exit;
|
|
|
|
|
|
|
|
BeginSection('IMPLEMENTATION', st);
|
|
|
|
try
|
|
|
|
st.AddStrings(subs);
|
|
|
|
finally
|
|
|
|
EndSection(st);
|
|
|
|
end;
|
|
|
|
|
2008-03-25 08:24:19 +00:00
|
|
|
finally
|
2008-04-17 13:58:59 +00:00
|
|
|
subs.Free;
|
2008-03-25 08:24:19 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
2008-04-15 14:13:34 +00:00
|
|
|
//Removed, must not be used, because enumerations must be converted to constants
|
2008-03-28 10:25:27 +00:00
|
|
|
function AppleEnumType(items: TList; TypeDefIdx: Integer): Boolean;
|
2008-04-15 14:13:34 +00:00
|
|
|
begin
|
|
|
|
Result := false;
|
|
|
|
{var
|
2008-03-28 10:25:27 +00:00
|
|
|
EnumIdx : integer;
|
|
|
|
typedef : TTypeNameDef;
|
|
|
|
enumdef : TEnumTypeDef;
|
|
|
|
const
|
|
|
|
AppleInherit = 'NSUInteger';
|
|
|
|
begin
|
|
|
|
Result := false;
|
|
|
|
EnumIdx := TypeDefIdx - 1;
|
|
|
|
if (EnumIdx < 0) or (EnumIdx >= items.Count) then Exit;
|
2008-04-07 14:06:35 +00:00
|
|
|
|
2008-03-28 10:25:27 +00:00
|
|
|
if (TObject(items.Items[TypeDefIdx]) is TTypeNameDef) and
|
2008-04-07 14:06:35 +00:00
|
|
|
(TObject(items.Items[EnumIdx]) is TEnumTypeDef) then begin
|
2008-03-28 10:25:27 +00:00
|
|
|
typedef := TTypeNameDef(items.Items[TypeDefIdx]);
|
|
|
|
enumdef := TEnumTypeDef(items.Items[EnumIdx]);
|
|
|
|
end else
|
|
|
|
Exit;
|
|
|
|
|
2008-04-07 14:06:35 +00:00
|
|
|
if typedef._Inherited = AppleInherit then begin
|
|
|
|
enumdef._Name := typedef._TypeName;
|
|
|
|
Result := true;
|
|
|
|
end;
|
2008-04-15 14:13:34 +00:00
|
|
|
}
|
2008-03-28 10:25:27 +00:00
|
|
|
end;
|
|
|
|
|
2008-04-01 06:29:04 +00:00
|
|
|
procedure FixAppleCategories(Items: TList; category: TClassDef);
|
|
|
|
var
|
|
|
|
i : Integer;
|
|
|
|
j : Integer;
|
|
|
|
cl : TClassdef;
|
|
|
|
begin
|
|
|
|
for i := 0 to Items.Count - 1 do
|
|
|
|
if TObject(Items[i]) is TClassDef then begin
|
|
|
|
cl := TClassDef(Items[i]);
|
2008-04-23 07:59:44 +00:00
|
|
|
if (cl._ClassName = category._ClassName) and (cl._Category = '') then
|
2008-04-01 06:29:04 +00:00
|
|
|
for j := 0 to category.Items.Count - 1 do begin
|
|
|
|
cl.Items.Add(category.Items[j]);
|
|
|
|
TEntity(category.Items[j]).owner := cl;
|
|
|
|
end; {of if}
|
|
|
|
end; {of if}
|
|
|
|
end;
|
|
|
|
|
2008-04-17 13:58:59 +00:00
|
|
|
procedure FixAppleClassDef(cl: TClassDef);
|
2008-04-22 08:07:37 +00:00
|
|
|
var
|
|
|
|
i : integer;
|
|
|
|
j : integer;
|
|
|
|
res : TClassMethodDef;
|
|
|
|
mtd : TClassMethodDef;
|
|
|
|
mtdnames : TStringList;
|
|
|
|
begin
|
|
|
|
//todo: use hash table
|
|
|
|
mtdnames := TStringList.Create;
|
|
|
|
try
|
|
|
|
for i := 0 to cl.Items.Count - 1 do
|
|
|
|
if TObject(cl.Items[i]) is TClassMethodDef then begin
|
|
|
|
mtd := TClassMethodDef(cl.Items[i]);
|
|
|
|
j := mtdnames.IndexOf(mtd._Name);
|
|
|
|
if j < 0 then
|
|
|
|
mtdnames.AddObject(mtd._Name, mtd)
|
|
|
|
else begin
|
|
|
|
res := TClassMethodDef(mtdnames.Objects[j]);
|
|
|
|
if res._IsClassMethod then res._Name := res._Name + '_'
|
|
|
|
else if mtd._IsClassMethod then mtd._Name := mtd._Name + '_';
|
|
|
|
end;
|
2008-04-22 11:13:59 +00:00
|
|
|
if IsPascalReserved(mtd._Name) then
|
|
|
|
mtd._Name := mtd._Name + '_';
|
2008-04-22 08:07:37 +00:00
|
|
|
end;
|
|
|
|
finally
|
|
|
|
mtdnames.Free;
|
|
|
|
end;
|
2008-04-17 13:58:59 +00:00
|
|
|
//nothing todo...
|
|
|
|
end;
|
|
|
|
|
2008-04-22 11:13:59 +00:00
|
|
|
procedure FastPack(Items: TList);
|
|
|
|
var
|
|
|
|
i, j : INteger;
|
|
|
|
begin
|
|
|
|
j := 0;
|
|
|
|
for i := 0 to Items.Count - 1 do
|
|
|
|
if Assigned(Items[i]) then begin
|
|
|
|
Items[j] := Items[i];
|
|
|
|
inc(j);
|
|
|
|
end;
|
|
|
|
Items.Count := j;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure FixObjCClassTypeDef(ent: TEntity);
|
2008-03-28 10:25:27 +00:00
|
|
|
var
|
|
|
|
i : Integer;
|
2008-04-01 06:29:04 +00:00
|
|
|
j : Integer;
|
2008-04-22 11:13:59 +00:00
|
|
|
cl : TClassDef;
|
|
|
|
begin
|
|
|
|
for i := 0 to ent.Items.Count - 1 do begin
|
|
|
|
if not (TObject(ent.Items[i]) is TClassDef) then Continue;
|
|
|
|
cl := TClassDef(ent.Items[i]);
|
|
|
|
for j := 0 to cl.Items.Count - 1 do begin
|
|
|
|
if not IsTypeDefEntity(cl.Items[j]) then Continue;
|
|
|
|
ent.Items.Add(cl.Items[j]);
|
|
|
|
TEntity(cl.Items[j]).Owner := ent;
|
|
|
|
cl.Items[j] := nil;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
FastPack(ent.Items);
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure AppleHeaderFix(ent : TEntity);
|
|
|
|
var
|
|
|
|
i : Integer;
|
2008-04-30 13:51:19 +00:00
|
|
|
j : Integer;
|
2008-03-28 10:25:27 +00:00
|
|
|
obj : TEntity;
|
2008-04-25 13:47:19 +00:00
|
|
|
prm : TObjCParameterDef;
|
2008-04-29 14:10:17 +00:00
|
|
|
res : TObjCResultTypeDef;
|
|
|
|
td : TTypeDef;
|
2008-03-28 10:25:27 +00:00
|
|
|
begin
|
2008-04-01 06:29:04 +00:00
|
|
|
// i := 0;
|
|
|
|
for i := 0 to ent.Items.Count - 1 do begin
|
2008-03-28 10:25:27 +00:00
|
|
|
obj := TEntity(ent.Items[i]);
|
2008-04-01 06:29:04 +00:00
|
|
|
if (obj is TTypeNameDef) and (AppleEnumType(ent.Items, i)) then begin
|
|
|
|
ent.Items[i] := nil;
|
|
|
|
obj.Free;
|
2008-04-08 09:22:54 +00:00
|
|
|
end else if (obj is TClassDef) and ((TClassDef(obj)._SuperClass = '') and (TClassDef(obj)._Category <> ''))then begin
|
2008-04-01 06:29:04 +00:00
|
|
|
FixAppleCategories(ent.Items, TClassDef(obj));
|
|
|
|
ent.Items[i] := nil;
|
|
|
|
obj.Free;
|
2008-04-08 09:22:54 +00:00
|
|
|
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'
|
2008-04-30 13:51:19 +00:00
|
|
|
{end else if (obj is TParamDescr) then begin
|
2008-04-01 06:29:04 +00:00
|
|
|
if IsPascalReserved(TParamDescr(obj)._Descr) then
|
2008-04-30 13:51:19 +00:00
|
|
|
TParamDescr(obj)._Descr := '_'+TParamDescr(obj)._Descr}
|
2008-04-29 14:10:17 +00:00
|
|
|
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;
|
2008-04-01 06:29:04 +00:00
|
|
|
end else if (obj is TObjCParameterDef) then begin
|
2008-04-25 13:47:19 +00:00
|
|
|
prm := TObjCParameterDef(obj);
|
2008-04-29 14:10:17 +00:00
|
|
|
|
|
|
|
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;
|
|
|
|
|
2008-04-30 13:51:19 +00:00
|
|
|
if IsPascalReserved(prm._Name) then
|
2008-04-25 13:47:19 +00:00
|
|
|
prm._Name := '_' + prm._Name;
|
|
|
|
|
|
|
|
end else if (obj is TStructField) then begin
|
2008-04-29 14:10:17 +00:00
|
|
|
// should _TypeName to be removed?
|
|
|
|
if ConvertSettings.ObjCClassTypes.IndexOf(TStructField(obj)._TypeName) >= 0 then begin
|
|
|
|
TStructField(obj)._TypeName := 'objc.id'
|
|
|
|
end;
|
2008-04-30 13:51:19 +00:00
|
|
|
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]);
|
2008-04-01 06:29:04 +00:00
|
|
|
end;
|
2008-04-29 14:10:17 +00:00
|
|
|
|
|
|
|
|
2008-03-28 10:25:27 +00:00
|
|
|
end;
|
2008-04-01 06:29:04 +00:00
|
|
|
|
2008-04-17 13:58:59 +00:00
|
|
|
// packing list, removing nil references.
|
2008-04-22 11:13:59 +00:00
|
|
|
FastPack(ent.Items);
|
2009-01-17 22:24:04 +00:00
|
|
|
|
2008-04-22 11:13:59 +00:00
|
|
|
for i := 0 to ent.Items.Count - 1 do
|
2008-03-28 10:25:27 +00:00
|
|
|
AppleHeaderFix( TEntity(ent.Items[i]));
|
2008-04-08 09:22:54 +00:00
|
|
|
|
2008-03-28 10:25:27 +00:00
|
|
|
end;
|
|
|
|
|
2008-04-17 13:58:59 +00:00
|
|
|
procedure WriteOutForwardSection(hdr: TObjCHeader; st: TStrings);
|
|
|
|
var
|
|
|
|
i : integer;
|
|
|
|
subs : TStringList;
|
|
|
|
begin
|
|
|
|
subs := TStringList.Create;
|
|
|
|
try
|
|
|
|
for i := 0 to hdr.Items.Count - 1 do
|
|
|
|
if TObject(hdr.Items[i]) is TClassDef then
|
|
|
|
subs.Add(Format (' %s = class;', [TClassDef(hdr.Items[i])._ClassName]));
|
|
|
|
if subs.Count > 0 then begin
|
|
|
|
BeginSection('FORWARD', st);
|
2008-06-09 08:12:20 +00:00
|
|
|
// BeginExcludeSection( GetIfDefFileName(hdr._FileName, '_FORWARD'), st);
|
2008-04-17 13:58:59 +00:00
|
|
|
try
|
|
|
|
st.AddStrings(subs);
|
2008-06-09 08:12:20 +00:00
|
|
|
st.Add('');
|
2008-04-17 13:58:59 +00:00
|
|
|
finally
|
2008-06-09 08:12:20 +00:00
|
|
|
//EndSection(st);
|
2008-04-17 13:58:59 +00:00
|
|
|
EndSection(st);
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
finally
|
|
|
|
subs.Free;
|
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
2008-03-25 08:24:19 +00:00
|
|
|
procedure WriteOutIncludeFile(hdr: TObjCHeader; st: TStrings);
|
2008-03-28 10:25:27 +00:00
|
|
|
var
|
2008-04-23 07:59:44 +00:00
|
|
|
i : integer;
|
|
|
|
cmt : TComment;
|
|
|
|
cl : TClassDef;
|
|
|
|
subs : TStringList;
|
|
|
|
consts : TStringList;
|
2008-04-30 13:51:19 +00:00
|
|
|
used : TStringList;
|
2008-03-25 08:24:19 +00:00
|
|
|
begin
|
2008-04-23 07:59:44 +00:00
|
|
|
subs := TStringList.Create;
|
|
|
|
consts := TStringList.Create;
|
2008-04-01 06:29:04 +00:00
|
|
|
try
|
2008-04-08 09:22:54 +00:00
|
|
|
st.AddStrings(ConvertSettings.ConvertPrefix);
|
2008-04-23 07:59:44 +00:00
|
|
|
|
2008-04-30 13:51:19 +00:00
|
|
|
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;
|
2009-01-18 14:05:34 +00:00
|
|
|
//used := nil;
|
2008-04-30 13:51:19 +00:00
|
|
|
end;
|
|
|
|
|
2008-04-01 06:29:04 +00:00
|
|
|
if hdr.Items.Count <= 0 then Exit;
|
|
|
|
AppleHeaderFix(hdr);
|
|
|
|
|
2008-04-25 13:47:19 +00:00
|
|
|
FixObjCClassTypeDef(hdr);
|
|
|
|
|
2008-04-01 06:29:04 +00:00
|
|
|
// .inc header-comment is the first comment entity in .h file , if any
|
|
|
|
if TObject(hdr.Items[0]) is TComment then begin
|
|
|
|
cmt := TComment(hdr.Items[0]);
|
|
|
|
st.Add('(*' + cmt._Comment + '*)');
|
|
|
|
cmt.Free;
|
|
|
|
hdr.Items.Delete(0);
|
|
|
|
end;
|
2008-03-28 10:25:27 +00:00
|
|
|
|
2008-04-23 07:59:44 +00:00
|
|
|
|
2008-04-01 06:29:04 +00:00
|
|
|
WriteOutHeaderSection(hdr, st);
|
2008-04-17 13:58:59 +00:00
|
|
|
WriteOutForwardSection(hdr, st);
|
2008-04-23 07:59:44 +00:00
|
|
|
|
2008-04-22 08:07:37 +00:00
|
|
|
for i := 0 to hdr.Items.Count - 1 do
|
|
|
|
if TObject(hdr.Items[i]) is TClassDef then
|
|
|
|
FixAppleClassDef(TClassDef(hdr.Items[i]));
|
2008-04-23 07:59:44 +00:00
|
|
|
|
2008-04-01 06:29:04 +00:00
|
|
|
WriteOutClassesSection(hdr, st);
|
2008-04-23 07:59:44 +00:00
|
|
|
WriteOutImplementationSection(hdr, st, subs);
|
|
|
|
finally
|
|
|
|
subs.Free;
|
|
|
|
consts.Free;
|
2008-03-28 10:25:27 +00:00
|
|
|
end;
|
2008-03-25 08:24:19 +00:00
|
|
|
end;
|
|
|
|
|
2008-04-07 14:06:35 +00:00
|
|
|
procedure WriteOutMainFramework(hdr: TObjCHeader; st: TStrings);
|
|
|
|
//var
|
|
|
|
// i : integer;
|
|
|
|
// nm : AnsiString;
|
|
|
|
begin
|
|
|
|
end;
|
|
|
|
|
|
|
|
{ TConvertSettings }
|
|
|
|
|
2008-04-29 14:10:17 +00:00
|
|
|
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;
|
|
|
|
|
2008-04-07 14:06:35 +00:00
|
|
|
constructor TConvertSettings.Create;
|
|
|
|
begin
|
2008-04-15 14:13:34 +00:00
|
|
|
IgnoreTokens := TStringList.Create;
|
2008-04-07 14:06:35 +00:00
|
|
|
IgnoreIncludes := TStringList.Create;
|
|
|
|
IgnoreIncludes.CaseSensitive := false;
|
|
|
|
DefineReplace := TReplaceList.Create;
|
|
|
|
TypeDefReplace := TReplaceList.Create; // replaces for default types
|
2008-04-25 13:47:19 +00:00
|
|
|
PtrTypeReplace := TReplaceList.Create; // replaces for C types pointers
|
2008-04-08 09:22:54 +00:00
|
|
|
ConvertPrefix := TStringList.Create;
|
2008-04-22 08:07:37 +00:00
|
|
|
|
|
|
|
FloatTypes := TStringList.Create;
|
|
|
|
FloatTypes.CaseSensitive := false;
|
|
|
|
|
|
|
|
StructTypes := TStringList.Create;
|
|
|
|
StructTypes.CaseSensitive := false;
|
|
|
|
|
2008-04-29 14:10:17 +00:00
|
|
|
ObjCClassTypes := TStringList.Create;
|
|
|
|
ObjCClassTypes.CaseSensitive := false;
|
2008-04-23 07:59:44 +00:00
|
|
|
|
2008-04-29 14:10:17 +00:00
|
|
|
CustomTypes := TStringList.Create;
|
2008-04-07 14:06:35 +00:00
|
|
|
end;
|
|
|
|
|
|
|
|
destructor TConvertSettings.Destroy;
|
|
|
|
begin
|
2008-04-22 08:07:37 +00:00
|
|
|
FloatTypes.Free;
|
|
|
|
StructTypes.Free;
|
2008-04-29 14:10:17 +00:00
|
|
|
ObjCClassTypes.Free;
|
2008-04-22 08:07:37 +00:00
|
|
|
|
2008-04-15 14:13:34 +00:00
|
|
|
IgnoreTokens.Free;
|
2008-04-07 14:06:35 +00:00
|
|
|
IgnoreIncludes.Free;
|
|
|
|
TypeDefReplace.Free;
|
2008-04-25 13:47:19 +00:00
|
|
|
PtrTypeReplace.Free;
|
2008-04-07 14:06:35 +00:00
|
|
|
DefineReplace.Free;
|
2008-04-08 09:22:54 +00:00
|
|
|
ConvertPrefix.Free;
|
2008-04-29 14:10:17 +00:00
|
|
|
CustomTypes.Free;
|
2008-04-07 14:06:35 +00:00
|
|
|
inherited Destroy;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure InitConvertSettings;
|
|
|
|
begin
|
|
|
|
with ConvertSettings.IgnoreIncludes do begin
|
|
|
|
// must not be $included, because they are used
|
2008-04-08 10:45:08 +00:00
|
|
|
// Add('Foundation/');
|
|
|
|
// Add('Foundation/NSObject.h');
|
|
|
|
// Add('NSObjCRuntime.h');
|
|
|
|
// Add('Foundation/NSObject.h');
|
|
|
|
// Add('Foundation/Foundation.h');
|
2008-04-07 14:06:35 +00:00
|
|
|
end;
|
2008-04-16 14:33:21 +00:00
|
|
|
|
2008-04-07 14:06:35 +00:00
|
|
|
with ConvertSettings do begin
|
2008-04-29 14:10:17 +00:00
|
|
|
{DefineReplace['MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_2'] := 'MAC_OS_X_VERSION_10_2';
|
2008-04-07 14:06:35 +00:00
|
|
|
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_5'] := 'MAC_OS_X_VERSION_10_5';
|
2008-04-29 14:10:17 +00:00
|
|
|
DefineReplace['__LP64__'] := 'LP64';}
|
2008-04-16 14:33:21 +00:00
|
|
|
|
2008-04-17 13:58:59 +00:00
|
|
|
TypeDefReplace['unsigned char'] := 'byte';
|
2008-04-22 08:07:37 +00:00
|
|
|
TypeDefReplace['uint8_t'] := 'byte';
|
2008-04-25 13:47:19 +00:00
|
|
|
PtrTypeReplace['uint8_t'] := 'PByte';
|
2008-04-29 14:10:17 +00:00
|
|
|
PtrTypeReplace['unsigned char'] := 'PChar';
|
|
|
|
PtrTypeReplace['char'] := 'PChar';
|
2008-04-17 13:58:59 +00:00
|
|
|
|
2008-04-16 14:33:21 +00:00
|
|
|
TypeDefReplace['short'] := 'SmallInt';
|
|
|
|
TypeDefReplace['short int'] := 'SmallInt';
|
2008-04-17 13:58:59 +00:00
|
|
|
|
2008-04-16 14:33:21 +00:00
|
|
|
TypeDefReplace['unsigned short'] := 'Word';
|
2008-04-17 13:58:59 +00:00
|
|
|
TypeDefReplace['unsigned short int'] := 'Word';
|
2008-04-22 08:07:37 +00:00
|
|
|
TypeDefReplace['uint16_t'] := 'Word';
|
2008-04-17 13:58:59 +00:00
|
|
|
|
2008-04-16 14:33:21 +00:00
|
|
|
TypeDefReplace['int'] := 'Integer';
|
2008-04-29 14:10:17 +00:00
|
|
|
TypeDefReplace['signed'] := 'Integer';
|
2008-04-17 13:58:59 +00:00
|
|
|
TypeDefReplace['signed int'] := 'Integer';
|
2008-04-22 08:07:37 +00:00
|
|
|
TypeDefReplace['int32_t'] := 'Integer';
|
|
|
|
TypeDefReplace['NSInteger'] := 'Integer';
|
2008-04-17 13:58:59 +00:00
|
|
|
|
|
|
|
TypeDefReplace['unsigned'] := 'LongWord';
|
|
|
|
TypeDefReplace['unsigned int'] := 'LongWord';
|
2008-04-22 08:07:37 +00:00
|
|
|
TypeDefReplace['uint32_t'] := 'LongWord';
|
|
|
|
TypeDefReplace['NSUInteger'] := 'LongWord';
|
2008-04-17 13:58:59 +00:00
|
|
|
|
2008-04-29 14:10:17 +00:00
|
|
|
PtrTypeReplace['int'] := 'PInteger';
|
|
|
|
PtrTypeReplace['signed'] := 'PInteger';
|
|
|
|
PtrTypeReplace['signed int'] := 'PInteger';
|
|
|
|
PtrTypeReplace['int32_t'] := 'PInteger';
|
|
|
|
PtrTypeReplace['NSInteger'] := 'PInteger';
|
2008-04-25 13:47:19 +00:00
|
|
|
|
2008-04-29 14:10:17 +00:00
|
|
|
PtrTypeReplace['unsigned'] := 'PLongWord';
|
|
|
|
PtrTypeReplace['unsigned int'] := 'PLongWord';
|
|
|
|
PtrTypeReplace['uint32_t'] := 'PLongWord';
|
|
|
|
PtrTypeReplace['NSUInteger'] := 'PLongWord';
|
2008-04-25 13:47:19 +00:00
|
|
|
|
2008-04-29 14:10:17 +00:00
|
|
|
TypeDefReplace['long long'] := 'Int64';
|
|
|
|
TypeDefReplace['singned long long'] := 'Int64';
|
2008-04-16 14:33:21 +00:00
|
|
|
TypeDefReplace['unsigned long long'] := 'Int64';
|
2008-04-22 08:07:37 +00:00
|
|
|
TypeDefReplace['int64_t'] := 'Int64';
|
|
|
|
TypeDefReplace['uint64_t'] := 'Int64';
|
2008-04-29 14:10:17 +00:00
|
|
|
|
|
|
|
PtrTypeReplace['long long'] := 'PInt64';
|
|
|
|
PtrTypeReplace['singned long long'] := 'PInt64';
|
|
|
|
PtrTypeReplace['unsigned long long'] := 'PInt64';
|
|
|
|
PtrTypeReplace['int64_t'] := 'PInt64';
|
2008-04-25 13:47:19 +00:00
|
|
|
PtrTypeReplace['uint64_t'] := 'PInt64';
|
2008-04-17 13:58:59 +00:00
|
|
|
|
|
|
|
TypeDefReplace['float'] := 'Single';
|
2008-04-16 14:33:21 +00:00
|
|
|
TypeDefReplace['CGFloat'] := 'Single';
|
2008-04-29 14:10:17 +00:00
|
|
|
PtrTypeReplace['double'] := 'PDouble';
|
|
|
|
PtrTypeReplace['float'] := 'PSingle';
|
|
|
|
PtrTypeReplace['CGFloat'] := 'PSingle';
|
2008-04-17 13:58:59 +00:00
|
|
|
|
|
|
|
TypeDefReplace['Class'] := '_Class';
|
2008-04-23 07:59:44 +00:00
|
|
|
|
2008-04-17 13:58:59 +00:00
|
|
|
TypeDefReplace['SRefCon'] := 'Pointer';
|
|
|
|
TypeDefReplace['va_list'] := 'array of const';
|
2008-04-15 14:13:34 +00:00
|
|
|
|
2008-04-29 14:10:17 +00:00
|
|
|
TypeDefReplace['uint8_t']:='byte';
|
|
|
|
TypeDefReplace['unsigned long long']:='Int64';
|
|
|
|
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';
|
|
|
|
|
2008-04-23 07:59:44 +00:00
|
|
|
StructTypes.Add('Int64');
|
2008-04-29 14:10:17 +00:00
|
|
|
{ StructTypes.Add('NSAffineTransformStruct');
|
2008-04-22 08:07:37 +00:00
|
|
|
FloatTypes.Add('NSTimeInterval');
|
2008-04-29 14:10:17 +00:00
|
|
|
FloatTypes.Add('CFFloat');}
|
2008-04-22 08:07:37 +00:00
|
|
|
|
2008-04-29 14:10:17 +00:00
|
|
|
{IgnoreTokens.Add('DEPRECATED_IN_MAC_OS_X_VERSION_10_5_AND_LATER');
|
2008-04-22 08:07:37 +00:00
|
|
|
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_4_AND_LATER');
|
|
|
|
IgnoreTokens.Add('AVAILABLE_MAC_OS_X_VERSION_10_3_AND_LATER');
|
2008-04-29 14:10:17 +00:00
|
|
|
IgnoreTokens.Add('AVAILABLE_MAC_OS_X_VERSION_10_2_AND_LATER');}
|
2008-04-07 14:06:35 +00:00
|
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
{ TReplaceList }
|
|
|
|
|
|
|
|
constructor TReplaceList.Create;
|
|
|
|
begin
|
|
|
|
inherited Create;
|
|
|
|
fItems := TStringList.Create;
|
|
|
|
end;
|
|
|
|
|
|
|
|
destructor TReplaceList.Destroy;
|
|
|
|
begin
|
|
|
|
fItems.Free;
|
|
|
|
inherited;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TReplaceList.GetCaseSense: Boolean;
|
|
|
|
begin
|
|
|
|
Result := fItems.CaseSensitive;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TReplaceList.SetCaseSense(AValue: Boolean);
|
|
|
|
begin
|
|
|
|
fITems.CaseSensitive := AValue;
|
|
|
|
end;
|
|
|
|
|
|
|
|
function TReplaceList.GetReplace(const ARepl: AnsiString): AnsiString;
|
|
|
|
var
|
|
|
|
i : integer;
|
|
|
|
begin
|
|
|
|
i := fItems.IndexOf(ARepl);
|
|
|
|
if i < 0 then Result := ''
|
|
|
|
else Result := TReplaceItem(fItems.Objects[i]).ReplaceStr;
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure TReplaceList.SetReplace(const ARepl, AValue: AnsiString);
|
|
|
|
var
|
|
|
|
i : integer;
|
|
|
|
it : TReplaceItem;
|
|
|
|
begin
|
|
|
|
i := fItems.IndexOf(ARepl);
|
|
|
|
if i < 0 then begin
|
|
|
|
it := TReplaceItem.Create;
|
|
|
|
it.ReplaceStr := AValue;
|
|
|
|
fItems.AddObject(Arepl, it);
|
|
|
|
end else
|
|
|
|
TReplaceItem(fItems.Objects[i]).ReplaceStr := AValue;
|
|
|
|
end;
|
|
|
|
|
2009-02-25 19:40:38 +00:00
|
|
|
|
2008-04-07 14:06:35 +00:00
|
|
|
initialization
|
|
|
|
ConvertSettings := TConvertSettings.Create;
|
|
|
|
InitConvertSettings;
|
|
|
|
|
|
|
|
finalization
|
|
|
|
ConvertSettings.Free;
|
|
|
|
|
2008-03-25 08:24:19 +00:00
|
|
|
end.
|