You've already forked lazarus-ccr
+ started separation of ObjCParserUtils unit to ObjCtoPas
* changed Pascal method name generation. Each parameter ':' is now replaced underscore git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@710 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -17,7 +17,7 @@ interface
|
|||||||
{$endif}
|
{$endif}
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, ObjCParserTypes;
|
Classes, SysUtils, ObjCParserTypes, ObjCToPas;
|
||||||
|
|
||||||
type
|
type
|
||||||
{ TConvertSettings }
|
{ TConvertSettings }
|
||||||
@ -358,25 +358,6 @@ begin
|
|||||||
Result := (l = 'id') or (l = cl._ClassName);
|
Result := (l = 'id') or (l = cl._ClassName);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function GetMethodPascalName(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 begin
|
|
||||||
Result := Result + TParamDescr(obj)._Descr;
|
|
||||||
end else if obj is TObjCParameterDef then
|
|
||||||
Result := Result + '_';
|
|
||||||
end;
|
|
||||||
i := length(Result);
|
|
||||||
while (i > 0) and (Result[i] = '_') do dec(i);
|
|
||||||
Result := Copy(Result, 1, i);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function GetMethodStr(cl: TClassDef; m: TClassMethodDef; ForImplementation: Boolean): AnsiString;
|
function GetMethodStr(cl: TClassDef; m: TClassMethodDef; ForImplementation: Boolean): AnsiString;
|
||||||
var
|
var
|
||||||
// i : integer;
|
// i : integer;
|
||||||
@ -665,7 +646,7 @@ var
|
|||||||
mtd : TClassMethodDef;
|
mtd : TClassMethodDef;
|
||||||
obj : TObject;
|
obj : TObject;
|
||||||
cs : AnsiString;
|
cs : AnsiString;
|
||||||
nm : AnsiString;
|
objcname : AnsiString;
|
||||||
begin
|
begin
|
||||||
cs := GetClassConst(cl._ClassName, cl._ClassName);
|
cs := GetClassConst(cl._ClassName, cl._ClassName);
|
||||||
if conststr.IndexOf(cs) < 0 then begin
|
if conststr.IndexOf(cs) < 0 then begin
|
||||||
@ -679,14 +660,14 @@ begin
|
|||||||
if obj is TClassMethodDef then begin
|
if obj is TClassMethodDef then begin
|
||||||
mtd := TClassMethodDef(cl.Items[i]);
|
mtd := TClassMethodDef(cl.Items[i]);
|
||||||
|
|
||||||
nm := GetMethodPascalName(mtd);
|
objcName := GetMethodConstName(mtd);
|
||||||
cs := GetClassConst(cl._ClassName, nm);
|
mtd._Name := ObjCToPasMethodName(mtd);
|
||||||
|
cs := GetClassConst(cl._ClassName, mtd._Name);
|
||||||
if conststr.IndexOf(cs) < 0 then begin
|
if conststr.IndexOf(cs) < 0 then begin
|
||||||
conststr.Add(cs);
|
conststr.Add(cs);
|
||||||
ss := Format(' %s = ''%s'';', [cs, GetMethodConstName(mtd)]);
|
ss := Format(' %s = ''%s'';', [cs, objcname]);
|
||||||
subs.add(ss);
|
subs.add(ss);
|
||||||
end;
|
end;
|
||||||
mtd._Name := nm;
|
|
||||||
|
|
||||||
end;
|
end;
|
||||||
end; {of for}
|
end; {of for}
|
||||||
@ -1361,13 +1342,13 @@ end;*)
|
|||||||
// adds procedure type and variable of objC init??? method, to wrap obj_SendMsg
|
// adds procedure type and variable of objC init??? method, to wrap obj_SendMsg
|
||||||
// initialize ObjC object structure calling init??? method
|
// initialize ObjC object structure calling init??? method
|
||||||
|
|
||||||
function RefixName(const mtdName: AnsiString): AnsiString;
|
{function RefixName(const mtdName: AnsiString): AnsiString;
|
||||||
begin
|
begin
|
||||||
Result := mtdName;
|
Result := mtdName;
|
||||||
if mtdName = '' then Exit;
|
if mtdName = '' then Exit;
|
||||||
if mtdName[length(mtdName)] = '_' then
|
if mtdName[length(mtdName)] = '_' then
|
||||||
Result := Copy(mtdName, 1, length(mtdName) - 1);
|
Result := Copy(mtdName, 1, length(mtdName) - 1);
|
||||||
end;
|
end;}
|
||||||
|
|
||||||
procedure WriteOutConstructorMethod(mtd: TClassMethodDef; subs: TStrings);
|
procedure WriteOutConstructorMethod(mtd: TClassMethodDef; subs: TStrings);
|
||||||
var
|
var
|
||||||
@ -1391,7 +1372,7 @@ begin
|
|||||||
subs.Add(
|
subs.Add(
|
||||||
Format(' vmethod := %s(@objc_msgSend);', [typeName]));
|
Format(' vmethod := %s(@objc_msgSend);', [typeName]));
|
||||||
subs.Add(
|
subs.Add(
|
||||||
Format(' Handle := vmethod(allocbuf, sel_registerName(PChar(Str%s_%s))%s);', [cl._ClassName, RefixName(mtd._Name), prms]));
|
Format(' Handle := vmethod(allocbuf, sel_registerName(PChar(Str%s_%s))%s);', [cl._ClassName, mtd._Name, prms]));
|
||||||
subs.Add('end;');
|
subs.Add('end;');
|
||||||
end else begin
|
end else begin
|
||||||
subs.Add('var');
|
subs.Add('var');
|
||||||
@ -1402,7 +1383,7 @@ begin
|
|||||||
subs.Add(
|
subs.Add(
|
||||||
Format(' vmethod := %s(@objc_msgSend);', [typeName]));
|
Format(' vmethod := %s(@objc_msgSend);', [typeName]));
|
||||||
subs.Add(
|
subs.Add(
|
||||||
Format(' Handle := vmethod(ClassID, sel_registerName(PChar(Str%s_%s))%s);', [cl._ClassName, RefixName(mtd._Name), prms]));
|
Format(' Handle := vmethod(ClassID, sel_registerName(PChar(Str%s_%s))%s);', [cl._ClassName, mtd._Name, prms]));
|
||||||
subs.Add('end;');
|
subs.Add('end;');
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -1428,7 +1409,7 @@ begin
|
|||||||
callobj := ClassMethodCaller[mtd._IsClassMethod];
|
callobj := ClassMethodCaller[mtd._IsClassMethod];
|
||||||
|
|
||||||
res := GetMethodResultType(mtd);
|
res := GetMethodResultType(mtd);
|
||||||
mnm := RefixName(mtd._Name);
|
mnm :=mtd._Name; //RefixName(mtd._Name);
|
||||||
//s := Format('vmethod(%s, sel_registerName(PChar(Str%s_%s)), %s)', [callobj, cl._ClassName, RefixName(mtd._Name), GetParamsNames(mtd)]);
|
//s := Format('vmethod(%s, sel_registerName(PChar(Str%s_%s)), %s)', [callobj, cl._ClassName, RefixName(mtd._Name), GetParamsNames(mtd)]);
|
||||||
tp := GetObjCVarType(res);
|
tp := GetObjCVarType(res);
|
||||||
prms := GetMethodParams(mtd, true);
|
prms := GetMethodParams(mtd, true);
|
||||||
@ -1478,7 +1459,8 @@ begin
|
|||||||
res := GetMethodResultType(mtd);
|
res := GetMethodResultType(mtd);
|
||||||
tp := GetObjCVarType(res);
|
tp := GetObjCVarType(res);
|
||||||
|
|
||||||
mnm := RefixName(mtd._Name);
|
//mnm := RefixName(mtd._Name);
|
||||||
|
mnm := mtd._Name;
|
||||||
case tp of
|
case tp of
|
||||||
vt_Int, vt_Object:
|
vt_Int, vt_Object:
|
||||||
s := Format('objc_msgSend(%s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
|
s := Format('objc_msgSend(%s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mnm ]);
|
||||||
|
46
bindings/pascocoa/parser/ObjCToPas.pas
Executable file
46
bindings/pascocoa/parser/ObjCToPas.pas
Executable file
@ -0,0 +1,46 @@
|
|||||||
|
unit ObjCToPas;
|
||||||
|
{ * This file is part of ObjCParser tool
|
||||||
|
* 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
|
||||||
|
* LGPL license along with at http://www.gnu.org/
|
||||||
|
}
|
||||||
|
// the unit contains (should contain) ObjC to Pascal convertion utility routines
|
||||||
|
// todo: move all ObjCParserUtils functions here.
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$ifdef fpc}{$mode delphi}{$h+}{$endif}
|
||||||
|
|
||||||
|
uses
|
||||||
|
ObjCParserTypes;
|
||||||
|
|
||||||
|
const
|
||||||
|
ObjCDefaultParamDelim = '_';
|
||||||
|
|
||||||
|
function ObjCToPasMethodName(mtd: TClassMethodDef; CutLastDelims: Boolean = false; ParamDelim: AnsiChar = ObjCDefaultParamDelim): AnsiString;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
function ObjCToPasMethodName(mtd: TClassMethodDef; CutLastDelims: Boolean; ParamDelim: AnsiChar): 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 begin
|
||||||
|
Result := Result + TParamDescr(obj)._Descr;
|
||||||
|
end else if obj is TObjCParameterDef then
|
||||||
|
Result := Result + ParamDelim;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if CutLastDelims then begin
|
||||||
|
i := length(Result);
|
||||||
|
while (i > 0) and (Result[i] = ParamDelim) do dec(i);
|
||||||
|
Result := Copy(Result, 1, i);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
@ -21,7 +21,8 @@ uses
|
|||||||
SysUtils,
|
SysUtils,
|
||||||
ObjCParserUtils,
|
ObjCParserUtils,
|
||||||
ObjCParserTypes,
|
ObjCParserTypes,
|
||||||
gnuccFeatures;
|
gnuccFeatures,
|
||||||
|
ObjCToPas in 'ObjCToPas.pas';
|
||||||
|
|
||||||
type
|
type
|
||||||
// this object is used only for precomile directives handling
|
// this object is used only for precomile directives handling
|
||||||
|
Reference in New Issue
Block a user