From f6f101c184cdbdf3ae9798d2cc737206cbbd4a8c Mon Sep 17 00:00:00 2001 From: skalogryz Date: Thu, 17 Apr 2008 13:58:59 +0000 Subject: [PATCH] * calling objc methods are fixed, overload method name fixed git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@426 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- bindings/pascocoa/parser/ObjCParserTypes.pas | 2 +- bindings/pascocoa/parser/ObjCParserUtils.pas | 200 +++++++++++++++---- bindings/pascocoa/parser/objcparser.lpi | 115 ++++++++++- bindings/pascocoa/parser/objcparser.pas | 11 +- 4 files changed, 270 insertions(+), 58 deletions(-) diff --git a/bindings/pascocoa/parser/ObjCParserTypes.pas b/bindings/pascocoa/parser/ObjCParserTypes.pas index 612011e92..196ee61ef 100755 --- a/bindings/pascocoa/parser/ObjCParserTypes.pas +++ b/bindings/pascocoa/parser/ObjCParserTypes.pas @@ -1502,7 +1502,7 @@ begin AParser.FindNextToken(s, tt); end; {of while} - if ((_Spec * [td_Int, td_Short, td_Char, td_Long]) = []) then begin + if ((_Spec * [td_Unsigned, td_Int, td_Short, td_Char, td_Long]) = []) then begin // if int, short long or char is not specified // volatile or const are Result := tt = tt_Ident; diff --git a/bindings/pascocoa/parser/ObjCParserUtils.pas b/bindings/pascocoa/parser/ObjCParserUtils.pas index 263d617c0..ceb2a7721 100755 --- a/bindings/pascocoa/parser/ObjCParserUtils.pas +++ b/bindings/pascocoa/parser/ObjCParserUtils.pas @@ -148,7 +148,9 @@ begin if vname = '' then vname := TObjCParameterDef(p)._Name; vtype := ObjCToDelphiType(TObjCParameterDef(p)._Res._Name, TObjCParameterDef(p)._Res._IsPointer); if Result <> '' then Result := Result + '; '; - Result := Result + vname + ': ' + vtype; + + if Copy(vtype, 1, 5) = 'array' then Result := Result + 'const A'+vname + ': ' + vtype + else Result := Result + 'A'+vname + ': ' + vtype; vname := ''; end; end; @@ -245,9 +247,24 @@ begin Result := (l = 'id') or (l = cl._ClassName); 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 + Result := Result + TParamDescr(obj)._Descr + end; +end; + function GetMethodStr(cl: TClassDef; m: TClassMethodDef; ForImplementation: Boolean): AnsiString; var // i : integer; + nm : AnsiString; ft : AnsiString; res : AnsiString; begin @@ -258,9 +275,10 @@ begin end else ft := ''; + nm := m._Name; if ForImplementation - then Result := GetProcFuncHead(m._Name, cl._ClassName, GetMethodParams(m), res, ft) - else Result := GetProcFuncHead(m._Name, '', GetMethodParams(m), res, ft) + then Result := GetProcFuncHead(nm, cl._ClassName, GetMethodParams(m), res, ft) + else Result := GetProcFuncHead(nm, '', GetMethodParams(m), res, ft) end; // returns define pas file name form Objective C name, like @@ -508,6 +526,24 @@ begin Result := Format('Str%s_%s', [ClassName, ConstName]); end; + +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; + + procedure WriteOutClassToHeader(cl : TClassDef; subs: TStrings; conststr: TStrings); var i : Integer; @@ -517,6 +553,7 @@ var mtd : TClassMethodDef; obj : TObject; cs : AnsiString; + nm : AnsiString; begin cs := GetClassConst(cl._ClassName, cl._ClassName); if conststr.IndexOf(cs) < 0 then begin @@ -530,12 +567,15 @@ begin if obj is TClassMethodDef then begin mtd := TClassMethodDef(cl.Items[i]); - cs := GetClassConst(cl._ClassName, mtd._Name); + nm := GetMethodPascalName(mtd); + cs := GetClassConst(cl._ClassName, nm); if conststr.IndexOf(cs) < 0 then begin conststr.Add(cs); - ss := Format(' %s = ''%s'';', [cs, mtd._Name]); + ss := Format(' %s = ''%s'';', [cs, GetMethodConstName(mtd)]); subs.add(ss); end; + mtd._Name := nm; + end else if obj is TPrecompiler then begin WriteOutIfDefPrecompiler(TPrecompiler(obj), ' ', subs); end; @@ -601,14 +641,17 @@ begin end; function GetPascalConstValue(const Vl: AnsiString): AnsiString; +var + ws : AnsiString; begin + Result := Vl; //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); + repeat ws := Result; Result := ReplaceStr('<<', 'shl', ws); until Result = ws; + repeat ws := Result; Result := ReplaceStr('>>', 'shr', ws); until Result = ws; + repeat ws := Result; Result := ReplaceStr('||', 'or', ws); until Result = ws; + repeat ws := Result; Result := ReplaceStr('|', 'or', ws); until Result = ws; + repeat ws := Result; Result := ReplaceStr('&&', 'and', ws); until Result = ws; + repeat ws := Result; Result := ReplaceStr('&', 'and', ws); until Result = ws; end; procedure WriteOutEnumValues(enm: TEnumTypeDef; const Prefix: AnsiString; st: TStrings); @@ -903,6 +946,7 @@ var i : Integer; // cnt : Integer; s : AnsiString; + nm : AnsiString; j : Integer; obj : TObject; // or TEntity @@ -929,9 +973,10 @@ begin for j := 0 to cl.Items.Count - 1 do begin obj := TObject(cl.Items[j]); if obj is TClassMethodDef then begin - i := mtds.indexOf(TClassMethodDef(obj)._Name); + nm := TClassMethodDef(obj)._Name; + i := mtds.indexOf(nm); if i < 0 then - mtds.Add( TClassMethodDef(obj)._Name) + mtds.Add(nm) else mtds.Objects[i] := TObject(Integer(mtds.Objects[i]) + 1); end; @@ -942,7 +987,8 @@ begin if obj is TClassMethodDef then begin WriteOutIfComment(cl.Items, j - 1, ' ', subs); s := GetMethodStr(cl, TClassMethodDef(cl.Items[j]), false); - i := mtds.IndexOf(TClassMethodDef(cl.Items[j])._Name); + nm := TClassMethodDef(cl.Items[j])._Name; + i := mtds.IndexOf(nm); if Integer(mtds.Objects[i]) > 0 then s := s + ' overload;'; subs.Add(SpacePrefix + s); end else if obj is TPrecompiler then begin @@ -960,15 +1006,8 @@ end; procedure WriteOutClassesSection(hdr: TObjCHeader; st: TStrings); var i : integer; -// cl : TClassDef; -// j : integer; -// s : AnsiString; subs : TStringList; begin - BeginSection('CLASSES', 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 @@ -985,14 +1024,17 @@ begin end; end; - if subs.Count > 0 then begin - st.Add('type'); + if subs.Count = 0 then Exit; + BeginSection('CLASSES', st); + BeginExcludeSection( GetIfDefFileName(hdr._FileName, 'C'), st); + try st.AddStrings(subs); + finally + EndSection(st); + EndSection(st); end; finally - EndSection(st); - EndSection(st); subs.Free; end; end; @@ -1041,9 +1083,9 @@ begin obj := TObject(mtd.Items[i]); if obj is TParamDescr then begin if vName <> '' then Result := Result + vname + ', '; - vname := TParamDescr(obj)._Descr; + vname := 'A'+TParamDescr(obj)._Descr; end else if obj is TObjCParameterDef then begin - if vname = '' then vname := TObjCParameterDef(obj)._Name; + if vname = '' then vname := 'A'+TObjCParameterDef(obj)._Name; end; end; Result := Result + vname; @@ -1084,9 +1126,14 @@ var s : AnsiString; typeName : AnsiString; cl : TClassDef; + + callobj : AnsiString; begin cl := TClassDef(mtd.Owner); - s := Format('vmethod(Handle, sel_registerName(PChar(Str%s_%s)), %s)', [cl._ClassName, mtd._Name, GetParamsNames(mtd)]); + if mtd._IsClassMethod then callobj := 'ClassID' + else callobj := 'Handle'; + s := Format('vmethod(%s, sel_registerName(PChar(Str%s_%s)), %s)', [callobj, cl._ClassName, mtd._Name, GetParamsNames(mtd)]); + if ObjCToDelphiType(mtd.GetResultType._Name, mtd.GetResultType._IsPointer) <> '' then s := 'Result := ' + s; ObjCMethodToProcType(mtd, typeName, subs); @@ -1104,12 +1151,16 @@ 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; + s : AnsiString; + res : AnsiString; + cl : TClassDef; + callobj : AnsiString; begin cl := TClassDef(mtd.owner); - s := Format('objc_msgSend(Handle, sel_registerName(PChar(Str%s_%s)), [])', [cl._ClassName, mtd._Name]); + if mtd._IsClassMethod then callobj := 'ClassID' + else callobj := 'Handle'; + + s := Format('objc_msgSend(%s, sel_registerName(PChar(Str%s_%s)), [])', [callobj, cl._ClassName, mtd._Name ]); res := GetMethodResultType(mtd); if res <> '' then begin if res = 'objc.id' then s := 'Result := ' +s @@ -1173,16 +1224,26 @@ end; procedure WriteOutImplementationSection(hdr: TObjCHeader; st: TStrings); var i : Integer; + subs : TStringList; begin - BeginSection('IMPLEMENTATION', st); + subs := TStringList.Create; try for i := 0 to hdr.Items.Count - 1 do - if Assigned(hdr.Items[i]) then begin + if Assigned(hdr.Items[i]) then if (TObject(hdr.Items[i]) is TClassDef) then - WriteOutClassToImplementation(TClassDef(hdr.Items[i]), st); - end; + WriteOutClassToImplementation(TClassDef(hdr.Items[i]), subs); + + if subs.Count = 0 then Exit; + + BeginSection('IMPLEMENTATION', st); + try + st.AddStrings(subs); + finally + EndSection(st); + end; + finally - EndSection(st); + subs.Free; end; end; @@ -1216,8 +1277,6 @@ begin } end; - - procedure FixAppleCategories(Items: TList; category: TClassDef); var i : Integer; @@ -1235,6 +1294,11 @@ begin end; {of if} end; +procedure FixAppleClassDef(cl: TClassDef); +begin +//nothing todo... +end; + procedure AppleHeaderFix(ent : TEntity); var i : Integer; @@ -1263,6 +1327,7 @@ begin end; end; + // packing list, removing nil references. j := 0; for i := 0 to ent.Items.Count - 1 do if Assigned(ent.Items[i]) then begin @@ -1271,11 +1336,39 @@ begin end; ent.Items.Count := j; - for i := 0 to ent.Items.Count - 1 do + for i := 0 to ent.Items.Count - 1 do begin AppleHeaderFix( TEntity(ent.Items[i])); + if TEntity(ent.Items[i]) is TClassDef then + FixAppleClassDef( TClassDef(ent.Items[i])); + end; end; +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); + BeginExcludeSection( GetIfDefFileName(hdr._FileName, '_FORWARD'), st); + try + st.AddStrings(subs); + finally + EndSection(st); + EndSection(st); + end; + end; + finally + subs.Free; + end; +end; + procedure WriteOutIncludeFile(hdr: TObjCHeader; st: TStrings); var // i : integer; @@ -1296,6 +1389,7 @@ begin end; WriteOutHeaderSection(hdr, st); + WriteOutForwardSection(hdr, st); WriteOutClassesSection(hdr, st); WriteOutImplementationSection(hdr, st); except @@ -1351,17 +1445,37 @@ begin TypeDefReplace['uint32_t'] := 'LongWord'; TypeDefReplace['uint8_t'] := 'byte'; + TypeDefReplace['NSUInteger'] := 'LongWord'; TypeDefReplace['NSInteger'] := 'Integer'; - TypeDefReplace['long long'] := 'Int64'; + + TypeDefReplace['unsigned char'] := 'byte'; + TypeDefReplace['short'] := 'SmallInt'; TypeDefReplace['short int'] := 'SmallInt'; + TypeDefReplace['unsigned short'] := 'Word'; - TypeDefReplace['unsigned int'] := 'LongWord'; + TypeDefReplace['unsigned short int'] := 'Word'; + TypeDefReplace['int'] := 'Integer'; + TypeDefReplace['signed int'] := 'Integer'; + + TypeDefReplace['unsigned'] := 'LongWord'; + TypeDefReplace['unsigned int'] := 'LongWord'; + + TypeDefReplace['long long'] := 'Int64'; TypeDefReplace['unsigned long long'] := 'Int64'; + + TypeDefReplace['float'] := 'Single'; TypeDefReplace['CGFloat'] := 'Single'; - TypeDefReplace['short'] := 'smallInt'; + + TypeDefReplace['unit16_t'] := 'Word'; + TypeDefReplace['int32_t'] := 'Integer'; + TypeDefReplace['int64_t'] := 'Int64'; + TypeDefReplace['Class'] := '_Class'; + + TypeDefReplace['SRefCon'] := 'Pointer'; + TypeDefReplace['va_list'] := 'array of const'; IgnoreTokens.Add('DEPRECATED_IN_MAC_OS_X_VERSION_10_5_AND_LATER'); end; diff --git a/bindings/pascocoa/parser/objcparser.lpi b/bindings/pascocoa/parser/objcparser.lpi index 356d56ab1..c8ec6c32d 100755 --- a/bindings/pascocoa/parser/objcparser.lpi +++ b/bindings/pascocoa/parser/objcparser.lpi @@ -35,17 +35,17 @@ - + - + - - + + @@ -53,8 +53,8 @@ - - + + @@ -119,7 +119,7 @@ - + @@ -190,7 +190,7 @@ - + @@ -264,7 +264,104 @@ - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/bindings/pascocoa/parser/objcparser.pas b/bindings/pascocoa/parser/objcparser.pas index 54be755fe..4ffce6e1d 100755 --- a/bindings/pascocoa/parser/objcparser.pas +++ b/bindings/pascocoa/parser/objcparser.pas @@ -150,9 +150,8 @@ var st : TStringList; f : Text; err : AnsiString; - - begin + err := ''; writeln('would you like to parse all current directory files .h to inc?'); readln(ch); if (ch <> 'Y') and (ch <> 'y') then begin @@ -235,6 +234,8 @@ var vlm : AnsiString; Params : TStringList; begin + prm := ''; + vlm := ''; Params := TStringList.Create; Params.CaseSensitive := false; try @@ -270,10 +271,10 @@ begin end; var - inpf : AnsiString; - st : TStrings; + inpf : AnsiString = ''; + st : TStrings = nil; i : integer; - err : AnsiString; + err : AnsiString = ''; begin try GetConvertSettings(ConvertSettings, inpf);