iphonelazext: implemented xibfile actions/outlets dumping

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1219 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/iphonelazext/ideext.pas

@@ -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;

components/iphonelazext/iphonelazext.lpk

@@ -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">

components/iphonelazext/iphonelazext.pas

@@ -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
 

components/iphonelazext/newxibdialog.lfm

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

components/iphonelazext/project_iphone_options.lfm

@@ -4,8 +4,9 @@ inherited iPhoneProjectOptionsEditor: TiPhoneProjectOptionsEditor
   ClientHeight = 474
   ClientWidth = 620
   OnClick = FrameClick
-  DesignLeft = 463
+  TabOrder = 0
-  DesignTop = 306
+  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
+    left = 160
-    top = 288
+    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

components/iphonelazext/project_iphone_options.lrs

@@ -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
+  +#2#7'OnClick'#7#10'FrameClick'#8'TabOrder'#2#0#10'DesignLeft'#3#1#2#9'Design'
-  +#242#2#0#9'TCheckBox'#10'chkisPhone'#4'Left'#2#16#6'Height'#2#18#3'Top'#2#16
+  +'Top'#2'a'#0#242#2#0#9'TCheckBox'#10'chkisPhone'#4'Left'#2#16#6'Height'#2#18
-  +#5'Width'#3#199#0#7'Caption'#6#29'is iPhone application project'#8'OnChange'
+  +#3'Top'#2#16#5'Width'#3#199#0#7'Caption'#6#29'is iPhone application project'
-  +#7#16'chkisPhoneChange'#8'TabOrder'#2#0#0#0#242#2#1#6'TLabel'#8'lblAppID'#4
+  +#8'OnChange'#7#16'chkisPhoneChange'#8'TabOrder'#2#0#0#0#242#2#1#6'TLabel'#8
-  +'Left'#2#16#6'Height'#2#18#3'Top'#2'X'#5'Width'#2'W'#7'Caption'#6#14'Applica'
+  +'lblAppID'#4'Left'#2#16#6'Height'#2#18#3'Top'#2'X'#5'Width'#2'W'#7'Caption'#6
-  +'tion ID'#11'ParentColor'#8#0#0#242#2#2#5'TEdit'#8'edtAppID'#4'Left'#2'p'#6
+  +#14'Application ID'#11'ParentColor'#8#0#0#242#2#2#5'TEdit'#8'edtAppID'#4'Lef'
-  +'Height'#2#22#3'Top'#2'U'#5'Width'#3#234#1#7'Anchors'#11#5'akTop'#6'akLeft'#7
+  +'t'#2'p'#6'Height'#2#22#3'Top'#2'U'#5'Width'#3#234#1#7'Anchors'#11#5'akTop'#6
-  +'akRight'#0#8'TabOrder'#2#1#4'Text'#6#19'com.mycompany.myapp'#0#0#242#2#3#6
+  +'akLeft'#7'akRight'#0#8'TabOrder'#2#1#4'Text'#6#19'com.mycompany.myapp'#0#0
-  +'TLabel'#12'lblAppIDHint'#4'Left'#2#16#6'Height'#2#14#3'Top'#2'u'#5'Width'#3
+  +#242#2#3#6'TLabel'#12'lblAppIDHint'#4'Left'#2#16#6'Height'#2#14#3'Top'#2'u'#5
-  +#237#1#7'Caption'#6'_It''s recommended by Apple to use domain-structured nam'
+  +'Width'#3#237#1#7'Caption'#6'_It''s recommended by Apple to use domain-struc'
-  +'e, i.e. com.mycompany.myApplication as ID'#11'Font.Height'#2#246#11'ParentC'
+  +'tured name, i.e. com.mycompany.myApplication as ID'#11'Font.Height'#2#246#11
-  +'olor'#8#10'ParentFont'#8#0#0#242#2#4#6'TLabel'#9'lblSDKVer'#4'Left'#2#16#6
+  +'ParentColor'#8#10'ParentFont'#8#0#0#242#2#4#6'TLabel'#9'lblSDKVer'#4'Left'#2
-  +'Height'#2#18#3'Top'#2'3'#5'Width'#2'P'#7'Caption'#6#12'SDK version:'#11'Par'
+  +#16#6'Height'#2#18#3'Top'#2'3'#5'Width'#2'P'#7'Caption'#6#12'SDK version:'#11
-  +'entColor'#8#0#0#242#2#5#9'TComboBox'#7'cmbSDKs'#4'Left'#2'p'#6'Height'#2#20
+  +'ParentColor'#8#0#0#242#2#5#9'TComboBox'#7'cmbSDKs'#4'Left'#2'p'#6'Height'#2
-  +#3'Top'#2'0'#5'Width'#3#184#0#10'ItemHeight'#2#0#8'OnChange'#7#13'cmbSDKsCha'
+  +#20#3'Top'#2'0'#5'Width'#3#184#0#10'ItemHeight'#2#0#8'OnChange'#7#13'cmbSDKs'
-  +'nge'#5'Style'#7#14'csDropDownList'#8'TabOrder'#2#2#0#0#242#2#6#5'TEdit'#9'e'
+  +'Change'#5'Style'#7#14'csDropDownList'#8'TabOrder'#2#2#0#0#242#2#6#5'TEdit'#9
-  +'dtResDir'#23'AnchorSideRight.Control'#7#15'btnShowInFinder'#4'Left'#2'x'#6
+  +'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
+  +#2#17#10'TPopupMenu'#9'nibsPopup'#7'OnPopup'#7#14'nibsPopupPopup'#4'left'#3
-  +#1#3'top'#3' '#1#0#9'TMenuItem'#9'mnuOpenIB'#7'Caption'#6#22'Open Interface '
+  +#160#0#3'top'#3#16#1#0#9'TMenuItem'#9'mnuOpenIB'#7'Caption'#6#22'Open Interf'
-  +'Builder'#7'OnClick'#7#14'mnuOpenIBClick'#0#0#0#0
+  +'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
 ]);

components/iphonelazext/project_iphone_options.pas

@@ -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;

components/iphonelazext/xibfile.pas

@@ -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;
+type
-  outletsNames, outletsTypes: TStrings);
+  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;
+procedure ListClassesDescr(root: TXibObject; DstList : TList);
-
-  actionsNames, actionsTypes: TStrings;
-  outletsNames, outletsTypes: TStrings);
 var
-  obj : TXibObject;
+  obj   : TXibObject;
-  act : 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.