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

objective-c, type parsing improved, expressions parsing improved, bad pascal generated code bug fixed

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@407 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2008-04-07 14:06:35 +00:00
parent 6c6bdbe86a
commit 3dd7651b27
4 changed files with 1185 additions and 247 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

File diff suppressed because it is too large Load Diff

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

@ -1,23 +1,59 @@
{
ObjCParserUtils.pas
Copyright (C) 2008 Dmitry 'Skalogryz' Boyarintsev
converting obj-c to objfpc unit
converting obj-c header to pascal (delphi compatible) unit
}
//todo: a lot of things =)
unit ObjCParserUtils;
interface
{$ifdef fpc}{$mode delphi}{$H+}{$endif fpc}
{$ifdef fpc}{$mode delphi}{$H+}{$endif}
uses
Classes, SysUtils, ObjCParserTypes;
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
constructor Create;
destructor Destroy; override;
end;
var
ConvertSettings : TConvertSettings;
procedure WriteOutIncludeFile(hdr: TObjCHeader; st: TStrings);
procedure WriteOutMainFramework(hdr: TObjCHeader; st: TStrings);
function ObjCToDelphiType(const objcType: AnsiString; isPointer: Boolean): AnsiString;
@ -66,9 +102,6 @@ begin
'w': Result := (ls = 'while') or (ls = 'with');
'x': Result := (ls = 'xor');
end;
end;
function GetMethodResultType(const m: TClassMethodDef): AnsiString;
@ -137,6 +170,7 @@ end;
function ObjCToDelphiType(const objcType: AnsiString; isPointer: Boolean): AnsiString;
var
l : AnsiString;
r : AnsiString;
begin
Result := objcType;
l := AnsiLowerCase(objcType);
@ -164,6 +198,11 @@ begin
'f':
if l = 'float' then Result := 'Single';
end;
if Result = objcType then begin
r := ConvertSettings.TypeDefReplace[objcType];
if r <> '' then Result := r;
end;
end;
@ -252,13 +291,27 @@ end;
// 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
function PrecompileIfDefToPascal(const prm: AnsiString): AnsiString;
function PrecompileIfDefToPascal(const prm: AnsiString; var isDef: Boolean): AnsiString;
var
i : Integer;
const
VerExclude = 'MAC_OS_X_VERSION_MAX_ALLOWED >=';
vs : AnsiString;
begin
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);
// really slow... and... don't like this anyway!
vs := ConvertSettings.DefineReplace[vs];
if vs <> ''
then Result := vs
else Result := prm;
{ for i := 0 to ConvertSettings.DefineReplace.C
Result := prm;
i := Pos(VerExclude, prm);
if i > 0 then begin
@ -266,7 +319,7 @@ begin
while (i <= length(Result)) and (Result[i] = ' ') do inc(i);
if i <= length(Result) then
Result := Copy(prm, i, length(Result) - i + 1);
end;
end;}
end;
// converts TProcpmiler entity to pascal entity
@ -277,13 +330,22 @@ end;
function WriteOutPrecompToPascal(Prec: TPrecompiler): AnsiString;
var
dir : AnsiString;
prm : AnsiString;
isdef : Boolean;
const
isdefConst : array [Boolean] of AnsiString = ('ifndef', 'ifdef');
begin
dir := AnsiLowerCase(Prec._Directive);
if (dir = '#import') or (dir = '#include') then
Result := Format('{$include %s}', [GetIncludeFile(Prec._Params)])
else if (dir = '#if') then
Result := Format('{$ifdef %s}', [PrecompileIfDefToPascal(Prec._Params)])
else if (dir = '#else') then
if (dir = '#import') or (dir = '#include') then begin
prm := GetIncludeFile(Prec._Params);
if (prm <> ' .inc') and (ConvertSettings.IgnoreIncludes.IndexOf(prm) < 0) then
Result := Format('{$include %s}', [prm]);
end else if (dir = '#if') then begin
prm := PrecompileIfDefToPascal(Prec._Params, isdef);
Result := Format('{$%s %s}', [isdefConst[isdef], prm]);
end else if (dir = '#else') then
Result := '{$else}'
else if (dir = '#endif') then
Result := '{$endif}';
@ -385,7 +447,7 @@ var
begin
ppas := WriteOutPrecompToPascal(prec);
isend := IsSubStr('{$endif', ppas, 1);
if isend or IsSubStr('{$ifdef', ppas, 1) or IsSubStr('{$else', ppas, 1) then
if isend or IsSubStr('{$ifndef', ppas, 1) or IsSubStr('{$ifdef', ppas, 1) or IsSubStr('{$else', ppas, 1) then
subs.Add(Prefix + ppas);
if isend then ClearEmptyPrecompile(subs);
end;
@ -399,20 +461,20 @@ var
mtd : TClassMethodDef;
obj : TObject;
begin
if conststr.IndexOf(cl._ClassName) < 0 then begin
conststr.Add(cl._ClassName);
s := Format(' Str_%s = '#39'%s'#39';', [cl._ClassName, cl._ClassName]);
// if conststr.IndexOf(cl._ClassName) < 0 then begin
// conststr.Add(cl._ClassName);
s := Format(' Str%s_%s = '#39'%s'#39';', [cl._ClassName, cl._ClassName, cl._ClassName]);
subs.Add(s);
end;
// end;
for i := 0 to cl.Items.Count - 1 do begin
obj := TObject(cl.Items[i]);
if obj is TClassMethodDef then begin
mtd := TClassMethodDef(cl.Items[i]);
if conststr.IndexOf(mtd._Name) < 0 then begin
conststr.Add(mtd._Name);
ss := Format(' Str_%s = '#39'%s'#39';', [mtd._Name, mtd._Name]);
// if conststr.IndexOf(mtd._Name) < 0 then begin
// conststr.Add(mtd._Name);
ss := Format(' Str%s_%s = '#39'%s'#39';', [cl._ClassName, mtd._Name, mtd._Name]);
subs.add(ss);
end;
// end;
end else if obj is TPrecompiler then begin
WriteOutIfDefPrecompiler(TPrecompiler(obj), ' ', subs);
end;
@ -451,7 +513,8 @@ var
dlph : AnsiString;
begin
dlph := WriteOutPrecompToPascal(Prec);
if IsSubStr('{$include', dlph, 1) then st.Add(dlph);
if IsSubStr('{$include', dlph, 1) then
st.Add(dlph);
end;
function GetPascalEnumValue(const Name, Param: AnsiString): AnsiString;
@ -481,6 +544,10 @@ begin
//todo: improve! check at h2pas
Result := ReplaceStr('<<', 'shl', vl);
Result := ReplaceStr('>>', 'shr', Result);
Result := ReplaceStr('||', 'or', Result);
Result := ReplaceStr('|', 'or', Result);
Result := ReplaceStr('&&', 'and', Result);
Result := ReplaceStr('&', 'and', Result);
end;
procedure WriteOutEnumValues(enm: TEnumTypeDef; const Prefix: AnsiString; st: TStrings);
@ -559,20 +626,70 @@ end;
procedure WriteOutEnumToHeader(enm: TEnumTypeDef; st: TStrings);
var
// i : Integer;
s : AnsiString;
i : Integer;
// ent : TEnumValue;
obj : TObject;
pre : TEnumValue;
vl : TEnumValue;
vls : AnsiString;
vli : Integer;
begin
if enm._Name = '' then s := EvaluateEnumName(enm)
else s := enm._Name;
st.Add(Format(' %s = (', [s] ));
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;
end;
procedure WriteOutTypeDefToHeader(typedef: TTypeNameDef; const Prefix: AnsiString; subs: TStrings);
var
vs : AnsiString;
tmp : AnsiString;
begin
subs.Add( Prefix + Format('%s = %s;', [typedef._TypeName, typedef._Inherited]));
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');
subs.Add(Prefix + Format('%s = %s;', [typedef._TypeName, vs]))
end else begin
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;
end;
end;
subs.Add('');
end;
procedure WriteOutHeaderSection(hdr: TObjCHeader; st: TStrings);
@ -593,10 +710,12 @@ begin
try
for i := 0 to hdr.Items.Count - 1 do
if Assigned(hdr.Items[i]) then begin
if (TObject(hdr.Items[i]) is TClassDef) then begin
cl := TClassDef(hdr.Items[i]);
WriteOutClassToHeader(cl, subs, consts);
end else if (TObject(hdr.Items[i]) is TPrecompiler) then begin
WriteOutIfDefPrecompiler(TPrecompiler(hdr.Items[i]), SpacePrefix, st);
WriteOutPrecompInclude(TPrecompiler(hdr.Items[i]), st);
WriteOutPrecompDefine(TPrecompiler(hdr.Items[i]), ' ', subs);
end;
@ -617,11 +736,12 @@ begin
WriteOutIfDefPrecompiler(TPrecompiler(hdr.Items[i]), SpacePrefix, st);
end else if (TObject(hdr.Items[i]) is TTypeNameDef) then begin
WriteOutTypeDefToHeader(TTypeNameDef(hdr.Items[i]), SpacePrefix, subs);
end;
end else if (TObject(hdr.Items[i]) is TSkip) then
subs.Add('//'+ TSkip(hdr.Items[i])._Skip);
end; {of if}
if subs.Count > 0 then begin
st.Add('type');
//if subs[0] <> 'const' then st.Add('type');
st.AddStrings(subs);
subs.Clear;
end;
@ -701,7 +821,9 @@ var
subs : TStringList;
begin
BeginSection('CLASSES', st);
BeginSection(GetIfDefFileName(hdr._FileName, 'C'), st);
//BeginSection(GetIfDefFileName(hdr._FileName, 'C'), st);
BeginExcludeSection( GetIfDefFileName(hdr._FileName, 'C'), st);
subs := TStringList.Create;
try
for i := 0 to hdr.Items.Count - 1 do
@ -709,10 +831,14 @@ begin
WriteOutPrecompInclude(TPrecompiler(hdr.Items[i]), st);
for i := 0 to hdr.Items.Count - 1 do
if Assigned(hdr.Items[i]) and (TObject(hdr.Items[i]) is TClassDef) then begin
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;
end;
if subs.Count > 0 then begin
st.Add('type');
@ -720,6 +846,7 @@ begin
end;
finally
EndSection(st);
EndSection(st);
subs.Free;
end;
@ -745,12 +872,16 @@ procedure ObjCMethodToProcType(mtd: TClassMethodDef; var typeName: AnsiString; s
var
// i : integer;
s : AnsiString;
ms : AnsiString;
begin
typeName := MtdPrefix + mtd._Name + MtdPostFix;
subs.Add('type');
// function GetProcFuncHead(const FuncName, OfClass, Params, ResType, FuncDest: AnsiString): AnsiString;
s := typeName + ' = ' + GetProcFuncHead('', '', 'param1: objc.id; param2: SEL; ' + GetMethodParams(mtd), GetMethodResultType(mtd), '' );
subs.Add(' ' + s + ' cdecl;');
ms := GetMethodParams(mtd);
if ms = '' then ms := 'param1: objc.id; param2: SEL'
else ms := 'param1: objc.id; param2: SEL' + ';' + ms;
s := Format(' %s = %s cdecl;',[typeName, GetProcFuncHead('', '', ms, GetMethodResultType(mtd), '' )]);
subs.Add(s);
end;
function GetParamsNames(mtd: TClassMethodDef): AnsiString;
@ -774,52 +905,93 @@ begin
// Result := Copy(Result, 1, length(Result) - 2);
end;
// 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
procedure WriteOutConstructorMethod(mtd: TClassMethodDef; subs: TStrings);
var
typeName : AnsiString;
cl : TClassDef;
begin
cl := TClassDef(mtd.Owner);
ObjCMethodToProcType(mtd, typeName, subs);
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(
Format(' Handle := vmethod(allocbuf, sel_registerName(PChar(Str%s_%s)), %s);', [cl._ClassName, mtd._Name, GetParamsNames(mtd)]));
subs.Add('end;');
end;
// writes out a method to implementation section
procedure WriteOutMethod(mtd: TClassMethodDef; subs: TStrings);
var
s : AnsiString;
typeName : AnsiString;
cl : TClassDef;
begin
cl := TClassDef(mtd.Owner);
s := Format('vmethod(Handle, sel_registerName(PChar(Str%s_%s)), %s)', [cl._ClassName, mtd._Name, GetParamsNames(mtd)]);
if ObjCToDelphiType(mtd.GetResultType._Name, mtd.GetResultType._IsPointer) <> '' then
s := 'Result := ' + s;
ObjCMethodToProcType(mtd, typeName, subs);
subs.Add('var');
subs.Add(
Format(' vmethod: %s;', [typeName]));
subs.Add('begin');
subs.Add(
Format(' vmethod := %s(@objc_msgSend);', [typeName]));
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
s : AnsiString;
res : AnsiString;
cl : TClassDef;
begin
cl := TClassDef(mtd.owner);
s := Format('objc_msgSend(Handle, sel_registerName(PChar(Str%s_%s)), [])', [cl._ClassName, mtd._Name]);
res := GetMethodResultType(mtd);
if res <> '' then begin
if res = 'objc.id' then s := 'Result := ' +s
else s := 'Result := '+res+'('+s+')'
end;
subs.Add('begin');
subs.Add(Format(' %s;', [s]));
subs.Add('end;');
end;
procedure WriteOutMethodToImplementation(mtd: TClassMethodDef; subs: TStrings);
var
cl : TClassDef;
res : Ansistring;
sp : AnsiString;
s : AnsiString;
// isConsts : Boolean;
typeName : AnsiString;
begin
typeName := '';
if not Assigned(mtd.Owner) or (not (TObject(mtd.Owner) is TClassDef)) then Exit; // method cannot be without owning class
cl := TClassDef(mtd.Owner);
subs.Add(GetMethodStr(cl, mtd, true));
if IsMethodConstructor(cl, mtd) then begin
subs.Add('begin');
subs.Add(' //todo: constructors are not implemented, yet');
subs.Add('end;');
end else if not isAnyParam(mtd) then begin
subs.Add('begin');
try
sp := Format('objc_msgSend(Handle, sel_registerName(PChar(Str_%s)), [])', [mtd._Name]);
res := GetMethodResultType(mtd);
if res <> '' then begin
if res = 'objc.id' then sp := 'Result := ' +sp
else sp := 'Result := '+res+'('+sp+')'
end;
subs.Add(' ' + sp+';');
finally
subs.Add('end;');
end;
end else begin
ObjCMethodToProcType(mtd, typeName, subs);
subs.Add('var');
subs.Add(Format(' vmethod: %s;', [typeName]));
subs.Add('begin');
subs.Add(Format(' vmethod := %s(@objc_msgSend);', [typeName]));
s := Format('vmethod(Handle, sel_registerName(PChar(Str_%s)), %s)', [mtd._Name, GetParamsNames(mtd)]);
if ObjCToDelphiType(mtd.GetResultType._Name, mtd.GetResultType._IsPointer) <> '' then
s := 'Result := ' + s;
s := s + ';';
subs.Add(' ' + s);
subs.Add('end;');
end;
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);
subs.Add('');
end;
@ -839,8 +1011,9 @@ begin
subs.Add('');
subs.Add(GetProcFuncHead('getClass', cl._ClassName, '', 'objc.id'));
subs.Add('begin');
subs.Add(' Result := objc_getClass(Str_'+cl._ClassName+');');
subs.Add('end');
subs.Add(
Format(' Result := objc_getClass(Str%s_%s);', [cl._ClassName, cl._ClassName]));
subs.Add('end;');
subs.Add('');
for i := 0 to cl.Items.Count - 1 do begin
@ -888,10 +1061,13 @@ begin
end else
Exit;
if typedef._Inherited = AppleInherit then enumdef._Name := typedef._TypeName;
if typedef._Inherited = AppleInherit then begin
enumdef._Name := typedef._TypeName;
Result := true;
end;
end;
procedure FixAppleCategories(Items: TList; category: TClassDef);
@ -972,4 +1148,243 @@ begin
end;
end;
procedure WriteOutMainFramework(hdr: TObjCHeader; st: TStrings);
//var
// i : integer;
// nm : AnsiString;
begin
end;
{ TConvertSettings }
constructor TConvertSettings.Create;
begin
IgnoreIncludes := TStringList.Create;
IgnoreIncludes.CaseSensitive := false;
DefineReplace := TReplaceList.Create;
TypeDefReplace := TReplaceList.Create; // replaces for default types
end;
destructor TConvertSettings.Destroy;
begin
IgnoreIncludes.Free;
TypeDefReplace.Free;
DefineReplace.Free;
inherited Destroy;
end;
procedure InitConvertSettings;
begin
with ConvertSettings.IgnoreIncludes do begin
// must not be $included, because they are used
Add('NSObjCRuntime.inc');
Add('NSObject.inc');
Add('Foundation.inc');
Add('NSZone.inc');
Add('NSAppleEventDescriptor.inc');
Add('NSAppleEventManager.inc');
Add('NSAppleScript.inc');
Add('NSArchiver.inc');
Add('NSArray.inc');
Add('NSAttributedString.inc');
Add('NSAutoreleasePool.inc');
Add('NSBundle.inc');
Add('NSByteOrder.inc');
Add('NSCalendar.inc');
Add('NSCalendarDate.inc');
Add('NSCharacterSet.inc');
Add('NSClassDescription.inc');
Add('NSCoder.inc');
Add('NSComparisonPredicate.inc');
Add('NSCompoundPredicate.inc');
Add('NSConnection.inc');
Add('NSData.inc');
Add('NSDate.inc');
Add('NSDateFormatter.inc');
Add('NSDebug.inc');
Add('NSDecimal.inc');
Add('NSDecimalNumber.inc');
Add('NSDictionary.inc');
Add('NSDistantObject.inc');
Add('NSDistributedLock.inc');
Add('NSDistributedNotificationCenter.inc');
Add('NSEnumerator.inc');
Add('NSError.inc');
Add('NSException.inc');
Add('NSExpression.inc');
Add('NSFileHandle.inc');
Add('NSFileManager.inc');
Add('NSFormatter.hinc');
Add('NSGarbageCollector.inc');
Add('NSGeometry.inc');
Add('NSHashTable.inc');
Add('NSHFSFileTypes.inc');
Add('NSHost.inc');
Add('NSHTTPCookie.inc');
Add('NSHTTPCookieStorage.inc');
Add('NSIndexPath.inc');
Add('NSIndexSet.inc');
Add('NSInvocation.inc');
Add('NSJavaSetup.inc');
Add('NSKeyedArchiver.inc');
Add('NSKeyValueCoding.inc');
Add('NSKeyValueObserving.inc');
Add('NSLocale.inc');
Add('NSLock.inc');
Add('NSMapTable.inc');
Add('NSMetadata.inc');
Add('NSMethodSignature.inc');
Add('NSNetServices.inc');
Add('NSNotification.inc');
Add('NSNotificationQueue.inc');
Add('NSNull.inc');
Add('NSNumberFormatter.inc');
Add('NSObjectScripting.inc');
Add('NSOperation.inc');
Add('NSPathUtilities.inc');
Add('NSPointerArray.inc');
Add('NSPointerFunctions.inc');
Add('NSPort.inc');
Add('NSPortCoder.inc');
Add('NSPortMessage.inc');
Add('NSPortNameServer.inc');
Add('NSPredicate.inc');
Add('NSProcessInfo.inc');
Add('NSPropertyList.inc');
Add('NSProtocolChecker.inc');
Add('NSProxy.inc');
Add('NSRange.inc');
Add('NSRunLoop.inc');
Add('NSScanner.inc');
Add('NSScriptClassDescription.inc');
Add('NSScriptCoercionHandler.inc');
Add('NSScriptCommand.inc');
Add('NSScriptCommandDescription.inc');
Add('NSScriptExecutionContext.inc');
Add('NSScriptKeyValueCoding.inc');
Add('NSScriptObjectSpecifiers.inc');
Add('NSScriptStandardSuiteCommands.inc');
Add('NSScriptSuiteRegistry.inc');
Add('NSScriptWhoseTests.inc');
Add('NSSet.inc');
Add('NSSortDescriptor.inc');
Add('NSSpellServer.inc');
Add('NSStream.inc');
Add('NSString.inc');
Add('NSTask.inc');
Add('NSThread.inc');
Add('NSTimer.inc');
Add('NSTimeZone.inc');
Add('NSUndoManager.inc');
Add('NSURL.inc');
Add('NSURLAuthenticationChallenge.inc');
Add('NSURLCache.inc');
Add('NSURLConnection.inc');
Add('NSURLCredential.inc');
Add('NSURLCredentialStorage.inc');
Add('NSURLDownload.inc');
Add('NSURLError.inc');
Add('NSURLHandle.inc');
Add('NSURLProtectionSpace.inc');
Add('NSURLProtocol.inc');
Add('NSURLRequest.inc');
Add('NSURLResponse.inc');
Add('NSUserDefaults.inc');
Add('NSValue.inc');
Add('NSValueTransformer.inc');
Add('NSXMLDocument.inc');
Add('NSXMLDTD.inc');
Add('NSXMLDTDNode.inc');
Add('NSXMLElement.inc');
Add('NSXMLNode.inc');
Add('NSXMLNodeOptions.inc');
Add('NSXMLParser.inc');
// temporary
Add('ApplicationServices.inc');
Add('IOLLEvent.inc');
Add('Limits.inc');
Add('AvailabilityMacros.inc');
Add('CCImage.inc');
Add('NSStringEncoding.inc');
Add('NSGlyph.inc');
Add('CFDate.inc');
Add('CFRunLoop.inc');
Add('gl.inc');
Add('UTF32Char.inc');
Add('CoreFoundation.inc');
Add('NSFetchRequest.inc');
Add('NSAttributeDescription.inc');
end;
with ConvertSettings do begin
DefineReplace['MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_2'] := 'MAC_OS_X_VERSION_10_2';
DefineReplace['MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_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';
DefineReplace['__LP64__'] := 'LP64';
TypeDefReplace['uint32_t'] := 'LongWord';
TypeDefReplace['uint8_t'] := 'byte';
TypeDefReplace['NSUInteger'] := 'LongWord';
end;
//????
// Values['MAC_OS_X_VERSION_MAX_ALLOWED <= MAC_OS_X_VERSION_10_2'] := 'MAC_OS_X_VERSION_10_2';
// Values['MAC_OS_X_VERSION_MAX_ALLOWED <= MAC_OS_X_VERSION_10_3'] := 'MAC_OS_X_VERSION_10_3';
// Values['MAC_OS_X_VERSION_MAX_ALLOWED <= MAC_OS_X_VERSION_10_4'] := 'MAC_OS_X_VERSION_10_4';
// Values['MAC_OS_X_VERSION_MAX_ALLOWED <= MAC_OS_X_VERSION_10_5'] := 'MAC_OS_X_VERSION_10_5';
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;
initialization
ConvertSettings := TConvertSettings.Create;
InitConvertSettings;
finalization
ConvertSettings.Free;
end.

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

@ -9,11 +9,11 @@
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<UseAppBundle Value="False"/>
<ActiveEditorIndexAtStart Value="3"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
@ -30,22 +30,248 @@
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<Units Count="3">
<Units Count="31">
<Unit0>
<Filename Value="objcparser.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Project1"/>
<CursorPos X="18" Y="20"/>
<TopLine Value="1"/>
<EditorIndex Value="0"/>
<UsageCount Value="69"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="ObjCParserUtils.pas"/>
<UnitName Value="ObjCParserUtils"/>
<CursorPos X="1" Y="10"/>
<TopLine Value="1"/>
<EditorIndex Value="4"/>
<UsageCount Value="33"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="ObjCParserTypes.pas"/>
<UnitName Value="ObjCParserTypes"/>
<CursorPos X="1" Y="266"/>
<TopLine Value="253"/>
<EditorIndex Value="3"/>
<UsageCount Value="33"/>
<Bookmarks Count="1">
<Item0 X="1" Y="589" ID="0"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="../foundation/foundation.pas"/>
<UnitName Value="foundation"/>
<CursorPos X="28" Y="10"/>
<TopLine Value="1"/>
<UsageCount Value="8"/>
</Unit3>
<Unit4>
<Filename Value="../appkit/AppKit.inc"/>
<CursorPos X="18" Y="156"/>
<TopLine Value="156"/>
<UsageCount Value="11"/>
</Unit4>
<Unit5>
<Filename Value="../../objc/objc.pas"/>
<UnitName Value="objc"/>
<CursorPos X="32" Y="38"/>
<TopLine Value="36"/>
<UsageCount Value="12"/>
</Unit5>
<Unit6>
<Filename Value="../../objc/objc-api.inc"/>
<CursorPos X="106" Y="9"/>
<TopLine Value="8"/>
<UsageCount Value="8"/>
</Unit6>
<Unit7>
<Filename Value="../appkit/NSActionCell.inc"/>
<CursorPos X="49" Y="34"/>
<TopLine Value="13"/>
<UsageCount Value="8"/>
</Unit7>
<Unit8>
<Filename Value="../appkit/NSCell.inc"/>
<CursorPos X="1" Y="48"/>
<TopLine Value="42"/>
<UsageCount Value="8"/>
</Unit8>
<Unit9>
<Filename Value="../foundation/NSGeometry.inc"/>
<CursorPos X="1" Y="46"/>
<TopLine Value="26"/>
<UsageCount Value="10"/>
</Unit9>
<Unit10>
<Filename Value="../foundation/NSObject.inc"/>
<CursorPos X="37" Y="302"/>
<TopLine Value="302"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit10>
<Unit11>
<Filename Value="pascodeutils.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="pascodeutils"/>
</Unit1>
<Unit2>
<CursorPos X="1" Y="13"/>
<TopLine Value="1"/>
<UsageCount Value="66"/>
</Unit11>
<Unit12>
<Filename Value="../appkit/NSWindow.inc"/>
<CursorPos X="37" Y="302"/>
<TopLine Value="302"/>
<UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit12>
<Unit13>
<Filename Value="test.inc"/>
<CursorPos X="9" Y="18"/>
<TopLine Value="1"/>
<UsageCount Value="9"/>
</Unit13>
<Unit14>
<Filename Value="NSWindow.h"/>
<CursorPos X="35" Y="194"/>
<TopLine Value="172"/>
<UsageCount Value="24"/>
<SyntaxHighlighter Value="C++"/>
</Unit14>
<Unit15>
<Filename Value="../../objc/objc-runtime.inc"/>
<CursorPos X="1" Y="127"/>
<TopLine Value="127"/>
<UsageCount Value="12"/>
</Unit15>
<Unit16>
<Filename Value="headers/NSScreen.h"/>
<CursorPos X="1" Y="9"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
<SyntaxHighlighter Value="C++"/>
</Unit16>
<Unit17>
<Filename Value="../foundation/NSAutoreleasePool.inc"/>
<CursorPos X="16" Y="12"/>
<TopLine Value="12"/>
<UsageCount Value="9"/>
</Unit17>
<Unit18>
<Filename Value="../appkit/NSButton.inc"/>
<CursorPos X="23" Y="15"/>
<TopLine Value="12"/>
<UsageCount Value="9"/>
</Unit18>
<Unit19>
<Filename Value="../appkit/NSControl.inc"/>
<CursorPos X="21" Y="151"/>
<TopLine Value="139"/>
<UsageCount Value="13"/>
</Unit19>
<Unit20>
<Filename Value="headers/NSButton.h"/>
<CursorPos X="1" Y="23"/>
<TopLine Value="4"/>
<UsageCount Value="9"/>
<SyntaxHighlighter Value="C++"/>
</Unit20>
<Unit21>
<Filename Value="NSWindow.inc"/>
<CursorPos X="51" Y="447"/>
<TopLine Value="442"/>
<UsageCount Value="19"/>
</Unit21>
<Unit22>
<Filename Value="NSWindow2.h"/>
<IsPartOfProject Value="True"/>
</Unit2>
<CursorPos X="44" Y="16"/>
<TopLine Value="11"/>
<UsageCount Value="47"/>
<SyntaxHighlighter Value="C++"/>
</Unit22>
<Unit23>
<Filename Value="../uikit/UIKit.h"/>
<CursorPos X="1" Y="31"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
<SyntaxHighlighter Value="C++"/>
</Unit23>
<Unit24>
<Filename Value="../appkit/NSAlert.inc"/>
<CursorPos X="1" Y="61"/>
<TopLine Value="38"/>
<UsageCount Value="10"/>
</Unit24>
<Unit25>
<Filename Value="../appkit/NSPanel.inc"/>
<CursorPos X="1" Y="34"/>
<TopLine Value="11"/>
<UsageCount Value="10"/>
</Unit25>
<Unit26>
<Filename Value="../appkit/NSView.inc"/>
<CursorPos X="5" Y="136"/>
<TopLine Value="121"/>
<UsageCount Value="13"/>
</Unit26>
<Unit27>
<Filename Value="headersMacOS/NSWindow.inc"/>
<CursorPos X="37" Y="302"/>
<TopLine Value="302"/>
<UsageCount Value="12"/>
</Unit27>
<Unit28>
<Filename Value="../appkit/appkit.pas"/>
<UnitName Value="appkit"/>
<CursorPos X="1" Y="7"/>
<TopLine Value="1"/>
<UsageCount Value="11"/>
</Unit28>
<Unit29>
<Filename Value="NSFontPanelUnit.pas"/>
<UnitName Value="NSFontPanelUnit"/>
<CursorPos X="25" Y="93"/>
<TopLine Value="79"/>
<EditorIndex Value="1"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit29>
<Unit30>
<Filename Value="objc.pas"/>
<UnitName Value="objc"/>
<CursorPos X="10" Y="19"/>
<TopLine Value="5"/>
<EditorIndex Value="2"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit30>
</Units>
<JumpHistory Count="5" HistoryIndex="4">
<Position1>
<Filename Value="NSFontPanelUnit.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position1>
<Position2>
<Filename Value="NSFontPanelUnit.pas"/>
<Caret Line="92" Column="75" TopLine="79"/>
</Position2>
<Position3>
<Filename Value="NSFontPanelUnit.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position3>
<Position4>
<Filename Value="NSFontPanelUnit.pas"/>
<Caret Line="93" Column="25" TopLine="79"/>
</Position4>
<Position5>
<Filename Value="objcparser.pas"/>
<Caret Line="199" Column="34" TopLine="193"/>
</Position5>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
@ -59,4 +285,16 @@
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="2">
<Item1>
<Source Value="C:/Games/CodeTest2/Sources/examples/codecompletion.lpr"/>
<Line Value="47"/>
</Item1>
<Item2>
<Source Value="../../LazTest4/consolethreads.pas"/>
<Line Value="18"/>
</Item2>
</BreakPoints>
</Debugging>
</CONFIG>

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

@ -14,13 +14,15 @@ program Project1;
{$endif}
uses
Classes, SysUtils, ObjCParserUtils, ObjCParserTypes;
Classes,
SysUtils,
ObjCParserUtils,
ObjCParserTypes;
type
// this object is used only for precomile directives handling
{ TPrecompileHandler }
TPrecompileHandler = class(TObject)
public
hdr : TObjCHeader;
@ -83,15 +85,19 @@ begin
hdr := AHeader;
end;
procedure ReadAndParseFile(const FileName: AnsiString; outdata: TStrings);
function ReadAndParseFile(const FileName: AnsiString; outdata: TStrings; var Err: AnsiString): Boolean;
var
hdr : TObjCHeader;
parser : TTextParser;
prec : TPrecompileHandler ;
s : AnsiString;
i, cnt : integer;
begin
if not FileExists(FileName) then
Result :=false;
if not FileExists(FileName) then begin
Err := 'File not found: ' + FileName;
Exit;
end;
s := StrFromFile(FileName);
hdr := TObjCHeader.Create;
@ -106,7 +112,21 @@ begin
parser.OnPrecompile := prec.OnPrecompile;
parser.OnComment := prec.OnComment;
hdr._FileName := ExtractFileName(FileName);
hdr.Parse(parser);
Result := hdr.Parse(parser);
if not Result then begin
if parser.Errors.Count > 0 then Err := parser.Errors[0]
else Err := 'undesribed error';
Err := Err + #13#10;
cnt := 120;
i := parser.Index - cnt;
if i <= 0 then begin
i := 1;
cnt := parser.Index;
end;
Err := Err + Copy(parser.Buf, i, cnt);
end;
except
end;
WriteOutIncludeFile(hdr, outdata);
@ -128,8 +148,11 @@ var
incs : AnsiString;
st : TStringList;
f : Text;
err : AnsiString;
begin
writeln('would you like to parse of local files .h to inc?');
writeln('would you like to parse all current directory files .h to inc?');
readln(ch);
if (ch <> 'Y') and (ch <> 'y') then begin
writeln('as you wish, bye!');
@ -146,7 +169,7 @@ begin
write('found: ', srch.Name);
write(' parsing...');
//writeln('parsing: ', pth+srch.Name);
ReadAndParseFile(pth+srch.Name, st);
if ReadAndParseFile(pth+srch.Name, st, err) then begin
write(' parsed ');
incs := pth + Copy(srch.Name,1, length(srch.Name) - length(ExtractFileExt(srch.Name)));
incs := incs + '.inc';
@ -160,6 +183,9 @@ begin
end;
st.Clear;
writeln(' converted!');
end else begin
writeln('Error: ', err);
end;
until FindNext(srch) <> 0;
finally
@ -167,8 +193,6 @@ begin
st.Free;
end;
end;
end;
@ -176,6 +200,7 @@ var
inpf : AnsiString;
st : TStrings;
i : integer;
err : AnsiString;
begin
try
inpf := ParamStr(1);
@ -186,7 +211,9 @@ begin
st := TStringList.Create;
try
ReadAndParseFile(inpf, st);
if not ReadAndParseFile(inpf, st, err) then
writeln('Error: ', err)
else
for i := 0 to st.Count - 1 do
writeln(st[i]);
except