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

iphonelazext: adding pbx file-xcode project sources

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3713 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2014-11-10 02:30:09 +00:00
parent 44f1fc48da
commit aa2c670376
5 changed files with 2391 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

752
components/iphonelazext/pbx/pbxcontainer.pas Normal file
View File

@ -0,0 +1,752 @@
unit pbxcontainer;
(*-------------------------------------------------------------------------------
* by Dmitry Boyarintsev - Oct 2014 *
* *
* license: free for use, but please leave a note to the origin of the library *
* *
* PBXcontainer unit is a library to read/write the pbx formatter file as a *
* whole The file structure is made to keep the reference in a complex objects *
* struture. Hierarchial trees, lists, cycles and so on. *
* *
* It's achieved by giving a full list of objects. With each object having an *
* "id" assigned. Later in the description, the reference is specifeid by the *
* object's id. *
* *
* Currently PBXContainer would read and try to build a structure based of *
* Object Pascal RTTI. (Not sure if Delphi compatible) *
* Following rules are used *
* read/write objects are going to join the list of objects (for the futher *
* reference) *
* read-only objects should be allocated in the constructor of the parent *
* they're "inlined" in the file *
* for array of objects TPBXObjectsList must be used *
* for array of strings TPBXStringArray must be used *
* for key-value set use TPBXKeyValue class *
* string and integer properties are supported... anything else? *
* *
* todo: add more documentions *
* *
* todo: memoty allocation and release. ObjC is using ref-counted structure. *
* do the same? similar? *
-------------------------------------------------------------------------------*)
interface
{$ifdef fpc}{$mode delphi}{$endif}
uses
Classes, SysUtils, typinfo, pbxfile, contnrs;
type
{ TPBXObject }
{ PBXObject }
PBXObject = class(TObject)
private
_id : string;
_fheaderComment : string;
protected
// collects the name of string properties that should be written out
// even if their values is an empty string.
// if property value is an empty string, it would not be written to the file
class procedure _WriteEmpty(propnames: TStrings); virtual;
public
property __id: string read _id;
property _headerComment: string read _fheaderComment write _fheaderComment;
constructor Create; virtual;
end;
PBXObjectClass = class of PBXObject;
TPBXObjectsList = class(TObjectList);
TPBXStringArray = class(TStringList);
TPBXKeyValue = class;
TPBXValueType = (vtString, vtArrayOfStr, vtKeyVal);
{ TPBXValue }
TPBXValue = class(TObject)
public
valType : TPBXValueType;
str : string;
arr : TPBXStringArray;
keyval : TPBXKeyValue;
destructor Destroy; override;
end;
{ TPBXKeyValue }
TPBXKeyValue = class(TFPHashObjectList)
protected
function AddVal(const name: string; atype: TPBXValueType): TPBXValue;
public
function AddStr(const name: string; const avalue: string = ''): TPBXValue;
function AddStrArray(const name: string): TPBXValue;
function AddKeyVal(const name: string): TPBXValue;
end;
TPBXFileInfo = record
archiveVersion : string;
objectVersion : string;
rootObject : PBXObject;
end;
{ TPBXReref }
TPBXReref = class(TObject)
instance : TObject;
propname : string;
_id : string;
constructor Create(ainstance: TObject; const apropname, aref: string);
end;
{ TPBXContainer }
TObjHashList = TFPHashObjectList;
TPBXContainer = class(TObject)
protected
procedure ReadObjects(p: TPBXParser; objs: TObjHashList);
function AllocObject(const nm: string): PBXObject;
public
function ReadFile(s: TStream; var AFileInfo: TPBXFileInfo): Boolean;
end;
procedure TestContainer(const buf: string);
procedure PBXRegisterClass(aclass: PBXObjectClass);
function PBXFindClass(const aclassname: string): PBXObjectClass;
function PBXReadObjectsListRef(p: TPBXParser; obj: PBXObject; propName: string; refs: TList): Boolean;
function PBXReadStringArray(p: TPBXParser; arr: TPBXStringArray): Boolean;
function PBXReadKeyValue(p: TPBXParser; kv: TPBXKeyValue): Boolean;
function PBXReadClass(p: TPBXParser; obj: PBXObject; refs: TList): Boolean;
procedure PBXReref(objs: TObjHashList; refs: TList);
function PBXWriteContainer(const FileInfo: TPBXFileInfo; AssignRef: Boolean = true): string;
procedure PBXWriteObjArray( w: TPBXWriter; list: TPBXObjectsList );
procedure PBXWriteStrArray( w: TPBXWriter; list: TPBXStringArray );
procedure PBXWriteKeyValue( w: TPBXWriter; kv: TPBXKeyValue );
procedure PBXWriteObj(pbx: PBXObject; w: TPBXWriter; WriteEmpty: TStrings);
procedure PBXAssignRef(list: TList);
procedure PBXGatherObjects(obj: TObject; srz: TList);
implementation
var
pbxClassList : TStringList;
function PBXReadKeyValue(p: TPBXParser; kv: TPBXKeyValue): Boolean;
var
et : TPBXEntity;
v : TPBXValue;
begin
et:=p.FetchNextEntity;
while et<>etCloseObject do begin
case et of
etValue: kv.AddStr(p.Name, p.Value);
etOpenArray: begin
v:=kv.AddStrArray(p.Name);
PBXReadStringArray(p, v.arr);
end;
etOpenObject: begin
v:=kv.AddKeyVal(p.Name);
PBXReadKeyValue(p, v.keyval);
end;
else
Result:=false;
Exit;
end;
et:=p.FetchNextEntity;
end;
Result:=True;
end;
procedure TestContainer(const buf: string);
var
c : TPBXContainer;
st : TStringStream;
info : TPBXFileInfo;
begin
c:= TPBXContainer.Create;
st := TStringStream.Create(buf);
try
c.ReadFile(st, info);
writeln('arch ver: ',info.archiveVersion);
writeln(' obj ver: ',info.objectVersion);
writeln('root obj: ', PtrUInt( info.rootObject ));
finally
st.Free;
c.Free;
end;
end;
procedure PBXRegisterClass(aclass: PBXObjectClass);
begin
pbxClassList.AddObject(aclass.ClassName, TObject(aclass));
end;
function PBXFindClass(const aclassname: string): PBXObjectClass;
var
i : integer;
begin
i:=pbxClassList.IndexOf(aclassname);
if i<0 then Result:=nil
else Result:=PBXObjectClass(pbxClassList.Objects[i]);
end;
{ TPBXValue }
destructor TPBXValue.Destroy;
begin
arr.Free;
keyval.Free;
inherited Destroy;
end;
{ TPBXKeyValue }
function TPBXKeyValue.AddVal(const name: string; atype: TPBXValueType): TPBXValue;
begin
Result:=TPBXValue.Create;
Result.valType:=atype;
case atype of
vtKeyVal: Result.keyval:=TPBXKeyValue.Create(true);
vtArrayOfStr: Result.arr:=TPBXStringArray.Create;
end;
Add(name, Result);
end;
function TPBXKeyValue.AddStr(const name: string; const avalue: string): TPBXValue;
begin
Result:=AddVal(name, vtString);
Result.str:=avalue;
end;
function TPBXKeyValue.AddStrArray(const name: string): TPBXValue;
begin
Result:=AddVal(name, vtArrayOfStr);
end;
function TPBXKeyValue.AddKeyVal(const name: string): TPBXValue;
begin
Result:=AddVal(name, vtKeyVal);
end;
{ TPBXReref }
constructor TPBXReref.Create(ainstance: TObject; const apropname, aref: string);
begin
inherited Create;
instance := ainstance;
propname := apropname;
_id := aref;
end;
{ TPBXObject }
class procedure PBXObject._WriteEmpty(propnames: TStrings);
begin
end;
constructor PBXObject.Create;
begin
end;
{ TPBXContainer }
procedure PBXReref(objs: TObjHashList; refs: TList);
var
i : integer;
refobj : TObject;
r : TPBXReref;
prp : PPropInfo;
pcls : TObject;
begin
for i:=0 to refs.Count-1 do begin
r := TPBXReref(refs[i]);
refobj:=objs.Find(r._id);
if Assigned(refobj) then begin
prp:=GetPropInfo(r.instance, r.propname);
if prp^.PropType^.Kind=tkClass then begin
pcls:=GetObjectProp(r.instance, r.propname);
if pcls is TPBXObjectsList then begin
TPBXObjectsList(pcls).Add(refobj);
end else begin
//writeln('setting prop: ', r.propname,' ');
SetObjectProp(r.instance, r.propname, refobj);
end;
end;
end;
//else writeln('no object found! ', r._id);
end;
end;
procedure TPBXContainer.ReadObjects(p: TPBXParser; objs: TObjHashList);
var
tk : TPBXEntity;
id : string;
cls : string;
obj : PBXObject;
i : Integer;
refs : TList;
cmt : string;
begin
tk:=p.FetchNextEntity;
refs:=TList.Create;
try
while tk<>etCloseObject do begin
if tk=etOpenObject then begin
id:=p.Name;
cmt:=p.LastComment;
cls:='';
p.FetchNextEntity;
if (p.CurEntity = etValue) and (p.Name = 'isa') then begin
cls:=p.Value;
obj:=AllocObject(cls);
if Assigned(obj) then begin
obj._headerComment:=cmt;
obj._id:=id;
PBXReadClass(p, obj, refs);
objs.Add(id, obj);
end else
PBXParserSkipLevel(p);
end else
PBXParserSkipLevel(p);
end;
tk:=p.FetchNextEntity;
end;
PBXReref(objs, refs);
finally
for i:=0 to refs.Count-1 do TObject(refs[i]).Free;
refs.Free;
end;
end;
function TPBXContainer.AllocObject(const nm: string): PBXObject;
var
cls : PBXObjectClass;
begin
cls:=PBXFindClass(nm);
if not Assigned(cls) then Result:=nil
else Result:=cls.Create;
end;
function TPBXContainer.ReadFile(s: TStream; var AFileInfo: TPBXFileInfo): Boolean;
var
p : TPBXParser;
buf : string;
tk : TPBXEntity;
root : string;
objs : TObjHashList;
rt : TObject;
begin
Result:=false;
AFileInfo.archiveVersion:='';
AFileInfo.objectVersion:='';
AFileInfo.rootObject:=nil;
if not Assigned(s) then Exit;
SetLength(buf, s.Size);
s.Read(buf[1], length(buf));
objs:=TObjHashList.Create(False);
p:=TPBXParser.Create;
try
p.scanner.SetBuf(buf);
if p.FetchNextEntity <> etOpenObject then Exit;
tk:=p.FetchNextEntity;
while tk <> etEOF do begin
if tk = etValue then begin
if p.Name='archiveVersion' then AFileInfo.archiveVersion:=p.Value
else if p.Name='objectVersion' then AFileInfo.objectVersion:=p.Value
else if p.Name='rootObject' then root:=p.Value;
end else if (tk=etOpenObject) and (p.Name = 'objects') then begin
ReadObjects(p, objs);
end;
tk:=p.FetchNextEntity;
end;
rt:=objs.Find(root);
if Assigned(rt) and (rt is PBXObject) then
AFileInfo.rootObject:=PBXObject(rt);
Result:=true;
finally
objs.Free;
p.Free;
end;
end;
function PBXReadObjectsListRef(p: TPBXParser; obj: PBXObject; propName: string; refs: TList): Boolean;
begin
Result:=true;
p.FetchNextEntity;
while not (p.CurEntity in [etCloseArray, etEOF, etError]) do begin
if p.CurEntity <> etValue then begin
Result:=false;
Exit;
end;
if p.Value<>'' then
refs.Add ( TPBXReref.Create( obj, propName, p.Value ));
p.FetchNextEntity;
end;
end;
function PBXReadStringArray(p: TPBXParser; arr: TPBXStringArray): Boolean;
begin
Result:=true;
p.FetchNextEntity;
while not (p.CurEntity in [etCloseArray, etEOF, etError]) do begin
if p.CurEntity <> etValue then begin
Result:=false;
Exit;
end;
arr.Add(p.Value);
p.FetchNextEntity;
end;
end;
function PBXReadClass(p: TPBXParser; obj: PBXObject; refs: TList): Boolean;
var
tk : TPBXEntity;
lvl : Integer;
prp : PPropInfo;
pobj : TObject;
pk : TTypeKind;
begin
lvl:=p.Level;
tk:=p.FetchNextEntity;
while p.Level>=lvl {tk<>tkCurlyBraceClose} do begin
prp:=GetPropInfo(obj, p.Name);
if Assigned(prp) then begin
pk:=prp^.PropType^.Kind;
if pk=tkClass then
pobj:=GetObjectProp(obj, prp)
else
pobj:=nil;
if tk=etValue then begin
case pk of
tkClass: begin
//writeln('ref for: ',p.Name,' to ', p.Value);
refs.Add( TPBXReref.Create(obj, p.Name, p.Value))
end;
tkInteger, tkInt64, tkQWord: begin
SetInt64Prop(obj, p.Name, StrToIntDef(p.Value, GetInt64Prop(obj, p.Name)) );
end;
else
SetStrProp(obj, p.Name, p.Value);
end;
end else begin
{write( p.CurEntity,' ',p.Name,' ',PtrUInt(pobj));
if Assigned(pobj) then write(' ', pobj.ClassName);
writeln;}
if (pobj is TPBXObjectsList) and (tk = etOpenArray) then begin
Result:=PBXReadObjectsListRef(p, obj, p.Name, refs);
if not Result then Exit;
end else if (pobj is TPBXStringArray) and (tk = etOpenArray) then begin
Result:=PBXReadStringArray(p, TPBXStringArray(pobj) );
if not Result then Exit;
end else if (pobj is TPBXKeyValue) and (tk = etOpenObject) then begin
Result:=PBXReadKeyValue(p, TPBXKeyValue(pobj) );
if not Result then Exit;
end else
// array of object
PBXParserSkipLevel(p);
end;
end else begin
writeln(obj.ClassName, ': property not found: ', p.Name);
if tk <> etValue then
PBXParserSkipLevel(p);
end;
tk:=p.FetchNextEntity;
end;
Result:=true;
end;
procedure PBXGatherObjects(obj: TObject; srz: TList);
var
plist : PPropList;
cnt : Integer;
i : Integer;
j : Integer;
k : Integer;
arr : TPBXObjectsList;
ch : TObject;
ach : TObject;
kind : TTypeKind;
const
FlagGet = 3; // 1 + 2 //ptField = 0;
FlagSet = 12; // 4 + 8 , 16 + 32 //ptStatic = 1;
FlagSP = 16 + 32; //ptVirtual = 2;
FlagIdx = 64; //ptConst = 3; }
begin
if (not Assigned(obj)) or (not Assigned(srz)) then Exit;
srz.Add(obj);
j:=0;
while j<srz.Count do begin
obj:=TObject(srz[j]);
plist:=nil;
cnt:=GetPropList(obj, plist);
if Assigned(plist) then begin
for i:=0 to cnt-1 do begin
kind := plist^[i]^.PropType^.Kind;
if (kind<>tkClass) then Continue;
ch:=GetObjectProp(obj, plist^[i] );
if not Assigned(ch) then Continue;
if (plist^[i]^.PropProcs and FlagSet <> FlagSet) then begin
if srz.IndexOf(ch)<0 then
srz.Add ( ch );
end else if ch is TPBXObjectsList then begin
arr:=TPBXObjectsList(ch);
for k:=0 to arr.Count-1 do begin
ach:=arr[k];
if srz.IndexOf(ach)<0 then srz.Add(ach);
end;
end;
end;
Freemem(plist);
end;
inc(j);
end;
end;
procedure PBXAssignRef(list: TList);
var
i : Integer;
p : PBXObject;
id: Int64;
begin
if not Assigned(list) then Exit;
id:=2; // root! :)
for i:=0 to list.Count-1 do begin
p:=PBXObject(list[i]);
if not Assigned(p) then Continue;
if (p._id='') then begin
p._id:=IntToHex(id, 24);
inc(id);
end;
end;
// 0AFA6EA519F60EFD004C8FD9
// 123456789012345678901234
end;
procedure PBXWriteStrArray( w: TPBXWriter; list: TPBXStringArray );
var
i : Integer;
begin
w.OpenBlock('(');
for i:=0 to list.Count-1 do
w.WriteArrValue(list.Strings[i]);
w.CloseBlock(')');
end;
procedure PBXWriteObjArray( w: TPBXWriter; list: TPBXObjectsList );
var
i : Integer;
pbx : PBXObject;
begin
for i:=0 to list.Count-1 do begin
pbx:=PBXObject(list[i]);
w.WriteArrValue(pbx._id, pbx._headerComment);
end;
end;
procedure PBXWriteKeyValue( w: TPBXWriter; kv: TPBXKeyValue );
var
i : Integer;
v : TPBXValue;
nm : string;
begin
w.OpenBlock( '{' );
for i:=0 to kv.Count-1 do begin
v:=TPBXValue(kv.Items[i]);
nm:=kv.NameOfIndex(i);
w.WriteName(nm);
case v.valType of
vtString: w.WriteValue(v.str);
vtArrayOfStr: PBXWriteStrArray(w, v.arr);
vtKeyVal: PBXWriteKeyValue(w, v.keyval);
end;
end;
w.CloseBlock( '}' );
end;
procedure PBXWriteObj(pbx: PBXObject; w: TPBXWriter; WriteEmpty: TStrings);
var
p : PPropList;
cnt : Integer;
i,j : Integer;
isMan : Boolean;
vl : string;
sobj : TObject;
nm : string;
vcmt : string;
isstr : Boolean;
// used for sorting. todo: find a better way for sort by names!
names : TStringList;
begin
w.WriteName(pbx._id, pbx._headerComment);
isMan:=(pbx.ClassName='PBXFileReference') or (pbx.ClassName='PBXBuildFile');
if isMan then w.ManualLineBreak:=true;
w.OpenBlock('{');
w.WriteNamedValue('isa', pbx.ClassName);
p:=nil;
cnt:=GetPropList(pbx, p);
//todo: I don't like this soritng at all!
// but it appears to be the most common available
names:=TStringList.Create;
try
for i:=0 to cnt-1 do names.AddObject(p^[i].Name, TObject(PtrUInt(i)));
names.Sort;
for j:=0 to names.Count-1 do begin
i:=Integer(PtrUInt(names.Objects[j]));
vl:='';
vcmt:='';
isstr:=false;
nm:=p^[i].Name;
if p^[i].PropType.Kind=tkClass then begin
sobj:=GetObjectProp(pbx, p^[i]);
if sobj is PBXObject then begin
vl:=PBXObject(sobj)._id;
vcmt:=PBXObject(sobj)._headerComment;
isstr:=vl<>'';
end else if sobj is TPBXObjectsList then begin
w.WriteName(nm); w.OpenBlock('(');
PBXWriteObjArray( w, TPBXObjectsList(sobj) );
w.CloseBlock(')');
end else if sobj is TPBXStringArray then begin
w.WriteName(nm);
PBXWriteStrArray( w, TPBXStringArray(sobj) );
end else if sobj is TPBXKeyValue then begin
w.WriteName(nm);
PBXWriteKeyValue(w, TPBXKeyValue(sobj));
end;
end else if p^[i].PropType.Kind in [tkAString, tkString] then begin
vl:=GetStrProp(pbx,p^[i]);
isstr:=(vl<>'') or (WriteEmpty.indexOf(nm)>=0);
end else if p^[i].PropType.Kind in [tkInteger, tkInt64, tkQWord] then begin
vl:=IntToStr(GetInt64Prop(pbx, p^[i]));
isstr:=(vl<>'') or (WriteEmpty.indexOf(nm)>=0);
end;
if isstr then begin
w.WriteName(nm);
w.WriteValue(vl,vcmt);
end;
end;
if isMan then w.ManualLineBreak:=false;
w.CloseBlock('}');
finally
names.Free;
if Assigned(p) then Freemem(p);
end;
end;
function PBXWriteContainer(const FileInfo: TPBXFileInfo; AssignRef: Boolean = true): string;
var
lst : TList;
st : TStringList;
i : Integer;
w : TPBXWriter;
sc : string;
pbx : PBXObject;
emp : TStringList;
begin
lst:=TList.Create;
st:=TStringList.Create;
emp:=TStringList.Create;
try
PBXGatherObjects(fileInfo.rootObject, lst);
if AssignRef then PBXAssignRef(lst);
for i:=0 to lst.Count-1 do begin
st.AddObject( PBXObject(lst[i]).ClassName+' '+PBXObject(lst[i])._id, PBXObject(lst[i]));
end;
st.Sort;
w:=TPBXWriter.Create;
try
sc:='';
w.WriteRaw('// !$*UTF8*$!');
w.WriteLineBreak;
w.OpenBlock('{');
w.WriteNamedValue('archiveVersion', FileInfo.archiveVersion);
w.WriteName('classes'); w.OpenBlock('{'); w.CloseBlock('}');
w.WriteNamedValue('objectVersion', FileInfo.objectVersion);
w.WriteName('objects'); w.OpenBlock('{');
for i:=0 to st.Count-1 do begin
pbx:=PBXObject(st.Objects[i]);
if sc<>pbx.ClassName then begin
if sc<>'' then begin
w.WriteLineComment('End '+sc+' section');
end;
sc:=pbx.ClassName;
w.WriteLineBreak();
w.WriteLineComment('Begin '+sc+' section');
emp.Clear;
pbx._WriteEmpty(emp);
end;
PBXWriteObj(pbx, w, emp);
end;
if sc<>'' then w.WriteLineComment('End '+sc+' section');
w.CloseBlock('}');
w.WriteNamedValue('rootObject', FileInfo.rootObject._id, FileInfo.rootObject._headerComment);
w.CloseBlock('}');
Result:=w.Buffer;
finally
w.Free;
end;
finally
st.Free;
lst.Free;
emp.Free;
end;
end;
initialization
pbxClassList := TStringList.Create;
finalization
pbxClassList.Free;
end.

715
components/iphonelazext/pbx/pbxfile.pas Normal file
View File

@ -0,0 +1,715 @@
unit pbxfile;
interface
(*-------------------------------------------------------------------------------
* by Dmitry Boyarintsev - Oct 2014 *
* *
* license: free for use, but please leave a note to the origin of the library *
* *
* pbxfile is JSON file format by Apple. Unlike JSON, it allows to add comments. *
* (was it introduced in NextStep system?) *
* other differences *
* no explicit type in values/identifiers *
* . and / are valud value/identifier character *
* ; - is a separator in values *
* () - is an array. the last element can (should?) end up with comma *
* {} - is an object (just like json) *
* escaping characters with C-style escaping: *
* * quotes (") *
* * line breaks (note OSX is typically using \n, unline Unix \r) *
* *
* PBXScanner - scans through the file *
* PBXParser - parses the file, returning a higher level entities of the file: *
* values, open/close of object/array *
* The parser doesn't produce any kind of structure. Instead it only allows to *
* build one. i.e. PBXContainer *
-------------------------------------------------------------------------------*)
{$ifdef fpc}{$mode delphi}{$endif}
uses
SysUtils, StrUtils;
type
TPBXToken = (
tkEOF,
tkComma, // ','
tkSemiColon, // ';'
tkEqual, // '='
tkCurlyBraceOpen, // '{'
tkCurlyBraceClose, // '}'
tkRoundBraceOpen, // '('
tkRoundBraceClose, // ')'
tkIdentifier,
tkUnknown
);
TCommentEvent = procedure (Sender: TObject; const cmtText: string) of object;
{ TPBXScanner }
TPBXScanner = class(TObject)
private
buf : string;
idx : Integer;
FCurLine : string;
FCurRow : Integer;
FCurToken : TPBXToken;
FCurTokenString: string;
function GetCurColumn: Integer;
protected
procedure DoComment(const cmt: string);
procedure SkipComment(const EndOfLine: Boolean);
function DoFetchToken: TPBXToken;
public
OnComment: TCommentEvent;
procedure SetBuf(const abuf: string);
function FetchToken: TPBXToken;
property CurLine: string read FCurLine;
property CurRow: Integer read FCurRow;
property CurColumn: Integer read GetCurColumn;
property CurToken: TPBXToken read FCurToken;
property CurTokenString: string read FCurTokenString;
end;
TPBXEntity = (
etOpenArray, etCloseArray
, etOpenObject, etCloseObject
, etValue
, etEOF
, etError
);
TPBXParserState = (stInit, stObject, stObjectNext, stArray, stArrayNext, stError);
{ TPBXParser }
TPBXParser = class(TObject)
private
fState : TPBXParserState;
fStStack : array of TPBXParserState;
fStCount : Integer;
fFetchComment: TCommentEvent;
procedure PushState(AState: TPBXParserState);
function PopState: TPBXParserState;
function DefaultFetch(tk: TPBXToken): TPBXEntity;
procedure DoScanComment(sender: TObject; const acomment: string);
public
scanner : TPBXScanner;
Name : string;
Value : string;
CurEntity : TPBXEntity;
LastComment : string;
procedure Reset;
function FetchNextEntity: TPBXEntity;
constructor Create;
destructor Destroy; override;
property Level: Integer read fStCount;
end;
{ TPBXWriter }
TPBXWriter = class(TObject)
private
fbuf : string;
idx : Integer;
protected
fprefix : Integer;
fManualLineBreak : Boolean;
fisNewLine : Boolean;
//fstack : array of fstack;
procedure IncPrefix;
procedure DecPrefix;
function GetBuf: string;
procedure DoWriteRaw(const s: string);
procedure DoWrite(const s: string);
procedure DoLineBreak;
public
constructor Create;
procedure OpenBlock(const openchar: string);
procedure CloseBlock(const closechar: string);
procedure WriteRaw(const s: string);
procedure WriteLineBreak;
procedure WriteLineComment(const s: string);
procedure WriteName(const nm: string; const cmt: string = '');
procedure WriteValue(const v: string; const cmt: string = '');
procedure WriteArrValue(const v: string; const cmt: string = '');
procedure WriteNamedValue(const nm, v: string; const cmt: string = '');
property Buffer: string read GetBuf;
property ManualLineBreak: Boolean read fManualLineBreak write fManualLineBreak;
end;
const
CharOffset = #$09;
CharLineBreak = #$0A;
CharSeparator = ';';
CharArrSeparator = ',';
CharSpace = #$20;
procedure ScanAString(const test: string);
procedure ParseAString(const test: string);
function PBXParserSkipLevel(p: TPBXParser): Boolean;
function PBXRawWriteValue(const v: string): string;
implementation
type
TCharSet = set of char;
const
LineBreaks = [#10, #13];
WhiteSpace = [#9,#8,#32];
WhiteSpaceBreaks = LineBreaks+WhiteSpace;
Alpha = ['a'..'z','A'..'Z'];
Numeric = ['0'..'9'];
AlphaNumeric = Alpha+Numeric;
IdentName = AlphaNumeric+['_','.','/']; // . and / are allowed in values
ToEscape = ['"',#13,#9,#10,'\'];
// commas are not
function PBXRawWriteValue(const v: string): string;
var
i : Integer;
k : Integer;
begin
k:=0;
for i:=1 to length(v) do begin
if not (v[i] in IdentName) then begin
if Result='' then begin
SetLength(Result, length(v)*2+2);
Result[1]:='"';
Move(v[1], Result[2], i);
k:=i+1;
end;
if (v[i] in ToEscape) then begin
Result[k]:='\';
inc(k);
case v[i] of
'"': Result[k]:='"';
#13: Result[k]:='n';
#10: Result[k]:='r';
#9: Result[k]:='t';
'\': Result[k]:='\';
end;
inc(k);
end else begin
Result[k]:=v[i];
inc(k);
end;
end else if k>0 then begin
Result[k]:=v[i];
inc(k);
end;
end;
if k=0 then
Result:=v
else begin
Result[k]:='"';
SetLength(Result,k);
end;
end;
function ScanTo(const s: string; var idx: Integer; ToChars: TCharSet): string;
var
i : integer;
begin
i:=idx;
while (idx<=length(s)) and not (s[idx] in ToChars) do inc(idx);
Result:=Copy(s, i, idx-i);
end;
function ScanWhile(const s: string; var idx: Integer; WhileChars: TCharSet): string;
var
i : integer;
begin
i:=idx;
while (idx<=length(s)) and (s[idx] in WhileChars) do
inc(idx);
Result:=Copy(s, i, idx-i);
end;
{ TPBXWriter }
procedure TPBXWriter.IncPrefix;
begin
inc(fprefix);
end;
procedure TPBXWriter.DecPrefix;
begin
dec(fprefix);
end;
function TPBXWriter.GetBuf: string;
begin
Result:=fbuf;
SetLength(Result, idx-1);
end;
procedure TPBXWriter.DoWriteRaw(const s: string);
var
sz : Integer;
bufsz : Integer;
begin
if s ='' then Exit;
sz:=length(s)+idx-1;
bufsz:=length(fbuf);
while bufsz<sz do begin
if bufsz=0 then bufsz:=1024
else bufsz:=bufsz*2;
end;
SetLength(fbuf, bufsz);
Move(s[1], fbuf[idx], length(s));
inc(idx, length(s));
fisNewLine:=false;
end;
procedure TPBXWriter.DoWrite(const s: string);
var
pfx : string;
begin
if fisNewLine and (fprefix>0) then begin
SetLength(pfx, fprefix);
FillChar(pfx[1], fprefix, CharOffset);
DoWriteRaw(pfx);
end;
DoWriteRaw(s);
end;
procedure TPBXWriter.DoLineBreak;
begin
DoWriteRaw(CharLineBreak);
fisNewLine:=true;
end;
constructor TPBXWriter.Create;
begin
idx:=1;
end;
procedure TPBXWriter.OpenBlock(const openchar: string);
begin
DoWrite(openchar);
IncPrefix;
if not fManualLineBreak then DoLineBreak;
end;
procedure TPBXWriter.CloseBlock(const closechar: string);
begin
DecPrefix;
DoWrite(closechar);
if fprefix>0 then DoWriteRaw(CharSeparator);
if not fManualLineBreak then DoLineBreak;
end;
procedure TPBXWriter.WriteRaw(const s: string);
begin
DoWriteRaw(s);
end;
procedure TPBXWriter.WriteLineBreak;
begin
DoLineBreak;
end;
procedure TPBXWriter.WriteLineComment(const s: string);
begin
DoWriteRaw('/* ');
DoWriteRaw(s);
DoWriteRaw(' */');
DoLineBreak;
end;
procedure TPBXWriter.WriteName(const nm: string; const cmt: string = '');
begin
if nm='' then Exit;
DoWrite(PBXRawWriteValue(nm));
if cmt<>'' then begin
DoWriteRaw(' /* ');
DoWriteRaw(cmt);
DoWriteRaw(' */');
end;
DoWriteRaw(' = ');
end;
procedure TPBXWriter.WriteValue(const v: string; const cmt: string = '');
begin
if v ='' then DoWriteRaw('""')
else DoWriteRaw(PBXRawWriteValue(v));
if cmt<>'' then begin
DoWriteRaw(' /* ');
DoWriteRaw(cmt);
DoWriteRaw(' */');
end;
DoWriteRaw(CharSeparator);
if not fManualLineBreak then DoLineBreak
else DoWriteRaw(CharSpace);
end;
procedure TPBXWriter.WriteArrValue(const v: string; const cmt: string);
begin
DoWrite(PBXRawWriteValue(v));
if cmt<>'' then begin
DoWriteRaw(' /* ');
DoWriteRaw(cmt);
DoWriteRaw(' */');
end;
DoWriteRaw(CharArrSeparator);
if not fManualLineBreak then DoLineBreak
else DoWriteRaw(CharSpace);
end;
procedure TPBXWriter.WriteNamedValue(const nm, v: string; const cmt: string);
begin
WriteName(nm);
WriteValue(v, cmt);
end;
{ TPBXParser }
procedure TPBXParser.PushState(AState: TPBXParserState);
begin
if fStCount=length(fStStack) then begin
if fStCount=0 then SetLength(fStStack, 4)
else SetLength(fStStack, fStCount*2);
end;
fStStack[fStcount]:=AState;
inc(fStcount);
fState:=AState;
end;
function TPBXParser.PopState: TPBXParserState;
begin
dec(fStCount);
if fStCount>0 then begin
fState:=fStStack[fStCount-1];
if fState = stObject then fState:=stObjectNext
else if fState = stArray then fState:=stArrayNext;
end else
fState:=stInit;
Result:=fState;
end;
function TPBXParser.DefaultFetch(tk: TPBXToken): TPBXEntity;
begin
case tk of
tkIdentifier: begin
Value:=scanner.CurTokenString;
Result:=etValue;
end;
tkCurlyBraceOpen: begin
Result:=etOpenObject;
PushState(stObject)
end;
tkRoundBraceOpen: begin
Result:=etOpenArray;
PushState(stArray)
end;
else
Result:=etError;
end;
end;
procedure TPBXParser.DoScanComment(sender: TObject; const acomment: string);
begin
LastComment:=acomment;
if Assigned(fFetchComment) then
fFetchComment(sender, acomment);
end;
procedure TPBXParser.Reset;
begin
fState:=stInit;
end;
function TPBXParser.FetchNextEntity: TPBXEntity;
var
tk : TPBXToken;
done : Boolean;
begin
LastComment:='';
Name:='';
Value:='';
case fState of
stInit :
case scanner.FetchToken of
tkCurlyBraceOpen:
begin
PushState(stObject);
Result:=etOpenObject;
end;
tkEOF:
Result:=etEOF;
else
Result:=etError;
end;
stObject, stObjectNext:
repeat
done:=true;
case scanner.FetchToken of
tkSemiColon: begin
if fState = stObjectNext then begin
done:=false;
fState:=stObject;
end else
Result:=etError;
end;
tkCurlyBraceClose: begin
PopState;
Result:=etCloseObject;
end;
tkIdentifier:
begin
Name:=scanner.CurTokenString;
LastComment:='';
if scanner.FetchToken <> tkEqual then begin
Result:=etError;
end else begin
tk:=scanner.FetchToken;
Result:=DefaultFetch(tk);
if Result=etValue then fState:=stObjectNext;
end;
end;
end;
until done;
stArray, stArrayNext: begin
repeat
done:=true;
tk:=scanner.FetchToken;
case tk of
tkComma: begin
if fState = stArrayNext then begin
fState:=stArray;
done:=false;
end else
Result:=etError; // unexpected comma
end;
tkRoundBraceClose: begin
PopState;
Result:=etCloseArray;
end;
else
Result:=DefaultFetch(tk);
if Result=etValue then fState:=stArrayNext;
end;
until done;
end;
stError:
Result:=etError;
end;
if Result=etError then
fState:=stError;
CurEntity:=Result;
end;
constructor TPBXParser.Create;
begin
inherited Create;
scanner:=TPBXScanner.Create;
scanner.OnComment:=DoScanComment;
Reset;
end;
destructor TPBXParser.Destroy;
begin
scanner.Free;
inherited Destroy;
end;
{ TPBXScanner }
function TPBXScanner.GetCurColumn: Integer;
begin
Result:=0;
end;
procedure TPBXScanner.DoComment(const cmt: string);
begin
if Assigned(OnComment) then OnComment(Self, cmt);
end;
procedure TPBXScanner.SkipComment(const EndOfLine: Boolean);
var
cmt : string;
i : integer;
cnt : string;
begin
if EndOfLine then begin
cmt:=ScanTo(buf, idx, LineBreaks);
cnt:=trim(cmt);
end else begin
i:=PosEx('*/', buf, idx+2);
cnt:=trim(Copy(buf, idx+2, i-idx-2));
if i>0 then inc(i,2);
cmt:=Copy(buf, idx, i-idx);
inc(idx, length(cmt));
end;
DoComment(cnt);
end;
function TPBXScanner.DoFetchToken: TPBXToken;
begin
if idx>length(buf) then begin
Result:=tkEOF;
Exit;
end;
// skipping comments
while true do begin
ScanWhile(buf, idx, WhiteSpaceBreaks);
if (idx<length(buf)) and (buf[idx]='/') then begin
if (buf[idx+1]='*') then
SkipComment(false)
else if buf[idx+1]='/' then begin
SkipComment(true);
end else begin
Break;
end;
end else
Break;
end;
if idx>length(buf) then begin
Result:=tkEOF;
Exit;
end;
if buf[idx] in IdentName then begin
Result:=tkIdentifier;
FCurTokenString:=ScanWhile(buf, idx, IdentName);
end else
case buf[idx] of
'"': begin
inc(idx);
Result:=tkIdentifier;
FCurTokenString:=ScanTo(buf, idx, ['"']);
inc(idx);
end;
'=': begin
Result:= tkEqual;
FCurTokenString:=buf[idx];
inc(idx);
end;
'{': begin
Result:=tkCurlyBraceOpen;
FCurTokenString:=buf[idx];
inc(idx);
end;
'}': begin
Result:=tkCurlyBraceClose;
FCurTokenString:=buf[idx];
inc(idx);
end;
')': begin
Result:=tkRoundBraceClose;
FCurTokenString:=buf[idx];
inc(idx);
end;
'(': begin
Result:=tkRoundBraceOpen;
FCurTokenString:=buf[idx];
inc(idx);
end;
';': begin
Result:=tkSemiColon;
FCurTokenString:=buf[idx];
inc(idx);
end;
',': begin
Result:=tkComma;
FCurTokenString:=buf[idx];
inc(idx);
end;
else
Result:= tkUnknown;
FCurTokenString:=buf[idx];
inc(idx);
end;
end;
procedure TPBXScanner.SetBuf(const abuf: string);
begin
buf:=abuf;
idx:=1;
end;
function TPBXScanner.FetchToken: TPBXToken;
begin
Result:=DoFetchToken;
FCurToken:=Result;
end;
procedure ScanAString(const test: string);
var
sc : TPBXScanner;
begin
sc := TPBXScanner.Create;
try
sc.SetBuf(test);
while sc.FetchToken<>tkEOF do begin
if sc.CurToken=tkUnknown then begin
writeln(sc.CurToken:20,' ', IntToHex( byte(sc.CurTokenString[1]), 2 ) );
writeln('idx = ', sc.idx);
end else
;
//writeln(sc.CurToken:20,' ', sc.CurTokenString);
end;
finally
sc.Free;
end;
end;
procedure ParseAString(const test: string);
var
pr : TPBXParser;
et : TPBXEntity;
begin
pr := TPBXParser.Create;
try
pr.scanner.SetBuf(test);
et:=pr.FetchNextEntity;
while et <> etEOF do begin
if pr.Name<>'' then write('"',pr.Name,'":');
case et of
etValue: writeln('"',pr.Value,'",');
etCloseObject: writeln('},');
etOpenObject: writeln('{');
etOpenArray: writeln('[');
etCloseArray: writeln('],');
else
writeln(et);
end;
if et = etError then Break;
//writeln(pr.fState);
et:=pr.FetchNextEntity;
end;
finally
pr.Free;
end;
end;
function PBXParserSkipLevel(p: TPBXParser): Boolean;
var
lvl : Integer;
tk : TPBXEntity;
begin
if not Assigned(p) then Exit;
lvl:=p.Level;
while (p.Level>=lvl) do begin
tk:=p.FetchNextEntity;
if tk=etError then begin
Result:=false;
Exit;
end;
end;
Result:=true;
end;
end.

74
components/iphonelazext/pbx/test/pbxreader.lpi Normal file
View File

@ -0,0 +1,74 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="pbxreader"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<Units Count="1">
<Unit0>
<Filename Value="pbxreader.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="pbxreader"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value=".."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<TargetCPU Value="i386"/>
</CodeGeneration>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

273
components/iphonelazext/pbx/test/pbxreader.lpr Normal file
View File

@ -0,0 +1,273 @@
program pbxreader;
{$mode delphi}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
heaptrc,
Classes, SysUtils, pbxfile, pbxcontainer, xcodeproj
{ you can add units after this };
function ReadFileToString(const fn: string): string;
var
fs : TFileStream;
begin
fs:=TFileStream.Create(fn, fmOpenRead or fmShareDenyNone);
try
SetLength(Result, fs.Size);
fs.Read(Result[1], fs.Size);
finally
fs.Free;
end;
end;
procedure WriteStringToFile(const s, fn: string);
var
fs : TFileStream;
begin
fs:=TFileStream.Create(fn, fmCreate);
try
if length(s)>0 then begin
fs.Write(s[1], length(s));
fs.Size:=length(s);
end;
finally
fs.Free;
end;
end;
procedure TestProject(const buf: string);
var
c : TPBXContainer;
st : TStringStream;
info : TPBXFileInfo;
prj : PBXProject;
i : Integer;
begin
c:= TPBXContainer.Create;
st := TStringStream.Create(buf);
try
c.ReadFile(st, info);
writeln('arch ver: ',info.archiveVersion);
writeln(' obj ver: ',info.objectVersion);
writeln('root obj: ', PtrUInt( info.rootObject ));
if info.rootObject is PBXProject then begin
writeln('project!');
prj:=PBXProject(info.rootObject);
writeln(prj.knownRegions.Text);
writeln('targets: ', prj.targets.Count );
for i:=0 to prj.targets.Count-1 do begin
writeln(prj.targets.Items[i].ClassName);
writeln(PBXNativeTarget(prj.targets.Items[i]).name);
end;
writeln(PtrUInt(prj.buildConfigurationList));
writeln('build configuration:');
for i:=0 to prj.buildConfigurationList.buildConfigurations.Count-1 do begin
writeln(' ',XCBuildConfiguration(prj.buildConfigurationList.buildConfigurations[i]).name);
end;
end;
finally
st.Free;
c.Free;
end;
end;
type
{ MyClass }
MyClass = class(TObject)
private
fInt: Integer;
fInt2: Integer;
fInt3: Integer;
fRO: TList;
fRW: TList;
protected
function GetInt3: Integer;
procedure SetInt3(AValue: Integer);
function GetInt2: Integer;
public
constructor Create;
published
property Int: Integer read fInt write fInt;
property Int2: Integer read GetInt2 write fInt2;
property Int3: Integer read GetInt3 write SetInt3;
property RO: TList read fRO;
property RW: TList read fRW write fRW;
end;
var
lst : TList;
m : MyClass;
{ MyClass }
function MyClass.GetInt3: Integer;
begin
Result:=fInt3;
end;
procedure MyClass.SetInt3(AValue: Integer);
begin
fInt3:=AValue;
end;
function MyClass.GetInt2: Integer;
begin
Result:=fInt2;
end;
constructor MyClass.Create;
begin
fRO:=TList.Create;
fRW:=TList.Create;
end;
procedure TestRTTI;
var
lst : TList;
m : MyClass;
begin
lst:=TList.Create;
m:=MyClass.Create;
PBXGatherObjects(m, lst);
end;
procedure TestWriter;
var
w : TPBXWriter;
begin
w := TPBXWriter.Create;
try
w.OpenBlock('{');
w.WriteName('archiveVersion');
w.WriteValue('1');
w.WriteName('classes');
w.OpenBlock('{');
w.CloseBlock('}');
w.WriteName('objectVersion');
w.WriteValue('46');
w.WriteName('objects');
w.OpenBlock('{');
w.CloseBlock('}');
w.WriteName('rootObject');
w.WriteValue('aaaa','Project object');
w.CloseBlock('}');
write(w.Buffer);
finally
w.Free;
end;
end;
procedure TestReadThenWrite;
var
prj : PBXProject;
list : TList;
i : Integer;
st : TStringList;
begin
if ParamCount=0 then begin
writeln('please provide pbx file');
Exit;
end;
//ScanAString( ReadFileToString(ParamStr(1)));
//ParseAString( ReadFileToString(ParamStr(1)));
//TestProject( ReadFileToString(ParamStr(1)));
if LoadProjectFromFile(ParamStr(1), prj) then begin
//list:=TList.Create;
//PBXGatherObjects(prj, list);
Write(ProjectWrite(prj));
prj.Free;
{st:=TStringList.Create;
try
for i:=0 to list.Count-1 do begin
st.AddObject( PBXObject(list[i]).ClassName, PBXObject(list[i]));
end;
st.Sort;
for i:=0 to st.Count-1 do begin
writeln(PBXObject(st.Objects[i]).__id,' : ',PBXObject(st.Objects[i]).ClassName);
end;
finally
st.Free;
end;}
//list.Free;
end else
writeln('not a project');
end;
procedure TestWriteAProject;
var
p : PBXProject;
s : string;
t : PBXNativeTarget;
prd : PBXGroup;
//cfg : XCBuildConfiguration;
ph : PBXShellScriptBuildPhase;
begin
p:=CreateMinProject;
p.buildConfigurationList._headerComment:=p.buildConfigurationList._headerComment+' for PBXProject "test"';
p.attributes.AddStr('LastUpgradeCheck','0610');
t:=ProjectAddTarget(p,'targetto');
ph:=TargetAddRunScript(t);
ph.shellScript:='echo "hello world"';
//ph.buildActionMask:='0';
ph.runOnlyForDeploymentPostprocessing:='0';
t.productReference:=CreateFileRef('targetto', FILETYPE_EXEC);
PBXFileReference(t.productReference).sourceTree:='BUILT_PRODUCTS_DIR';
t.productName:='targetto';
t.productType:=PRODTYPE_TOOL;
// at least one configuration is added !
//todo: a target should automatically copy project's building settings
t.buildConfigurationList:=XCConfigurationList.Create;
t.buildConfigurationList._headerComment:='Build configuration list for PBXNativeTarget "targetto"';
t.buildConfigurationList.addConfig('Default').buildSettings.AddStr('PRODUCT_NAME','targetto');
t.buildConfigurationList.addConfig('Release').buildSettings.AddStr('PRODUCT_NAME','targetto');
t.buildConfigurationList.defaultConfigurationIsVisible:='0';
t.buildConfigurationList.defaultConfigurationName:='Release';
{ cfg:=XCBuildConfiguration(p.buildConfigurationList.buildConfigurations[0]);
cfg.buildSettings.AddStr('COPY_PHASE_STRIP', 'NO');
cfg.buildSettings.AddStr('GCC_DYNAMIC_NO_PIC', 'NO');
cfg.buildSettings.AddStr('GCC_OPTIMIZATION_LEVEL', '0');
cfg.buildSettings.AddStr('PRODUCT_NAME', 'targetto'); }
p.mainGroup:=CreateRootGroup('/Users/dmitry/pbx/utils/test.xcodeproj');
// requirements ?
prd:=p.mainGroup.addSubGroup('Products');
prd.children.Add(t.productReference);
p.productRefGroup:=prd;
p.compatibilityVersion:='Xcode 3.2';
s:=ProjectWrite(p);
WriteStringToFile(s, 'test.xcodeproj/project.pbxproj');
p.Free;
end;
begin
if FileExists('leaks.txt') then DeleteFile('leaks.txt');
SetHeapTraceOutput('leaks.txt');
try
TestReadThenWrite;
except
on e: exception do
writeln(e.Message);
end;
end.

577
components/iphonelazext/pbx/xcodeproj.pas Normal file
View File

@ -0,0 +1,577 @@
unit xcodeproj;
{--------------------------------------------------------------------------------
* by Dmitry Boyarintsev - Oct 2014 *
* *
* license: free for use, but please leave a note to the origin of the library *
* *
* PBXcontainer unit is a library to read/write the pbx formatter file as a *
* whole The file structure is made to keep the reference in a complex objects *
* *
* Memory Management. *
* Cocoa is reference - counted library, thus the usage of an object *
* controlled natively by ref counting. *
* A bit trickier for pascal *
* Following rules are applied *
* * read-only property objects are freed by the host (obviously) *
* * other "freeing" operations are noted at "mmgr" comments *
* * any objects within key-value tables are freed *
* Alternative solution - implement ref counting! *
* *
--------------------------------------------------------------------------------}
interface
uses
Classes, SysUtils,
typinfo, pbxcontainer;
type
{ XCBuildConfiguration }
XCBuildConfiguration = class(PBXObject)
private
fname : string;
fbuildSettings: TPBXKeyValue;
public
constructor Create; override;
destructor Destroy; override;
published
property buildSettings : TPBXKeyValue read fbuildSettings;
property name: string read fname write fname;
end;
{ XCConfigurationList }
// mmgr: XCConfigurationList frees
// * content of buildConfigurations
XCConfigurationList = class(PBXObject)
private
fdefaultConfigurationIsVisible: string;
fdefaultConfigurationName: string;
fbuildConfigurations: TPBXObjectsList;
public
constructor Create; override;
destructor Destroy; override;
function addConfig(const aname: string): XCBuildConfiguration;
published
property buildConfigurations: TPBXObjectsList read fbuildConfigurations;
property defaultConfigurationIsVisible: string read fdefaultConfigurationIsVisible write fdefaultConfigurationIsVisible;
property defaultConfigurationName: string read fdefaultConfigurationName write fdefaultConfigurationName;
end;
{ PBXContainerItemProxy }
PBXContainerItemProxy = class(PBXObject)
private
FcontainerPortal : PBXObject;
fproxyType : string;
fremoteGlobalIDString: string;
fremoteInfo: string;
published
property containerPortal: PBXObject read fcontainerPortal write fcontainerPortal; // Object = 0AFA6EA519F60EFD004C8FD9 /* Project object */;
property proxyType: string read FproxyType write fproxyType;
property remoteGlobalIDString: string read fremoteGlobalIDString write fremoteGlobalIDString; //object = 0AFA6EAC19F60EFD004C8FD9;
property remoteInfo : string read fremoteInfo write fremoteInfo; // ttestGame;
end;
{ PBXFileReference }
PBXFileReference = class(PBXObject)
private
FexplicitFileType: string;
FincludeInIndex: string;
FlastKnownFileType: string;
Fname: string;
Fpath: string;
FsourceTree: string;
published
property explicitFileType: string read FexplicitFileType write FexplicitFileType;
property includeInIndex: string read FincludeInIndex write FincludeInIndex;
property lastKnownFileType: string read flastKnownFileType write flastKnownFileType;
property name: string read Fname write Fname;
property path: string read Fpath write Fpath;
property sourceTree: string read FsourceTree write FsourceTree;
end;
{ PBXBuildFile }
PBXBuildFile = class(PBXObject)
private
fFileRef : PBXFileReference;
published
property fileRef : PBXFileReference read ffileRef write ffileRef; // obj
end;
{ PBXBuildPhase }
// mmgr: on free
// * content of files
PBXBuildPhase = class(PBXObject)
private
fbuildActionMask : Integer;
ffiles: TPBXObjectsList;
frunOnlyForDeploymentPostprocessing: string;
fname: string;
public
constructor Create; override;
destructor Destroy; override;
published
property buildActionMask: Integer read fbuildActionMask write fbuildActionMask;
property files: TPBXObjectsList read ffiles;
property name: string read fname write fname;
property runOnlyForDeploymentPostprocessing: string read frunOnlyForDeploymentPostprocessing write frunOnlyForDeploymentPostprocessing;
end;
{ PBXFrameworksBuildPhase }
PBXFrameworksBuildPhase = class(PBXBuildPhase);
PBXResourcesBuildPhase = class(PBXBuildPhase);
PBXSourcesBuildPhase = class(PBXBuildPhase);
{ PBXShellScriptBuildPhase }
PBXShellScriptBuildPhase = class(PBXBuildPhase)
private
finputPaths: TPBXStringArray;
foutputPaths: TPBXStringArray;
fshellpath: string;
fshellScript: string;
public
constructor Create; override;
destructor Destroy; override;
published
property inputPaths: TPBXStringArray read finputPaths;
property outputPaths: TPBXStringArray read foutputPaths;
property shellPath: string read fshellpath write fshellPath;
property shellScript: string read fshellScript write fshellScript;
end;
{ PBXGroup }
// mmgt: PBXGroup owns children object (PBXGroup and PBXFileRefernece)
// and would free then on release;
// note, that PBXFileReference objects might be used in other places
PBXGroup = class(PBXObject)
private
fsourceTree : string;
fchildren: TPBXObjectsList;
fname: string;
fpath: string;
public
constructor Create; override;
destructor Destroy; override;
function addSubGroup(const aname: string): PBXGroup;
published
property children: TPBXObjectsList read fchildren;
property name: string read fname write fname;
property path: string read fpath write fpath;
property sourceTree: string read fsourceTree write fsourceTree;
end;
PBXVariantGroup = class(PBXGroup);
{ PBXNativeTarget }
// mmgr: PBXNativeTarget
// * buildConfigurationList
// * contents of buildPhases
// * contents of buildRules
// * content of dependencies
PBXNativeTarget = class(PBXObject)
private
fbuildConfigurationList: XCConfigurationList;
fname : string;
fproductName : string;
fproductReference : PBXObject;
fproductType : string;
fbuildPhases : TPBXObjectsList;
fbuildRules : TPBXObjectsList;
fdependencies : TPBXObjectsList;
public
constructor Create; override;
destructor Destroy; override;
published
property buildConfigurationList : XCConfigurationList read fbuildConfigurationList write fbuildConfigurationList; //= 0AFA6ED419F60F01004C8FD9 /* Build configuration list for PBXNativeTarget "ttestGame" */;
property buildPhases: TPBXObjectsList read fbuildPhases;
property buildRules: TPBXObjectsList read fbuildRules;
property dependencies: TPBXObjectsList read fdependencies;
property name: string read fname write fname;
property productName: string read fproductName write fproductName; // = ttestGame;
property productReference: PBXObject read fproductReference write fproductReference; // = 0AFA6EAD19F60EFE004C8FD9 /* ttestGame.app */;
property productType: string read fproductType write fproductType; // = "com.apple.product-type.application";
end;
{ PBXTargetDependency }
// mmgt:
// targetProxy - is freed
PBXTargetDependency = class(PBXObject)
private
ftargetProxy: PBXContainerItemProxy;
ftarget: PBXNativeTarget;
public
destructor Destroy; override;
published
property target : PBXNativeTarget read ftarget write ftarget;
property targetProxy: PBXContainerItemProxy read ftargetProxy write ftargetProxy; {* PBXContainerItemProxy *}
end;
{ PBXProject }
// mmgt: PBXProject frees the following property objects, if assigned:
// * mainGroup
// * buildConfigurationList
// * contents of targets
PBXProject = class(PBXObject)
private
fattributes : TPBXKeyValue;
fcompatibilityVersion : string;
fdevelopmentRegion : string;
fhasScannedForEncodings: string;
fmainGroup: PBXGroup;
fknownRegions: TPBXStringArray;
fproductRefGroup: PBXGroup;
fprojectDirPath: string;
fprojectRoot : string;
ftargets: TPBXObjectsList;
fbuildConfigurationList: XCConfigurationList;
protected
class procedure _WriteEmpty(propnames: TStrings); override;
public
constructor Create; override;
destructor Destroy; override;
function addTarget(const aname: string): PBXNativeTarget;
published
property attributes: TPBXKeyValue read fattributes;
property buildConfigurationList: XCConfigurationList read fbuildConfigurationList write fbuildConfigurationList;
property compatibilityVersion: string read fcompatibilityVersion write fcompatibilityVersion;
property developmentRegion: string read fdevelopmentRegion write fdevelopmentRegion;
property hasScannedForEncodings: string read fhasScannedForEncodings write fhasScannedForEncodings;
property knownRegions: TPBXStringArray read fknownRegions;
property mainGroup: PBXGroup read fmainGroup write fmainGroup;
property productRefGroup: PBXGroup read fproductRefGroup write fproductRefGroup;
property projectDirPath: string read fprojectDirPath write fprojectDirPath;
property projectRoot: string read fprojectRoot write fprojectRoot;
property targets: TPBXObjectsList read ftargets;
end;
function LoadProjectFromStream(st: TStream; var prj: PBXProject): Boolean;
function LoadProjectFromFile(const fn: string; var prj: PBXProject): Boolean;
function ProjectWrite(prj: PBXProject): string;
function CreateMinProject: PBXProject;
function ProjectAddTarget(prj: PBXProject; const ATargetName: string): PBXNativeTarget;
const
SCRIPT_RUNPATH = '/bin/sh';
SCRIPT_DEFAULT = '';
SCRIPT_DEFNAME = 'Run Script';
function TargetAddRunScript(atarget: PBXNativeTarget): PBXShellScriptBuildPhase;
const
//FILETYPE_SCRIPT = 'text.script.sh';
FILETYPE_EXEC = 'compiled.mach-o.executable';
FILETYPE_MACHO = FILETYPE_EXEC;
function CreateFileRef(const afilename: string; const filetype: string = ''): PBXFileReference;
const
GROUPSRC_ABSOLUTE = '<absolute>';
GROUPSRC_GROUP = '<group>';
function CreateGroup(const aname: string; const srcTree: string = GROUPSRC_GROUP): PBXGroup;
//todo: need a rountine to update the path whenever the project is saved
function CreateRootGroup(const projectfolder: string): PBXGroup;
const
PRODTYPE_TOOL = 'com.apple.product-type.tool';
//
// PBXSourcesBuildPhase (sources) - is part of a PBXNativeTarget
// PBXNativeTarget - is part of Target
// PBXNativeTarget
//buildPhases = (
//0AA67B651A04929900CF0DD7 /* Sources */,
//0AA67B661A04929900CF0DD7 /* Frameworks */,
//0AA67B671A04929900CF0DD7 /* CopyFiles */,
//);
implementation
{ PBXTargetDependency }
destructor PBXTargetDependency.Destroy;
begin
ftargetProxy.Free;
inherited Destroy;
end;
{ PBXShellScriptBuildPhase }
constructor PBXShellScriptBuildPhase.Create;
begin
inherited Create;
finputPaths:=TPBXStringArray.Create;
foutputPaths:=TPBXStringArray.Create;
end;
destructor PBXShellScriptBuildPhase.Destroy;
begin
finputPaths.Free;
foutputPaths.Free;
inherited Destroy;
end;
{ PBXNativeTarget }
constructor PBXNativeTarget.Create;
begin
inherited Create;
fbuildPhases := TPBXObjectsList.Create(true);
fdependencies := TPBXObjectsList.Create(true);
fbuildRules := TPBXObjectsList.Create(true);
end;
destructor PBXNativeTarget.Destroy;
begin
fbuildConfigurationList.Free;
fbuildRules.Free;
fbuildPhases.Free;
fdependencies.Free;
inherited Destroy;
end;
{ PBXProject }
class procedure PBXProject._WriteEmpty(propnames: TStrings);
begin
propnames.Add('projectDirPath');
propnames.Add('projectRoot');
end;
constructor PBXProject.Create;
begin
inherited Create;
ftargets:=TPBXObjectsList.create(true);
fknownRegions:=TPBXStringArray.Create;
fattributes:=TPBXKeyValue.Create(true);
end;
destructor PBXProject.Destroy;
begin
fattributes.Free;
fknownRegions.Free;
ftargets.Free;
fmainGroup.Free;
fbuildConfigurationList.Free;
inherited Destroy;
end;
function PBXProject.addTarget(const aname: string): PBXNativeTarget;
begin
Result:=PBXNativeTarget.Create;
targets.Add(Result);
Result._headerComment:=aname;
Result.name:=aname;
// productName?
// productReference - is a resulting file
end;
{ XCConfigurationList }
constructor XCConfigurationList.Create;
begin
inherited Create;
fbuildConfigurations:=TPBXObjectsList.Create(true);
end;
destructor XCConfigurationList.Destroy;
begin
fbuildConfigurations.Free;
inherited Destroy;
end;
function XCConfigurationList.AddConfig(const aname: string): XCBuildConfiguration;
begin
Result:=XCBuildConfiguration.Create;
Result.name:=aname;
Result._headerComment:=aname;
fbuildConfigurations.Add(Result);
end;
{ XCBuildConfiguration }
constructor XCBuildConfiguration.Create;
begin
inherited Create;
fbuildSettings:=TPBXKeyValue.Create(true);
end;
destructor XCBuildConfiguration.Destroy;
begin
fbuildSettings.Free;
inherited Destroy;
end;
{ PBXGroup }
constructor PBXGroup.Create;
begin
inherited Create;
fchildren:=TPBXObjectsList.Create(true);
end;
destructor PBXGroup.Destroy;
begin
fchildren.Free;
inherited Destroy;
end;
function PBXGroup.addSubGroup(const aname: string): PBXGroup;
begin
Result:=PBXGroup.Create;
fchildren.Add(Result);
Result.name:=aname;
Result._headerComment:=aname;
Result.sourceTree:=GROUPSRC_GROUP;
end;
{ PBXBuildPhase }
constructor PBXBuildPhase.Create;
begin
inherited Create;
ffiles:=TPBXObjectsList.Create(true);
end;
destructor PBXBuildPhase.Destroy;
begin
ffiles.Free;
end;
function LoadProjectFromStream(st: TStream; var prj: PBXProject): Boolean;
var
c : TPBXContainer;
info : TPBXFileInfo;
begin
prj:=nil;
c:= TPBXContainer.Create;
try
Result:=c.ReadFile(st, info);
if Result then begin
if not (info.rootObject is PBXProject) then begin
info.rootObject.Free;
end else begin
prj:=PBXProject(info.rootObject);
end;
end
finally
c.Free;
end;
end;
function LoadProjectFromFile(const fn: string; var prj: PBXProject): Boolean;
var
fs :TFileStream;
begin
fs:=TFileStream.Create(fn, fmOpenRead or fmShareDenyNone);
try
Result:=LoadProjectFromStream(fs, prj);
finally
fs.Free;
end;
end;
function ProjectWrite(prj: PBXProject): string;
var
info : TPBXFileInfo;
begin
info.archiveVersion:='1';
info.objectVersion:='46';
info.rootObject:=prj;
Result:=PBXWriteContainer(info);
end;
function CreateMinProject: PBXProject;
var
p : PBXProject;
cfg : XCBuildConfiguration;
begin
// requirements:
// * at least one build configuration
p := PBXProject.Create;
p._headerComment:='Project object';
p.buildConfigurationList:=XCConfigurationList.Create;
p.buildConfigurationList._headerComment:='Build configuration list';
p.buildConfigurationList.defaultConfigurationIsVisible:='0';
cfg:=p.buildConfigurationList.addConfig('Default');
cfg:=p.buildConfigurationList.addConfig('Release');
// default name must be present
p.buildConfigurationList.defaultConfigurationName:='Release';
Result:=p;
end;
function ProjectAddTarget(prj: PBXProject; const ATargetName: string): PBXNativeTarget;
begin
Result:=nil;
if not Assigned(prj) then Exit;
Result:=prj.addTarget(ATargetName);
end;
function TargetAddRunScript(atarget: PBXNativeTarget): PBXShellScriptBuildPhase;
begin
Result:=PBXShellScriptBuildPhase.Create;
Result.name:=SCRIPT_DEFNAME;
Result._headerComment:=SCRIPT_DEFNAME;
Result.shellScript:=SCRIPT_DEFAULT;
Result.shellPath:=SCRIPT_RUNPATH;
atarget.buildPhases.Add(Result);
end;
function CreateFileRef(const afilename: string; const filetype: string ): PBXFileReference;
begin
Result:=PBXFileReference.Create;
Result.path:=afilename;
Result._headerComment:=afilename;
Result.explicitFileType:=FILETYPE_EXEC;
end;
function CreateGroup(const aname, srcTree: string): PBXGroup;
begin
Result:=PBXGroup.Create;
Result.name:=aname;
Result.sourceTree:=srcTree;
Result._headerComment:=aname;
end;
function CreateRootGroup(const projectfolder: string): PBXGroup;
begin
Result:=CreateGroup('', GROUPSRC_ABSOLUTE);
Result.path:=projectfolder;
Result._headerComment:=projectfolder;
end;
initialization
PBXRegisterClass(PBXBuildFile);
PBXRegisterClass(PBXContainerItemProxy);
PBXRegisterClass(PBXFileReference);
PBXRegisterClass(PBXFrameworksBuildPhase);
PBXRegisterClass(PBXGroup);
PBXRegisterClass(PBXNativeTarget);
PBXRegisterClass(PBXProject);
PBXRegisterClass(PBXResourcesBuildPhase);
PBXRegisterClass(PBXSourcesBuildPhase);
PBXRegisterClass(PBXTargetDependency);
PBXRegisterClass(PBXVariantGroup);
PBXRegisterClass(XCBuildConfiguration);
PBXRegisterClass(XCConfigurationList);
end.