IDE: auto creating application bundle on compile

git-svn-id: trunk@16387 -

ide/applicationbundle.pas

@@ -37,7 +37,8 @@ uses
 {$IFDEF UNIX}
   BaseUnix,
 {$ENDIF}
-  Classes, SysUtils, FileUtil;
+  Classes, SysUtils, FileUtil, Forms, Controls, Dialogs,
+  DialogProcs;
 
 type
   EApplicationBundleException = Exception;
@@ -49,8 +50,8 @@ type
     constructor Create(const ExeName: String; Title: String = ''; const Version: String = '0.1');
   end;
 
-procedure CreateApplicationBundle(const Filename: String; Title: String = '');
+function CreateApplicationBundle(const Filename: String; Title: String = ''; Recreate: boolean = false): TModalResult;
-procedure CreateSymbolicLink(const Filename: String);
+function CreateAppBundleSymbolicLink(const Filename: String; Recreate: boolean = false): TModalResult;
   
 const
   ApplicationBundleExt = '.app';
@@ -122,60 +123,47 @@ begin
   Add('</plist>');
 end;
 
-procedure CreateDirectoryInteractive(const Directory: String);
+function CreateApplicationBundle(const Filename: String; Title: String;
-begin
+  Recreate: boolean): TModalResult;
-  if not CreateDirUTF8(Directory) then
-    EApplicationBundleException.CreateFmt(rsCreatingDirFailed, [Directory]);
-end;
-
-procedure CreateApplicationBundle(const Filename: String; Title: String);
 var
   AppBundleDir: String;
   ContentsDir: String;
   MacOSDir: String;
   ResourcesDir: String;
-  
+  sl: TStringList;
-  procedure CreatePackageInfoFile(const Path: String);
-  var
-    S: TStringList;
-  begin
-    S := TStringList.Create;
-    try
-      S.Add(PackageInfoHeader);
-      S.SaveToFile(UTF8ToSys(Path + PackageInfoFileName));
-    finally
-      S.Free;
-    end;
-  end;
-  
 begin
   AppBundleDir := ExtractFileNameWithoutExt(Filename) + ApplicationBundleExt + PathDelim;
-  // create 'applicationname.app/' directory
+  if not Recreate and DirectoryExistsUTF8(AppBundleDir) then exit(mrOk);
-  CreateDirectoryInteractive(AppBundleDir);
+
-  begin
-    // create 'applicationname.app/Contents/' directory
-    ContentsDir := AppBundleDir + ContentsDirName + PathDelim;
-    CreateDirectoryInteractive(ContentsDir);
-    begin
   // create 'applicationname.app/Contents/MacOS/' directory
+  ContentsDir := AppBundleDir + ContentsDirName + PathDelim;
   MacOSDir := ContentsDir + MacOSDirName + PathDelim;
-      CreateDirectoryInteractive(MacOSDir);
+  Result:=ForceDirectoryInteractive(MacOSDir,[mbIgnore,mbRetry]);
+  if Result<>mrOk then exit;
 
   // create Info.plist file
-      with TApplicationPropertyList.Create(ExtractFileNameOnly(Filename), Title) do
+  sl:=TApplicationPropertyList.Create(ExtractFileNameOnly(Filename), Title);
-        SaveToFile(UTF8ToSys(ContentsDir + PropertyListFileName));
+  Result:=SaveStringListToFile(ContentsDir + PropertyListFileName,'Info.plist part of Application bundle',sl);
+  sl.Free;
+  if Result<>mrOk then exit;
 
   // create PkgInfo file
-      CreatePackageInfoFile(ContentsDir);
+  sl:=TStringList.Create;
+  sl.Add(PackageInfoHeader);
+  Result:=SaveStringListToFile(ContentsDir+PackageInfoFileName,'PkgInfo part of Application bundle',sl);
+  sl.Free;
+  if Result<>mrOk then exit;
 
   // create 'applicationname.app/Contents/Resources/' directory
   ResourcesDir:=ContentsDir + ResourcesDirName + PathDelim;
-      CreateDirectoryInteractive(ResourcesDir);
+  Result:=ForceDirectoryInteractive(ResourcesDir,[mbIgnore,mbRetry]);
-    end;
+  if Result<>mrOk then exit;
-  end;
+
+  Result:=mrOk;
 end;
 
-procedure CreateSymbolicLink(const Filename: String);
+function CreateAppBundleSymbolicLink(const Filename: String;
+  Recreate: boolean): TModalResult;
 {$IFDEF UNIX}
 var
   ShortExeName: String;
@@ -186,14 +174,11 @@ begin
   ShortExeName := ExtractFileNameOnly(Filename);
   LinkFilename := ExtractFileNameWithoutExt(Filename) + ApplicationBundleExt + PathDelim +
     ContentsDirName + PathDelim + MacOSDirName + PathDelim + ShortExeName;
-  if FPSymLink(PChar('..' + PathDelim + '..' + PathDelim + '..' + PathDelim + ShortExeName),
+  if (not Recreate) and (FileExistsUTF8(LinkFilename)) then exit(mrOk);
-    PChar(LinkFilename)) <> 0 then
+  Result:=CreateSymlinkInteractive(LinkFilename,'..' + PathDelim + '..' + PathDelim + '..' + PathDelim + ShortExeName,[mbIgnore,mbRetry]);
-    raise EApplicationBundleException.CreateFmt(rsCreatingSymLinkFailed, [LinkFilename]);
   {$ELSE}
-    raise EApplicationBundleException.Create(rsCreatingSymLinkNotSupported);
+  Result:=mrIgnore;
   {$ENDIF}
 end;
 
-
-
 end.

ide/dialogprocs.pas

@@ -88,6 +88,8 @@ function CheckCreatingFile(const AFilename: string;
 function CheckFileIsWritable(const Filename: string;
                              ErrorButtons: TMsgDlgButtons): TModalResult;
 function ChooseSymlink(var Filename: string): TModalResult;
+function CreateSymlinkInteractive(const LinkFilename, TargetFilename: string;
+                                  ErrorButtons: TMsgDlgButtons): TModalResult;
 function ForceDirectoryInteractive(Directory: string;
                                    ErrorButtons: TMsgDlgButtons): TModalResult;
 function DeleteFileInteractive(const Filename: string;
@@ -104,6 +106,11 @@ procedure NotImplementedDialog(const Feature: string);
 
 implementation
 
+{$IFDEF Unix}
+uses
+  baseunix;
+{$ENDIF}
+
 function BackupFileInteractive(const Filename: string): TModalResult;
 begin
   if Assigned(OnBackupFileInteractive) then
@@ -495,6 +502,25 @@ begin
   end;
 end;
 
+function CreateSymlinkInteractive(const LinkFilename, TargetFilename: string;
+  ErrorButtons: TMsgDlgButtons): TModalResult;
+var i: integer;
+  Dir: string;
+begin
+  {$IFDEF Unix}
+  if FpReadLink(LinkFilename)=TargetFilename then exit(mrOk);
+  while FPSymLink(PChar(TargetFilename),PChar(LinkFilename)) <> 0 do begin
+    Result:=IDEMessageDialog(lisCodeToolsDefsWriteError, Format(
+      lisUnableToCreateLinkWithTarget, ['"',
+      LinkFilename, '"', '"', TargetFilename, '"']),
+      mtError,ErrorButtons+[mbCancel],'');
+    if Result<>mrRetry then exit;
+  end;
+  {$ELSE}
+  Result:=mrIgnore;
+  {$ENDIF}
+end;
+
 function ForceDirectoryInteractive(Directory: string;
   ErrorButtons: TMsgDlgButtons): TModalResult;
 var i: integer;

ide/lazarusidestrconsts.pas

@@ -3833,6 +3833,8 @@ resourcestring
   lisDeleteSelectedFiles = 'Delete selected files';
   lisAddDirectory = 'Add directory';
   lisAddFilesOfDirectory = 'Add files of directory';
+  lisUnableToCreateLinkWithTarget = 'Unable to create link %s%s%s with '
+    +'target %s%s%s';
 
 implementation
 

ide/main.pp

@@ -95,7 +95,7 @@ uses
   IDEProtocol,
   // compile
   Compiler, CompilerOptions, CompilerOptionsDlg, CheckCompilerOpts,
-  W32VersionInfo, ImExportCompilerOpts, InfoBuild,
+  ApplicationBundle, W32VersionInfo, ImExportCompilerOpts, InfoBuild,
   // projects
   Project, ProjectDefs, NewProjectDlg, ProjectOpts,
   PublishProjectDlg, ProjectInspector, PackageDefs,
@@ -9203,6 +9203,7 @@ var
   VersionInfo: TProjectVersionInfo;
   NeedBuildAllFlag: Boolean;
   UnitOutputDirectory: String;
+  TargetExeName: String;
 begin
   if Project1.MainUnitInfo=nil then begin
     // this project has not source to compile
@@ -9338,6 +9339,20 @@ begin
       if Result<>mrOk then exit;
     end;
 
+    // create application bundle
+    if Project1.UseAppBundle and (Project1.MainUnitID>=0)
+    and (MainBuildBoss.GetLCLWidgetType(true)='carbon')
+    then begin
+      if Project1.IsVirtual then
+        TargetExeName := EnvironmentOptions.GetTestBuildDirectory + ExtractFilename(Project1.MainUnitInfo.Filename)
+      else
+        TargetExeName := Project1.CompilerOptions.CreateTargetFilename(Project1.MainFilename);
+      Result:=CreateApplicationBundle(TargetExeName, Project1.Title);
+      if not (Result in [mrOk,mrIgnore]) then exit;
+      Result:=CreateAppBundleSymbolicLink(TargetExeName);
+      if not (Result in [mrOk,mrIgnore]) then exit;
+    end;
+
     // execute compilation tool 'Before'
     if not (pbfSkipTools in Flags) then begin
       ToolBefore:=TProjectCompilationToolOptions(

ide/projectopts.pp

@@ -48,26 +48,16 @@ type
   { TProjectOptionsDialog }
 
   TProjectOptionsDialog = class(TForm)
-    CreateAppBundleButton: TButton;
-    EnableI18NCheckBox: TCheckBox;
-    I18NGroupBox: TGroupBox;
-    PanelOtherLabels: TPanel;
-    PODBtnPanel: TPanel;
-    PoOutDirLabel: TLabel;
-
     Notebook: TNotebook;
     ApplicationPage: TPage;
     FormsPage: TPage;
     MiscPage: TPage;
     LazDocPage: TPage;
-    i18nPage: TPage;
-    POOutDirButton: TButton;
-    POOutDirEdit: TEdit;
     SavePage: TPage;
-    UseAppBundleCheckBox: TCheckBox;
-    UseXPManifestCheckBox: TCheckBox;
     VersionInfoPage: TPage;
+    i18nPage: TPage;
 
+    // General
     AppSettingsGroupBox: TGroupBox;
     OutputSettingsGroupBox: TGroupBox;
     SelectDirectoryDialog: TSelectDirectoryDialog;
@@ -75,6 +65,10 @@ type
     TitleEdit: TEdit;
     TargetFileLabel: TLabel;
     TargetFileEdit: TEdit;
+    PanelOtherLabels: TPanel;
+    CreateAppBundleButton: TButton;
+    UseAppBundleCheckBox: TCheckBox;
+    UseXPManifestCheckBox: TCheckBox;
 
     // Forms
     FormsAutoCreatedLabel: TLabel;
@@ -134,6 +128,14 @@ type
     CopyrightLabel: TLabel;
     AdditionalInfoForm: TVersionInfoAdditinalInfoForm;
 
+    // i18n
+    POOutDirButton: TButton;
+    POOutDirEdit: TEdit;
+    EnableI18NCheckBox: TCheckBox;
+    I18NGroupBox: TGroupBox;
+    PODBtnPanel: TPanel;
+    PoOutDirLabel: TLabel;
+
     // buttons at bottom
     HelpButton: TBitBtn;
     CancelButton: TBitBtn;
@@ -211,19 +213,14 @@ var
 begin
   Result := False;
   if AProject.MainUnitInfo = nil then Exit;
-  try
   if AProject.IsVirtual then
     TargetExeName := EnvironmentOptions.GetTestBuildDirectory + ExtractFilename(AProject.MainUnitInfo.Filename)
   else
     TargetExeName := AProject.CompilerOptions.CreateTargetFilename(AProject.MainFilename);
 
-    CreateApplicationBundle(TargetExeName, AProject.Title);
+  if not (CreateApplicationBundle(TargetExeName, AProject.Title,true) in [mrOk,mrIgnore]) then exit;
-    CreateSymbolicLink(TargetExeName);
+  if not (CreateAppBundleSymbolicLink(TargetExeName,true) in [mrOk,mrIgnore]) then exit;
   Result := True;
-  except
-    on E: Exception do
-      MessageDlg(lisABCreationFailed + E.Message, mtError, [mbCancel], 0);
-  end;
 end;
 
 function ProjectSessionStorageToLocalizedName(s: TProjectSessionStorage