diff --git a/bindings/pascocoa/parser/ObjCParserTypes.pas b/bindings/pascocoa/parser/ObjCParserTypes.pas index 2449d5ad3..c643e5aa4 100755 --- a/bindings/pascocoa/parser/ObjCParserTypes.pas +++ b/bindings/pascocoa/parser/ObjCParserTypes.pas @@ -2,8 +2,8 @@ ObjCParserTypes.pas Copyright (C) 2008 Dmitry 'Skalogryz' Boyarintsev - - objc parsing unit + + parsing objc header unit } unit ObjCParserTypes; @@ -13,7 +13,12 @@ interface {$ifdef fpc}{$mode delphi}{$endif fpc} uses - Classes, SysUtils; + Classes, SysUtils; + +const + Err_Ident = 'Identifier'; + Err_Expect = '%s, excepted, but %s found'; + Err_BadPrecompile = 'Bad precompile directive'; type TTokenType = (tt_Ident, tt_Symbol, tt_None, tt_Numeric); @@ -41,6 +46,7 @@ type TTextParser = class(TObject) protected function HandlePrecomiler: Boolean; virtual; + public Buf : AnsiString; Index : Integer; @@ -48,72 +54,86 @@ type TokenTable : TTokenTable; OnPrecompile : TNotifyEvent; OnComment : procedure (Sender: TObject; const Comment: AnsiString) of object; + Line : Integer; Stack : TList; + Errors : TStringList; constructor Create; destructor Destroy; override; - + procedure BeginParse(AObject: TObject); procedure EndParse; - + function SkipComments: Boolean; + function FindNextToken(var Token: AnsiString; var TokenType: TTokenType): Boolean; + + procedure SetError(const ErrorCmt: AnsiString); end; { TEntity } TEntity = class(TObject) protected - procedure DoParse(AParser: TTextParser); virtual; abstract; + function DoParse(AParser: TTextParser): Boolean; virtual; abstract; public owner : TEntity; Items : TList; constructor Create(AOwner: TEntity); destructor Destroy; override; - procedure Parse(AParser: TTextParser); virtual; + function Parse(AParser: TTextParser): Boolean; virtual; end; - + { TComment } //C tokens: /*, // TComment = class(TEntity) protected - procedure DoParse(AParser: TTextParser); override; + function DoParse(AParser: TTextParser): Boolean; override; public _Comment : WideString; end; + TSkip = class(TEntity) + protected + function DoParse(AParser: TTextParser): Boolean; override; + public + _Skip : AnsiString; + end; + { TPrecompiler } //C token: # TPrecompiler = class(TEntity) + {updated} protected - procedure DoParse(AParser: TTextParser); override; + function DoParse(AParser: TTextParser): Boolean; override; public _Directive : AnsiString; _Params : AnsiString; end; - + { TEnumValue } - TEnumValue = class(TEntity) + TEnumValue = class(TEntity) protected - procedure DoParse(AParser: TTextParser); override; + function DoParse(AParser: TTextParser): Boolean; override; public _Name : AnsiString; _Value : AnsiString; end; - + { TEnumTypeDef } - + //C token: enum + {updated} TEnumTypeDef = class(TEntity) protected fValCount : Integer; function GetValue(idx: integer): TEnumValue; - procedure DoParse(AParser: TTextParser); override; + function DoParse(AParser: TTextParser): Boolean; override; public _Name : AnsiString; property Value[idx: Integer]: TEnumValue read GetValue; @@ -123,8 +143,9 @@ type { TStructField } TStructField = class(TEntity) + {updated} protected - procedure DoParse(AParser: TTextParser); override; + function DoParse(AParser: TTextParser): Boolean; override; public _Name : AnsiString; _BitSize : Integer; @@ -136,8 +157,9 @@ type //C token: struct TStructTypeDef = class(TEntity) + {update} protected - procedure DoParse(AParser: TTextParser); override; + function DoParse(AParser: TTextParser): Boolean; override; public _Name : AnsiString; //todo: remove @@ -149,9 +171,10 @@ type TTypeDefSpecs = set of (td_Unsigned, td_Signed, td_Volitale, td_Const, td_Long, td_Short); + {updated} TTypeDef = class(TEntity) protected - procedure DoParse(AParser: TTextParser); override; + function DoParse(AParser: TTextParser): Boolean; override; public _Name : AnsiString; _Spec : TTypeDefSpecs; @@ -162,8 +185,9 @@ type //C token: typdef TTypeNameDef = class(TEntity) + {updated} protected - procedure DoParse(AParser: TTextParser); override; + function DoParse(AParser: TTextParser): Boolean; override; public _Inherited : AnsiString; _Type : TEntity; @@ -173,8 +197,9 @@ type { TObjCParameterDef } TObjCResultTypeDef = class(TTypeDef) + {updating} protected - procedure DoParse(AParser: TTextParser); override; + function DoParse(AParser: TTextParser): Boolean; override; public _isRef : Boolean; _isConst : Boolean; // (const Sometype) @@ -182,8 +207,9 @@ type end; TObjCParameterDef = class(TEntity) + {updated} protected - procedure DoParse(AParser: TTextParser); override; + function DoParse(AParser: TTextParser): Boolean; override; public _Res : TObjCResultTypeDef; _Name : AnsiString; @@ -192,8 +218,9 @@ type { TParamDescr } TParamDescr = class(TEntity) + {updated} protected - procedure DoParse(AParser: TTextParser); override; + function DoParse(AParser: TTextParser): Boolean; override; public _Descr : AnsiString; end; @@ -201,8 +228,9 @@ type { TClassMethodDef } TClassMethodDef = class(TEntity) + {update} protected - procedure DoParse(AParser: TTextParser); override; + function DoParse(AParser: TTextParser): Boolean; override; public _IsClassMethod : Boolean; // is class function as delphi would say _CallChar : AnsiChar; // + or - @@ -215,7 +243,7 @@ type //todo: implement TSubSection = class(TEntity) // for public, protected and private sections protected - procedure DoParse(AParser: TTextParser); override; + function DoParse(AParser: TTextParser): Boolean; override; public _EntityName : AnsiString; end; @@ -224,7 +252,7 @@ type TClassDef = class(TEntity) protected - procedure DoParse(AParser: TTextParser); override; + function DoParse(AParser: TTextParser): Boolean; override; public _ClassName : AnsiString; _SuperClass : AnsiString; @@ -238,13 +266,12 @@ type TObjCHeader = class(TEntity) protected - procedure DoParse(AParser: TTextParser); override; + function DoParse(AParser: TTextParser): Boolean; override; public _FileName : AnsiString; constructor Create; end; - const EoLnChars : TCharSet = [#10,#13]; InvsChars : TCharSet = [#32,#9]; @@ -257,7 +284,7 @@ procedure SetCSymbols(var ch: TCharSet); function CreateObjCTokenTable: TTokenTable; function LastEntity(ent: TEntity): TEntity; -function ParseCExpression(AParser: TTextParser): AnsiString; +function ParseCExpression(AParser: TTextParser; var ExpS: AnsiString): Boolean; function ScanWhile(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString; function ScanTo(const s: AnsiString; var index: Integer; const ch: TCharSet): AnsiString; @@ -266,8 +293,16 @@ function ParseTypeDef(Owner: TEntity; AParser: TTextParser): TEntity; procedure FreeEntity(Item: TEntity); +procedure ParseCNumeric(const S: AnsiString; var idx: integer; var NumStr: AnsiSTring); +function CToPascalNumeric(const Cnum: AnsiString): AnsiString; + implementation +function ErrExpectStr(const Expected, Found: AnsiString): AnsiString; +begin + Result := Format(Err_Expect, [Expected, Found]); +end; + procedure FreeEntity(Item: TEntity); var i : Integer; @@ -345,7 +380,7 @@ end; procedure SetCSymbols(var ch: TCharSet); begin - ch := ['(',')', '{','}', ':', '-','+','<','>','*',';', ','] + ch := ['(',')', '{','}', ':', '-','+','<','>','*',';', ',','|','&'] end; procedure SetCComments(Table: TTokenTable); @@ -436,11 +471,14 @@ end; constructor TTextParser.Create; begin Index := 1; + Line := 1; Stack := TList.Create; + Errors := TStringList.Create; end; destructor TTextParser.Destroy; begin + Errors.Free; Stack.Free; inherited Destroy; end; @@ -465,12 +503,82 @@ begin Result := Index <> idx; end; +function ParseHexNumber(const S:AnsiString; var idx: Integer): AnsiString; +begin + Result := ScanWhile(s, idx, ['0'..'9', 'A'..'F', 'a'..'f']); +end; + +procedure ParseCNumeric(const S: AnsiString; var idx: integer; var NumStr: AnsiSTring); +var + l : integer; + i : Integer; + f : AnsiString; +begin + l := length(s); + if (idx <= 0) or (idx > l) then Exit; + + if (s[idx] = '0') and (idx < l) and ((s[idx+1] = 'x') or (s[idx+1] = 'X')) then begin + inc(idx,2); + NumStr := '0x'+ParseHexNumber(s, idx); + end else begin + NumStr := ScanWhile(s, idx, ['0'..'9']); + if (idx < l) and (s[idx] = '.') then begin + i := idx + 1; + f := ScanWhile(s, i, ['0'..'9']); + if f <> '' then begin + idx := i; + NumStr := NumStr + '.' + f; + end; + end; + end; + + ScanWhile(s, idx, ['U','L','u','l']); +end; + +function isFloatNum(const num: AnsiString): Boolean; +begin + Result := Pos('.', num)>0; +end; + +function CToPascalNumeric(const Cnum: AnsiString): AnsiString; +var + i : Integer; + num : Int64; + c : Int64; +begin + if isFloatNum(cNum) then + Result := cNum + else if length(cNum) < 3 then + Result := cNum + else if cNum[1] <> '0' then + Result := cNum + else begin + if cNum[2] = 'x' + then Result := '$'+Copy(cNum, 3, length(cNum) - 2) + else begin + num := 0; + c := 1; + for i := length(cnum) downto 1 do begin + if not (cnum[i] in['0'..'7']) then begin + Result := cNum; + Exit; + end; + num := num + c * (byte(cnum[i]) - byte('0')); + c := c * 8; + end; + Result := IntToStr(num); + end; + end; +end; + + function TTextParser.FindNextToken(var Token: AnsiString; var TokenType: TTokenType): Boolean; var srch : TCharSet; blck : TCharSet; i : Integer; t : AnsiString; + spaces : TCharSet; begin Result := Index <= length(Buf); if not Result then Exit; @@ -490,23 +598,32 @@ begin Token := ''; Result := false; TokenType := tt_Ident; + + spaces := TokenTable.SpaceChars; try while (not Result) and (index <= length(Buf)) do begin - ScanWhile(Buf, index, TokenTable.SpaceChars); + ScanWhile(Buf, index, spaces); if not (IsSubStr(TokenTable.Precompile, Buf, Index) and HandlePrecomiler) then begin // 1. check is Compiler directive is found if (Buf[index] in TokenTable.Symbols) then begin // 2. symbol has been found, so it's not an ident if (not (Buf[index] in blck)) or (not SkipComments) then begin // 2.1 check if comment is found (comment prefixes match to the symbols) Result := true; // 2.2 check if symbol is found - TokenType := tt_Symbol; - Token := Buf[index]; - inc(index); + if (Buf[index] = '.') and (index < length(Buf)) and (Buf[index+1] in ['0'..'9']) then begin + // is float number + inc(index); + Token := '.' + ScanWhile(Buf, index, ['0'..'9']); + TokenType := tt_Numeric; + end else begin + TokenType := tt_Symbol; + Token := Buf[index]; + inc(index); + end; Exit; end; end else if (Buf[index] in ['0'..'9']) then begin // 3. a number is found, so it's possibl a number //todo: Hex and floats support! //todo: Negative numbers support; + ParseCNumeric(Buf, index, Token); TokenType := tt_Numeric; - Token := ScanWhile(Buf, index, ['0'..'9']); Result := true; Exit; end else begin @@ -528,6 +645,10 @@ begin if not Result then TokenType := tt_None else TokenPos := Index - length(Token); + + //todo: make an event or something + if TokenType = tt_Numeric then + Token := CToPascalNumeric(Token); end; end; @@ -559,6 +680,11 @@ begin end; end; +procedure TTextParser.SetError(const ErrorCmt: AnsiString); +begin + Errors.Add(ErrorCmt); +end; + { TTokenTable } constructor TTokenTable.Create; @@ -587,14 +713,17 @@ begin inherited Destroy; end; -procedure TEntity.Parse(AParser: TTextParser); +function TEntity.Parse(AParser: TTextParser): Boolean; begin + Result := false; AParser.BeginParse(Self); try - DoParse(AParser); - finally - AParser.EndParse; + Result := DoParse(AParser); + except + on e: Exception do + AParser.SetError('Internal error. Exception: ' + e.Message); end; + AParser.EndParse; end; { TClassDef } @@ -611,13 +740,14 @@ begin inherited; end; -procedure TClassDef.DoParse(AParser:TTextParser); +function TClassDef.DoParse(AParser: TTextParser): Boolean; var s : AnsiString; tt : TTokenType; cnt : Integer; mtd : TClassMethodDef; begin + Result := false; AParser.FindNextToken(s, tt); if s <> '@interface' then begin Exit; @@ -654,7 +784,9 @@ begin exit; end; - if s = '{' then inc(cnt) + //work around for not using preprocessor! #if @interface #else @interface #endif + if s = '@interface' then SkipLine(AParser.buf, AParser.index) + else if s = '{' then inc(cnt) else if s = '}' then dec(cnt) else if (cnt = 0) then begin //todo: better parsing @@ -668,6 +800,7 @@ begin end; end; until (s = '@end') or (s = ''); // looking for declaration end + Result := true; end; { TObjCHeader } @@ -678,30 +811,36 @@ begin inherited Create(nil); end; -procedure TObjCHeader.DoParse(AParser:TTextParser); +function TObjCHeader.DoParse(AParser: TTextParser): Boolean; var s : AnsiString; tt : TTokenType; ent : TEntity; begin + Result := false; while AParser.FindNextToken(s, tt) do begin if s = 'typedef' then begin AParser.Index := AParser.TokenPos; ent := TTypeNameDef.Create(Self); - ent.Parse(AParser); + if not ent.Parse(AParser) then Exit; end else if s = 'enum' then begin AParser.Index := AParser.TokenPos; ent := TEnumTypeDef.Create(Self); - ent.Parse(AParser); + if not ent.Parse(AParser) then Exit; AParser.FindNextToken(s, tt); // skipping last ';' end else if s = '@interface' then begin AParser.Index := AParser.TokenPos; ent := TClassDef.Create(Self); - ent.Parse(AParser); - end else - ent := nil; + if not ent.Parse(AParser) then Exit; + end else begin + // anything else is skipped, though should not! + ent := TSkip.Create(Self); + AParser.Index := AParser.TokenPos; + TSkip(ent)._Skip := SkipLine(AParser.Buf, AParser.Index); + end; if Assigned(ent) then Items.Add(ent); end; + Result := true; end; { TClassMethodDef } @@ -710,21 +849,17 @@ function TClassMethodDef.GetResultType: TObjCResultTypeDef; var i : integer; begin - for i := 0 to Items.Count - 1 do - if TObject(Items[i]) is TObjCResultTypeDef then begin Result := TObjCResultTypeDef(Items[i]); Exit; end; - Result := nil; - end; -procedure TClassMethodDef.DoParse(AParser:TTextParser); +function TClassMethodDef.DoParse(AParser: TTextParser): Boolean; var s : AnsiString; tt : TTokenType; @@ -732,8 +867,13 @@ var para : TObjCParameterDef; des : TParamDescr; begin + Result := false; AParser.FindNextToken(s, tt); - if (s <> '+') and (s <> '-') then Exit; + if (s <> '+') and (s <> '-') then begin + AParser.SetError( ErrExpectStr(' + or -, method descriptor ', s)); + Exit; + end; + _CallChar := s[1]; _IsClassMethod := _CallChar = '+'; @@ -742,38 +882,57 @@ begin // _Class methods can be with out type AParser.Index:=AParser.TokenPos; res := TObjCResultTypeDef.Create(Self); - res.Parse(AParser); + if not res.Parse(AParser) then begin + res.Free; + Exit; + end; Items.Add(res); end; - AParser.FindNextToken(_Name, tt); + if not AParser.FindNextToken(_Name, tt) then begin + AParser.SetError(ErrExpectStr('method name Identifier', s)); + Exit; + end; while AParser.FindNextToken(s, tt) do begin if s = ';' then - Exit + Break // successfuly parsed! else if s = ':' then begin para := TObjCParameterDef.Create(Self); - para.Parse(AParser); + if not para.Parse(AParser) then begin + para.Free; + Exit; + end; Items.Add(para); end else if tt = tt_Ident then begin des := TParamDescr.Create(Self); des._Descr := s; Items.Add(des); + end else begin + AParser.SetError(ErrExpectStr('type identifier', s)); + Exit; end; - end; // AParser.FindNextToken() + Result := true; end; { TParameterDef } -procedure TObjCParameterDef.DoParse(AParser:TTextParser); +function TObjCParameterDef.DoParse(AParser: TTextParser): Boolean; var tt : TTokenType; begin + Result := false; _Res := TObjCResultTypeDef.Create(Self); - _Res.Parse(AParser); + if not _Res.Parse(AParser) then Exit; + Items.Add(_Res); AParser.FindNextToken(_Name, tt); + if tt <> tt_Ident then begin + AParser.SetError(ErrExpectStr('Identifier', _Name)); + Exit; + end; + Result := true; end; { TResultTypeDef } @@ -795,13 +954,17 @@ begin end; end; -procedure TObjCResultTypeDef.DoParse(AParser: TTextParser); +function TObjCResultTypeDef.DoParse(AParser: TTextParser): Boolean; var s : AnsiString; tt : TTokenType; begin + Result := false; AParser.FindNextToken(s, tt); - if (tt <> tt_Symbol) and (s <> '(') then Exit; + if (tt <> tt_Symbol) and (s <> '(') then begin + AParser.SetError(ErrExpectStr('"("', s)); + Exit; + end; inherited DoParse(AParser); (* _prefix := ''; _TypeName := ''; @@ -825,6 +988,7 @@ begin AParser.FindNextToken(s, tt); if s <> ')' then ; // an error + Result := true; end; @@ -832,39 +996,46 @@ end; { TParamDescr } - -procedure TParamDescr.doParse(AParser: TTextParser); +function TParamDescr.DoParse(AParser: TTextParser): Boolean; var tt : TTokenType; begin + Result := false; AParser.FindNextToken(_Descr, tt); + if tt <> tt_Ident then begin + AParser.SetError(ErrExpectStr('Identifier', '_Descr')); + Exit; + end; + Result := true; end; { TSubSection } -procedure TSubSection.DoParse(AParser: TTextParser); +function TSubSection.DoParse(AParser: TTextParser): Boolean; begin //todo: + Result := true; end; { TPrecompiler } -procedure TPrecompiler.DoParse(AParser: TTextParser); +function TPrecompiler.DoParse(AParser: TTextParser): Boolean; var tt : TTokenType; - idx : Integer; begin - - idx := AParser.Index; + Result := false; if not AParser.FindNextToken(_Directive, tt) then begin - AParser.Index := idx; + AParser.Index := AParser.TokenPos; + AParser.SetError('precompiler directive not found'); Exit; end; if (_Directive = '') or (_Directive[1] <> '#') then begin - AParser.Index := idx; + AParser.Index := AParser.TokenPos; + AParser.SetError('identifier is not precompiler directive'); Exit; end; _Params := SkipLine(AParser.Buf, AParser.Index); + Result := true; end; { TEnumTypeDef } @@ -884,41 +1055,62 @@ begin Result := nil; end; -procedure TEnumTypeDef.DoParse(AParser: TTextParser); +function TEnumTypeDef.DoParse(AParser: TTextParser): Boolean; var token : AnsiString; tt : TTokenType; nm : AnsiString; - i : Integer; vl : TEnumValue; begin + Result := false; if not AParser.FindNextToken(token, tt) then Exit; - if token <> 'enum' then Exit; - - i := AParser.Index; - if not AParser.FindNextToken(nm, tt) then Exit; - if tt <> tt_Ident then AParser.Index := i + if token <> 'enum' then begin + AParser.SetError(ErrExpectStr('enum', token)); + Exit; + end; + + if not AParser.FindNextToken(nm, tt) then begin + AParser.SetError(ErrExpectStr('identifier', token)); + Exit; + end; + + if tt <> tt_Ident then AParser.Index := AParser.TokenPos else _Name := nm; - + AParser.FindNextToken(nm, tt); - if nm <> '{' then Exit; + if nm <> '{' then begin + AParser.SetError(ErrExpectStr('"{" for enumeration', token)); + Exit; + end; + repeat vl := TEnumValue.Create(Self); - vl.Parse(AParser); + if not vl.Parse(AParser) then begin + vl.Free; + Exit; + end; + if vl._Name <> '' then begin inc(fValCount); Items.Add(vl) - end else begin - vl.Free; - Exit; // incorrect header! enumeration value cannot go without name! end; - + AParser.FindNextToken(nm, tt); - if (nm <> ',') and (nm <> '}') then // if not , then ; must be followed! + if tt = tt_Symbol then begin + if (nm = ',') then begin + AParser.FindNextToken(nm, tt); + if tt = tt_Ident then + AParser.Index := AParser.TokenPos; + end; + end else begin + AParser.SetError(ErrExpectStr('"}"', token)); Exit; + end; + until nm = '}'; - - + + + Result := true; //AParser.FindNextToken(nm, tt); // skip last ';' end; @@ -934,6 +1126,9 @@ begin vl := nm[1]; case vl[1] of '+', '-', '*': Result := true; + '|', '&': begin + Result := true; + end; '<', '>': begin vl := nm[1]; Result := AParser.FindNextToken(nm, tt); @@ -946,7 +1141,7 @@ begin end; end; -function ParseCExpression(AParser: TTextParser): AnsiString; +function ParseCExpression(AParser: TTextParser; var ExpS: AnsiString): Boolean; var i : integer; nm : AnsiString; @@ -956,16 +1151,17 @@ begin //todo: better code. it's just a work around // i := AParser.Index; brac := 0; - Result := ''; + ExpS := ''; + Result := false; while AParser.FindNextToken(nm, tt) do begin if (tt = tt_Numeric) or (tt = tt_Ident) then begin - Result := Result + nm; + ExpS := ExpS + nm; i := AParser.Index; if not ParseCOperator(AParser, nm) then begin AParser.Index := i; Break; end else - Result := Result + ' ' + nm + ' '; + ExpS := ExpS + ' ' + nm + ' '; end else if (tt = tt_Symbol) then begin if nm ='(' then inc(brac) else if nm = ')' then dec(brac); @@ -978,55 +1174,74 @@ begin while (brac > 0) and (AParser.FindNextToken(nm, tt)) do if nm = ')' then dec(brac); + Result := true; end; { TEnumValue } -procedure TEnumValue.DoParse(AParser: TTextParser); +function TEnumValue.DoParse(AParser: TTextParser): Boolean; var - i : integer; s : AnsiString; tt : TTokenType; begin + Result := false; AParser.FindNextToken(_Name, tt); - if tt <> tt_Ident then Exit; + if tt <> tt_Ident then begin + AParser.SetError( ErrExpectStr('Identifier', _Name) ); + Exit; + end; - i := AParser.Index; AParser.FindNextToken(s, tt); if s <> '=' then begin - AParser.Index := i; + AParser.Index := AParser.TokenPos; _Value := ''; - end else - _Value := ParseCExpression(AParser); + end else begin + if not ParseCExpression(AParser, _Value) then + Exit; + end; + Result := true; end; { TComment } -procedure TComment.DoParse(AParser: TTextParser); +function TComment.DoParse(AParser: TTextParser): Boolean; begin + Result := true; //todo:! Comment parsing is now executed by TTextParser end; { TTypeNameDef } -procedure TTypeNameDef.DoParse(AParser: TTextParser); +function TTypeNameDef.DoParse(AParser: TTextParser): Boolean; var s : AnsiString; tt : TTokenType; begin + Result := false; AParser.FindNextToken(s, tt); - if s <> 'typedef' then Exit; - _Type := ParseTypeDef(Self, AParser); + if s <> 'typedef' then begin + AParser.SetError( ErrExpectStr('typedef', s)); + Exit; + end; - AParser.FindNextToken(_TypeName, tt); + _Type := ParseTypeDef(Self, AParser); + if not Assigned(_Type) then Exit; + + Result := AParser.FindNextToken(_TypeName, tt); + if not Result then begin + AParser.SetError( ErrExpectStr('Type name identifier', _TypeName) ); + Exit; + end; _inherited := GetTypeNameFromEntity(_Type); AParser.FindNextToken(s, tt); // skip last ';'; + + Result := true; end; { TStructTypeDef } -procedure TStructTypeDef.DoParse(AParser: TTextParser); +function TStructTypeDef.DoParse(AParser: TTextParser): Boolean; var s : AnsiString; tt : TTokenType; @@ -1034,8 +1249,13 @@ var st : TStructField; prev : TStructField; begin + Result := false; AParser.FindNextToken(s, tt); - if s <> 'struct' then Exit; + if s <> 'struct' then begin + AParser.SetError(ErrExpectStr('struct', s)); + Exit; + end; + AParser.FindNextToken(s, tt); i := AParser.TokenPos; if (tt = tt_Ident) then begin @@ -1053,26 +1273,36 @@ begin AParser.FindNextToken(s, tt); prev := nil; - while s <> '}' do begin + while (s <> '}') do begin //i := AParser.TokenPos; st := TStructField.Create(Self); if not Assigned(prev) then begin - st.Parse(AParser); + if not st.Parse(AParser) then Exit; end else begin AParser.FindNextToken(st._Name, tt); + if tt <> tt_Ident then begin + AParser.SetError(ErrExpectStr('field name', st._Name)); + Exit; + end; st._TypeName := prev._TypeName; end; Items.Add(st); AParser.FindNextToken(s, tt); - if s = ',' then prev := st - else prev := nil; + if s = ',' + then prev := st + else prev := nil; + if s = ';' then begin AParser.FindNextToken(s, tt); if s <> '}' then AParser.Index := AParser.TokenPos; + end else begin + AParser.SetError(ErrExpectStr('";"', st._Name)); + Exit; end; end; + Result := true; //no skipping last ';', because after structure a variable can be defined //ie: struct POINT {int x; int y} point; end; @@ -1087,25 +1317,33 @@ begin Result := err = 0; end; -procedure TStructField.DoParse(AParser: TTextParser); +function TStructField.DoParse(AParser: TTextParser): Boolean; var tt : TTokenType; s : AnsiString; begin + Result := false; _Type := ParseTypeDef(Self, AParser); if Assigned(_Type) then Exit; + _TypeName := GetTypeNameFromEntity(_Type); if not (AParser.FindNextToken(s, tt)) or (tt <> tt_Ident) then begin + AParser.SetError(ErrExpectStr('Identifier', s)); Exit; end; - + AParser.FindNextToken(s, tt); if (tt = tt_Symbol) and (s = ':') then begin AParser.FindNextToken(s, tt); + if tt <> tt_Numeric then begin + AParser.SetError(ErrExpectStr('number', s)); + Exit; + end; CVal(s, _BitSize); AParser.FindNextToken(s, tt); end; + Result := true; //success: (tt = tt_Symbol) and (s = ';') end; @@ -1136,29 +1374,49 @@ begin Result := false; end; -procedure TTypeDef.DoParse(AParser: TTextParser); +function TTypeDef.DoParse(AParser: TTextParser): Boolean; var s : AnsiString; tt : TTokenType; vl : TTypeDefSpecs; msk : TTypeDefSpecs; begin + Result := false; AParser.FindNextToken(s, tt); while (tt = tt_Ident) and (IsSpecifier(s, vl, msk)) do begin - if _Spec * msk <> [] then Exit; + if _Spec * msk <> [] then begin + AParser.SetError( ErrExpectStr('Type identifier', s)); + Exit; + end; _Spec := _Spec + vl; AParser.FindNextToken(s, tt); end; - if tt = tt_Ident then begin - _Name := s; - AParser.FindNextToken(s, tt); - if (tt = tt_Symbol) and (s = '*') then begin - _isPointer := true; - end else begin + if tt <> tt_Ident then begin + Result := true; // type name can be: usigned long! + AParser.Index := AParser.TokenPos; + Exit; + end; + _Name := s; + AParser.FindNextToken(s, tt); + if (tt = tt_Symbol) then begin + if (s = '*') then + _isPointer := true + else begin AParser.Index := AParser.TokenPos; + AParser.SetError( ErrExpectStr('identifier', 'symbol ' + s )); + Exit; end; - end else ; //error + end else + AParser.Index := AParser.TokenPos; + Result := true; +end; + +{ TSkip } + +function TSkip.DoParse(AParser: TTextParser): Boolean; +begin + Result := true; end; end. diff --git a/bindings/pascocoa/parser/ObjCParserUtils.pas b/bindings/pascocoa/parser/ObjCParserUtils.pas index a48eba1ba..191376b4e 100755 --- a/bindings/pascocoa/parser/ObjCParserUtils.pas +++ b/bindings/pascocoa/parser/ObjCParserUtils.pas @@ -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; +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]); - subs.add(ss); - end; +// 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 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] )); - WriteOutEnumValues(enm, ' ', st ); - st.Add(' );'); - st.Add(''); + 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; @@ -607,7 +726,7 @@ begin st.AddStrings(subs); subs.Clear; end; - + for i := 0 to hdr.Items.Count - 1 do if Assigned(hdr.Items[i]) then begin if (TObject(hdr.Items[i]) is TEnumTypeDef) then begin @@ -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,9 +831,13 @@ 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 - WriteOutIfComment(hdr.Items, i - 1, ' ', subs); - WriteOutClassToClasses(TClassDef(hdr.Items[i]), subs); + 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 @@ -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; + cl : TClassDef; 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 @@ -880,16 +1053,19 @@ begin Result := false; EnumIdx := TypeDefIdx - 1; if (EnumIdx < 0) or (EnumIdx >= items.Count) then Exit; - + if (TObject(items.Items[TypeDefIdx]) is TTypeNameDef) and - (TObject(items.Items[EnumIdx]) is TEnumTypeDef) then begin + (TObject(items.Items[EnumIdx]) is TEnumTypeDef) then begin typedef := TTypeNameDef(items.Items[TypeDefIdx]); enumdef := TEnumTypeDef(items.Items[EnumIdx]); end else Exit; - if typedef._Inherited = AppleInherit then enumdef._Name := typedef._TypeName; - Result := true; + if typedef._Inherited = AppleInherit then begin + enumdef._Name := typedef._TypeName; + Result := true; + end; + end; @@ -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. diff --git a/bindings/pascocoa/parser/objcparser.lpi b/bindings/pascocoa/parser/objcparser.lpi index d291dc732..5e0340121 100755 --- a/bindings/pascocoa/parser/objcparser.lpi +++ b/bindings/pascocoa/parser/objcparser.lpi @@ -9,11 +9,11 @@ - + @@ -30,22 +30,248 @@ - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -59,4 +285,16 @@ + + + + + + + + + + + + diff --git a/bindings/pascocoa/parser/objcparser.pas b/bindings/pascocoa/parser/objcparser.pas index 4704c653f..b9caeca4f 100755 --- a/bindings/pascocoa/parser/objcparser.pas +++ b/bindings/pascocoa/parser/objcparser.pas @@ -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; @@ -28,7 +30,7 @@ type procedure OnComment(Sender: TObject; const Comment: AnsiString); constructor Create(AHeader: TObjCHeader); end; - + procedure TPrecompileHandler.OnPrecompile(Sender: TObject); var parser : TTextParser; @@ -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,14 +148,17 @@ 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!'); Exit; end; - + pth := IncludeTrailingPathDelimiter( GetCurrentDir); writeln('looking for .h files in ', pth); res := FindFirst(pth + '*.h', -1, srch); @@ -146,20 +169,23 @@ begin write('found: ', srch.Name); write(' parsing...'); //writeln('parsing: ', pth+srch.Name); - ReadAndParseFile(pth+srch.Name, st); - write(' parsed '); - incs := pth + Copy(srch.Name,1, length(srch.Name) - length(ExtractFileExt(srch.Name))); - incs := incs + '.inc'; - //writeln(incs); - assignfile(f, incs); rewrite(f); - try - for i := 0 to st.Count - 1 do - writeln(f, st[i]); - finally - closefile(f); + 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'; + //writeln(incs); + assignfile(f, incs); rewrite(f); + try + for i := 0 to st.Count - 1 do + writeln(f, st[i]); + finally + closefile(f); + end; + st.Clear; + writeln(' converted!'); + end else begin + writeln('Error: ', err); end; - st.Clear; - writeln(' converted!'); 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,9 +211,11 @@ begin st := TStringList.Create; try - ReadAndParseFile(inpf, st); - for i := 0 to st.Count - 1 do - writeln(st[i]); + if not ReadAndParseFile(inpf, st, err) then + writeln('Error: ', err) + else + for i := 0 to st.Count - 1 do + writeln(st[i]); except end; st.Free;