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

iphonelazext: implemented xibfile actions/outlets dumping

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1219 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2010-05-06 08:42:28 +00:00
parent ed5c714eec
commit 162d9c868b
8 changed files with 334 additions and 46 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/iphonelazext/ideext.pas
View File

@ -147,8 +147,6 @@ begin
finally
xiblist.free;
end;
//todo: compile .xib files to .nibs
end;
function FindParam(const Source, ParamKey: String; var idx: Integer; var Content: String): Boolean;

6
components/iphonelazext/iphonelazext.lpk
View File

@ -18,7 +18,7 @@
<Description Value="iPhone Development Lazarus extension"/>
<License Value="LGPL"/>
<Version Minor="6"/>
<Files Count="13">
<Files Count="14">
<Item1>
<Filename Value="ideext.pas"/>
<HasRegisterProc Value="True"/>
@ -72,6 +72,10 @@
<Filename Value="newxibdialog.pas"/>
<UnitName Value="newxibdialog"/>
</Item13>
<Item14>
<Filename Value="xibfile.pas"/>
<UnitName Value="xibfile"/>
</Item14>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="3">

3
components/iphonelazext/iphonelazext.pas
View File

@ -9,7 +9,8 @@ interface
uses
ideext, iPhoneExtStr, iPhoneBundle, XCodeProject,
environment_iphone_options, project_iphone_options, iPhoneExtOptions,
xcodetemplate, LazFilesUtils, XcodeUtils, newXibDialog, LazarusPackageIntf;
xcodetemplate, LazFilesUtils, XcodeUtils, newXibDialog, xibfile,
LazarusPackageIntf;
implementation

4
components/iphonelazext/newxibdialog.lfm
View File

@ -1,7 +1,7 @@
object newXibForm: TnewXibForm
Left = 583
Left = 462
Height = 447
Top = 195
Top = 164
Width = 477
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog

13
components/iphonelazext/project_iphone_options.lfm
View File

@ -4,8 +4,9 @@ inherited iPhoneProjectOptionsEditor: TiPhoneProjectOptionsEditor
ClientHeight = 474
ClientWidth = 620
OnClick = FrameClick
DesignLeft = 463
DesignTop = 306
TabOrder = 0
DesignLeft = 513
DesignTop = 97
object chkisPhone: TCheckBox[0]
Left = 16
Height = 18
@ -180,11 +181,15 @@ inherited iPhoneProjectOptionsEditor: TiPhoneProjectOptionsEditor
end
object nibsPopup: TPopupMenu[17]
OnPopup = nibsPopupPopup
left = 256
top = 288
left = 160
top = 272
object mnuOpenIB: TMenuItem
Caption = 'Open Interface Builder'
OnClick = mnuOpenIBClick
end
object mnuDump: TMenuItem
Caption = 'Dump classes to Pascal'
OnClick = mnuDumpClick
end
end
end

41
components/iphonelazext/project_iphone_options.lrs
View File

@ -3,23 +3,23 @@
LazarusResources.Add('TiPhoneProjectOptionsEditor','FORMDATA',[
'TPF0'#241#27'TiPhoneProjectOptionsEditor'#26'iPhoneProjectOptionsEditor'#6'H'
+'eight'#3#218#1#5'Width'#3'l'#2#12'ClientHeight'#3#218#1#11'ClientWidth'#3'l'
+#2#7'OnClick'#7#10'FrameClick'#10'DesignLeft'#3#207#1#9'DesignTop'#3'2'#1#0
+#242#2#0#9'TCheckBox'#10'chkisPhone'#4'Left'#2#16#6'Height'#2#18#3'Top'#2#16
+#5'Width'#3#199#0#7'Caption'#6#29'is iPhone application project'#8'OnChange'
+#7#16'chkisPhoneChange'#8'TabOrder'#2#0#0#0#242#2#1#6'TLabel'#8'lblAppID'#4
+'Left'#2#16#6'Height'#2#18#3'Top'#2'X'#5'Width'#2'W'#7'Caption'#6#14'Applica'
+'tion ID'#11'ParentColor'#8#0#0#242#2#2#5'TEdit'#8'edtAppID'#4'Left'#2'p'#6
+'Height'#2#22#3'Top'#2'U'#5'Width'#3#234#1#7'Anchors'#11#5'akTop'#6'akLeft'#7
+'akRight'#0#8'TabOrder'#2#1#4'Text'#6#19'com.mycompany.myapp'#0#0#242#2#3#6
+'TLabel'#12'lblAppIDHint'#4'Left'#2#16#6'Height'#2#14#3'Top'#2'u'#5'Width'#3
+#237#1#7'Caption'#6'_It''s recommended by Apple to use domain-structured nam'
+'e, i.e. com.mycompany.myApplication as ID'#11'Font.Height'#2#246#11'ParentC'
+'olor'#8#10'ParentFont'#8#0#0#242#2#4#6'TLabel'#9'lblSDKVer'#4'Left'#2#16#6
+'Height'#2#18#3'Top'#2'3'#5'Width'#2'P'#7'Caption'#6#12'SDK version:'#11'Par'
+'entColor'#8#0#0#242#2#5#9'TComboBox'#7'cmbSDKs'#4'Left'#2'p'#6'Height'#2#20
+#3'Top'#2'0'#5'Width'#3#184#0#10'ItemHeight'#2#0#8'OnChange'#7#13'cmbSDKsCha'
+'nge'#5'Style'#7#14'csDropDownList'#8'TabOrder'#2#2#0#0#242#2#6#5'TEdit'#9'e'
+'dtResDir'#23'AnchorSideRight.Control'#7#15'btnShowInFinder'#4'Left'#2'x'#6
+#2#7'OnClick'#7#10'FrameClick'#8'TabOrder'#2#0#10'DesignLeft'#3#1#2#9'Design'
+'Top'#2'a'#0#242#2#0#9'TCheckBox'#10'chkisPhone'#4'Left'#2#16#6'Height'#2#18
+#3'Top'#2#16#5'Width'#3#199#0#7'Caption'#6#29'is iPhone application project'
+#8'OnChange'#7#16'chkisPhoneChange'#8'TabOrder'#2#0#0#0#242#2#1#6'TLabel'#8
+'lblAppID'#4'Left'#2#16#6'Height'#2#18#3'Top'#2'X'#5'Width'#2'W'#7'Caption'#6
+#14'Application ID'#11'ParentColor'#8#0#0#242#2#2#5'TEdit'#8'edtAppID'#4'Lef'
+'t'#2'p'#6'Height'#2#22#3'Top'#2'U'#5'Width'#3#234#1#7'Anchors'#11#5'akTop'#6
+'akLeft'#7'akRight'#0#8'TabOrder'#2#1#4'Text'#6#19'com.mycompany.myapp'#0#0
+#242#2#3#6'TLabel'#12'lblAppIDHint'#4'Left'#2#16#6'Height'#2#14#3'Top'#2'u'#5
+'Width'#3#237#1#7'Caption'#6'_It''s recommended by Apple to use domain-struc'
+'tured name, i.e. com.mycompany.myApplication as ID'#11'Font.Height'#2#246#11
+'ParentColor'#8#10'ParentFont'#8#0#0#242#2#4#6'TLabel'#9'lblSDKVer'#4'Left'#2
+#16#6'Height'#2#18#3'Top'#2'3'#5'Width'#2'P'#7'Caption'#6#12'SDK version:'#11
+'ParentColor'#8#0#0#242#2#5#9'TComboBox'#7'cmbSDKs'#4'Left'#2'p'#6'Height'#2
+#20#3'Top'#2'0'#5'Width'#3#184#0#10'ItemHeight'#2#0#8'OnChange'#7#13'cmbSDKs'
+'Change'#5'Style'#7#14'csDropDownList'#8'TabOrder'#2#2#0#0#242#2#6#5'TEdit'#9
+'edtResDir'#23'AnchorSideRight.Control'#7#15'btnShowInFinder'#4'Left'#2'x'#6
+'Height'#2#22#3'Top'#3#174#0#5'Width'#3'c'#1#7'Anchors'#11#5'akTop'#6'akLeft'
+#7'akRight'#0#19'BorderSpacing.Right'#2#10#8'OnChange'#7#15'edtResDirChange'
+#6'OnExit'#7#13'edtResDirExit'#8'TabOrder'#2#3#4'Text'#6#9'Resources'#0#0#242
@ -54,7 +54,8 @@ LazarusResources.Add('TiPhoneProjectOptionsEditor','FORMDATA',[
+#14'btnAddXibClick'#8'TabOrder'#2#7#0#0#242#2#16#7'TButton'#12'btnRemoveXib'
+#4'Left'#2'('#6'Height'#2#20#3'Top'#3'8'#1#5'Width'#2'J'#8'AutoSize'#9#7'Cap'
+'tion'#6#6'Remove'#7'OnClick'#7#17'btnRemoveXibClick'#8'TabOrder'#2#8#0#0#242
+#2#17#10'TPopupMenu'#9'nibsPopup'#7'OnPopup'#7#14'nibsPopupPopup'#4'left'#3#0
+#1#3'top'#3' '#1#0#9'TMenuItem'#9'mnuOpenIB'#7'Caption'#6#22'Open Interface '
+'Builder'#7'OnClick'#7#14'mnuOpenIBClick'#0#0#0#0
+#2#17#10'TPopupMenu'#9'nibsPopup'#7'OnPopup'#7#14'nibsPopupPopup'#4'left'#3
+#160#0#3'top'#3#16#1#0#9'TMenuItem'#9'mnuOpenIB'#7'Caption'#6#22'Open Interf'
+'ace Builder'#7'OnClick'#7#14'mnuOpenIBClick'#0#0#9'TMenuItem'#7'mnuDump'#7
+'Caption'#6#22'Dump classes to Pascal'#7'OnClick'#7#12'mnuDumpClick'#0#0#0#0
]);

200
components/iphonelazext/project_iphone_options.pas
View File

@ -21,7 +21,7 @@ interface
uses
Classes,SysUtils,FileUtil,LResources,Forms,StdCtrls,CheckLst,Buttons, Dialogs,
Menus,IDEOptionsIntf,ProjectIntf,LazIDEIntf,iPhoneExtStr,
iPhoneExtOptions, Controls, LazFilesUtils, XcodeUtils, newXibDialog;
iPhoneExtOptions, Controls, LazFilesUtils, XcodeUtils, newXibDialog, xibfile;
type
@ -32,6 +32,7 @@ type
btnAddXib:TButton;
btnRemoveXib:TButton;
Label5:TLabel;
mnuDump:TMenuItem;
mnuOpenIB:TMenuItem;
nibFilesBox:TCheckListBox;
chkisPhone: TCheckBox;
@ -57,6 +58,7 @@ type
procedure edtResDirChange(Sender:TObject);
procedure edtResDirExit(Sender:TObject);
procedure FrameClick(Sender: TObject);
procedure mnuDumpClick(Sender:TObject);
procedure mnuOpenIBClick(Sender:TObject);
procedure nibFilesBoxClickCheck(Sender:TObject);
procedure nibFilesBoxItemClick(Sender:TObject;Index:integer);
@ -76,6 +78,7 @@ type
procedure RefreshXIBList;
procedure SetControlsEnabled(AEnabled: Boolean);
procedure DumpClasses(const XibFileName: AnsiString; var PascalFileName: AnsiString);
public
{ public declarations }
class function SupportedOptionsClass: TAbstractIDEOptionsClass; override;
@ -205,6 +208,25 @@ begin
end;
procedure TiPhoneProjectOptionsEditor.mnuDumpClick(Sender:TObject);
var
s : AnsiString;
pas : AnsiString;
p : TControl;
begin
if SelXibFile ='' then Exit;
s:=ChangeFileExt(IncludeTrailingPathDelimiter (edtResDir.Text) + SelXibFile,'.xib');
LazarusIDE.ActiveProject.LongenFilename(s);
DumpClasses(s, pas);
p:=Parent;
while Assigned(p) and (not (p is TForm)) do
p:=p.Parent;
if Assigned(p) then TForm(p).ModalResult:=mrOK;
LazarusIDE.DoOpenEditorFile(pas, -1,-1, [ofOnlyIfExists]);
end;
procedure TiPhoneProjectOptionsEditor.mnuOpenIBClick(Sender:TObject);
var
path : AnsiString;
@ -255,6 +277,7 @@ begin
mnuOpenIB.Caption:=Format(strOpenXibAtIB, [SelXibFile])
else
mnuOpenIB.Caption:=strOpenAtIB;
mnuDump.Enabled:=SelXibFile<>''
end;
procedure TiPhoneProjectOptionsEditor.DoChanged;
@ -290,6 +313,181 @@ begin
Controls[i].Enabled:=AEnabled;
end;
function MethodName(const msg: AnsiString): String;
var
i : Integer;
begin
Result:=msg;
for i:=0 to length(Result) do if Result[i]=':' then Result[i]:='_';
end;
function ActionParams(const ActionName: AnsiString): String;
var
i : integer;
c : Integer;
begin
c:=0;
for i:=1 to length(ActionName) do if ActionName[i]=':' then inc(c);
case c of
1 : Result:=('(sender: id)');
2 : Result:=('(sender: id; keyEvent: SEL)');
end;
end;
function SetMethodName(const propName: AnsiString): String;
begin
if propName<>'' then
Result:='set'+AnsiUpperCase(propName[1])+Copy(propName, 2, length(propName)-1)
else
Result:='';
end;
procedure XibClassToInterface(cls: TXibClassDescr; intf: TStrings);
var
i : Integer;
begin
if not Assigned(cls) or not Assigned(intf) then Exit;
intf.Add(' { ' +cls.Name + ' }');
intf.Add('');
intf.Add(' ' +cls.Name + '=objcclass(NSObject)');
if length(cls.Outlets)>0 then begin
intf.Add(' private');
for i:=0 to length(cls.Outlets) - 1 do
intf.Add(' f'+cls.Outlets[i].Key+' : '+ cls.Outlets[i].Value+';');
end;
intf.Add(' public');
for i:=0 to length(cls.Actions) - 1 do
with cls.Actions[i] do
intf.Add(Format(' function %s%s: %s; message ''%s'';', [MethodName(Key), ActionParams(Key), Value, Key]));
for i:=0 to length(cls.Outlets) - 1 do
with cls.Outlets[i] do begin
intf.Add(Format(' function %s: %s; message ''%s'';', [Key, Value, Key]));
intf.Add(Format(' procedure %s(a%s: %s); message ''%s'';',
[SetMethodName(Key), Key, Value, SetMethodName(Key)+':']));
end;
if length(cls.Outlets) > 0 then
intf.Add(' procedure dealloc; override;');
intf.Add(' end;');
intf.Add('');
end;
procedure XibClassToImplementation(cls: TXibClassDescr; st: TStrings);
var
i : Integer;
begin
if not Assigned(cls) or not Assigned(st) then Exit;
if (length(cls.Actions)=0) and (length(cls.Outlets)=0) then exit;
st.Add(' { ' +cls.Name + ' }');
st.Add('');
for i:=0 to length(cls.Actions)-1 do
with cls.Actions[i] do begin
st.Add(Format('function %s.%s%s: %s;', [cls.Name, MethodName(Key), ActionParams(Key), Value]));
st.Add('begin');
st.Add(' // put action''s code here');
st.Add(' Result:=nil;');
st.Add('end;');
st.Add('');
end;
for i:=0 to length(cls.Outlets) - 1 do
with cls.Outlets[i] do begin
st.Add(Format('function %s.%s: %s;', [cls.Name, Key, Value]));
st.Add( 'begin');
st.Add(Format(' Result:=f%s;', [Key]));
st.Add( 'end;');
st.Add( '');
st.Add(Format('procedure %s.%s(a%s: %s);', [cls.Name, SetMethodName(Key), Key, Value]));
st.Add( 'begin');
st.Add(Format(' f%s:=a%s;', [Key, Key]));
st.Add(Format(' f%s.retain;', [Key]));
st.Add( 'end;');
st.Add( '');
end;
if length(cls.Outlets)>0 then begin
st.Add(Format('procedure %s.dealloc; ', [cls.Name]));
st.Add( 'begin');
for i:=0 to length(cls.Outlets) - 1 do
st.Add(Format(' f%s.release;',[cls.Outlets[i].Key]));
st.Add( ' inherited;');
st.Add( 'end;');
st.Add('');
end;
end;
procedure TiPhoneProjectOptionsEditor.DumpClasses(const XibFileName: AnsiString;
var PascalFileName: AnsiString);
var
unitNm : AnsiString;
fs : TFileStream;
xibcls : TList;
i : Integer;
intfPart : TStringList;
implPart : TStringList;
cls : TXibClassDescr;
const
le : Ansistring = LineEnding;
procedure wln(const s: AnsiString);
begin
if s <>'' then
fs.Write(s[1], length(s));
fs.Write(le[1], length(le));
end;
begin
if not FileExists(XibFileName) then Exit;
intfPart:=TStringList.Create;
implPart:=TStringList.Create;
xibcls:=TList.Create;
ListClassesDescr(XibFileName, xibcls);
for i:=0 to xibcls.Count-1 do begin
cls:=TXibClassDescr(xibcls[i]);
XibClassToInterface(cls, intfPart);
XibClassToImplementation(cls, implPart);
cls.Free;
end;
xibcls.Free;
unitNm:='dump'+ChangeFileExt(ExtractFileName(XibFileName),'');
PascalFileName:=unitNm+'.pas';
LazarusIDE.ActiveProject.LongenFilename(PascalFileName);
fs:=TFileStream.Create(PascalFileName, fmCreate);
wln('unit ' + unitNm+';');
wln('');
wln('{$mode objfpc}{$h+}');
wln('{$modeswitch objectivec1}');
wln('');
wln('interface');
wln('');
if intfPart.Count>0 then begin
wln('type');
for i:=0 to intfPart.Count-1 do wln(intfPart[i]);
end;
wln('');
wln('implementation');
wln('');
if implPart.Count>0 then
for i:=0 to implPart.Count-1 do wln(implPart[i]);
wln('');
wln('end.');
intfPart.Free;
implPart.Free;
fs.Free;
end;
function TiPhoneProjectOptionsEditor.GetTitle: String;
begin
Result:=strPrjOptTitle;

111
components/iphonelazext/xibfile.pas
View File

@ -51,12 +51,60 @@ type
procedure DoReadXibDoc(ADoc: TXMLDocument; var Obj: TXibObject);
function FindXibObject(root: TXibObject; const ObjName: String; Recursive: Boolean=False): TXibObject;
procedure ListActionsAndOutlets(root: TXibObject;
actionsNames, actionsTypes: TStrings;
outletsNames, outletsTypes: TStrings);
type
TXibKeyValue = record
Key : AnsiString;
Value : AnsiString;
end;
{ TXibClassDescr }
TXibClassDescr = class(TObject)
Name : AnsiString;
Actions : array of TXibKeyValue;
Outlets : array of TXibKeyValue;
constructor Create(const AName: AnsiString);
end;
procedure ListClassesDescr(root: TXibObject; DstList : TList); overload;
procedure ListClassesDescr(const FileName: AnsiString; DstList : TList); overload;
implementation
function Min(a,b: integer): Integer;
begin
if a<b then Result:=a
else Result:=b;
end;
procedure SetActions(names, types: TStrings; descr: TXibClassDescr);
var
i : integer;
begin
if not Assigned(names) or not Assigned(types) then Exit;
SetLength(descr.Actions, Min(names.Count, types.Count));
for i:=0 to length(descr.Actions)- 1 do begin
descr.Actions[i].Key:=names[i];
descr.Actions[i].Value:=types[i];
end;
end;
procedure SetOutlets(names, types: TStrings; descr: TXibClassDescr);
var
i : integer;
begin
if not Assigned(names) or not Assigned(types) then Exit;
SetLength(descr.Outlets, Min(names.Count, types.Count));
for i:=0 to length(descr.Outlets)- 1 do begin
descr.Outlets[i].Key:=names[i];
descr.Outlets[i].Value:=types[i];
end;
end;
procedure ListDictionary(dict: TXibObject; keys, values: TStrings);
var
xibkeys : TXibObject;
@ -72,19 +120,22 @@ begin
end;
end;
procedure ListActionsAndOutlets(root: TXibObject;
actionsNames, actionsTypes: TStrings;
outletsNames, outletsTypes: TStrings);
procedure ListClassesDescr(root: TXibObject; DstList : TList);
var
obj : TXibObject;
act : TXibObject;
obj : TXibObject;
act : TXibObject;
outs : TXibObject;
cls : AnsiString;
cls : TXibClassDescr;
names : TStringList;
types : TStringList;
begin
if not Assigned(DstList) then Exit;
obj:=FindXibObject(root, 'IBDocument.Classes', true);
if not Assigned(obj) then Exit;
names := TStringList.Create;
types := TStringList.Create;
obj:=FindXibObject(obj, 'referencedPartialClassDescriptions', true);
obj:=obj.ChildObject;
@ -95,17 +146,26 @@ begin
Continue;
end;
cls:=obj.StrProp['className'];
cls:=TXibClassDescr.Create(obj.StrProp['className']);
act:=FindXibObject(obj, 'actions');
if Assigned(act) then ListDictionary(act, actionsNames, actionsTypes);
if Assigned(act) then begin
names.Clear; types.Clear;
ListDictionary(act, names, types);
SetActions(names, types, cls);
end;
outs:=FindXibObject(obj, 'outlets');
if Assigned(outs) then ListDictionary(outs, outletsNames, outletsTypes);
if Assigned(outs) then begin
names.Clear; types.Clear;
ListDictionary(outs, names, types);
SetOutlets(names, types, cls);
end;
DstList.Add(cls);
//todo: enum all classes in Xib file!
Break;
obj:=obj.NextObject;
end;
names.Free;
types.Free;
end;
function FindXibObject(root: TXibObject; const ObjName: String; Recursive: Boolean): TXibObject;
@ -296,5 +356,26 @@ begin
Result:=TDOMElement(fXibNode).AttribStrings['class'];
end;
procedure ListClassesDescr(const FileName: AnsiString; DstList : TList); overload;
var
xib : TXibFile;
begin
xib := TXibFile.Create;
try
xib.LoadFromFile(FileName);
ListClassesDescr(xib.FirstObject, DstList);
finally
xib.Free;
end;
end;
{ TXibClassDescr }
constructor TXibClassDescr.Create(const AName:AnsiString);
begin
inherited Create;
Name:=AName;
end;
end.