From b161bf580839c2f5c3eec6dee2ab078c47700cdd Mon Sep 17 00:00:00 2001 From: mattias Date: Wed, 3 Sep 2008 11:42:20 +0000 Subject: [PATCH] IDE: auto creating application bundle on compile git-svn-id: trunk@16387 - --- ide/applicationbundle.pas | 87 +++++++++++++++---------------------- ide/dialogprocs.pas | 26 +++++++++++ ide/lazarusidestrconsts.pas | 2 + ide/main.pp | 17 +++++++- ide/projectopts.pp | 45 +++++++++---------- 5 files changed, 101 insertions(+), 76 deletions(-) diff --git a/ide/applicationbundle.pas b/ide/applicationbundle.pas index c872e14ff3..073c4bb7c9 100644 --- a/ide/applicationbundle.pas +++ b/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 = ''); -procedure CreateSymbolicLink(const Filename: String); +function CreateApplicationBundle(const Filename: String; Title: String = ''; Recreate: boolean = false): TModalResult; +function CreateAppBundleSymbolicLink(const Filename: String; Recreate: boolean = false): TModalResult; const ApplicationBundleExt = '.app'; @@ -122,60 +123,47 @@ begin Add(''); end; -procedure CreateDirectoryInteractive(const Directory: String); -begin - if not CreateDirUTF8(Directory) then - EApplicationBundleException.CreateFmt(rsCreatingDirFailed, [Directory]); -end; - -procedure CreateApplicationBundle(const Filename: String; Title: String); +function CreateApplicationBundle(const Filename: String; Title: String; + Recreate: boolean): TModalResult; var AppBundleDir: String; ContentsDir: String; MacOSDir: String; ResourcesDir: String; - - 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; - + sl: TStringList; begin AppBundleDir := ExtractFileNameWithoutExt(Filename) + ApplicationBundleExt + PathDelim; - // create 'applicationname.app/' directory - CreateDirectoryInteractive(AppBundleDir); - begin - // create 'applicationname.app/Contents/' directory - ContentsDir := AppBundleDir + ContentsDirName + PathDelim; - CreateDirectoryInteractive(ContentsDir); - begin - // create 'applicationname.app/Contents/MacOS/' directory - MacOSDir := ContentsDir + MacOSDirName + PathDelim; - CreateDirectoryInteractive(MacOSDir); + if not Recreate and DirectoryExistsUTF8(AppBundleDir) then exit(mrOk); - // create Info.plist file - with TApplicationPropertyList.Create(ExtractFileNameOnly(Filename), Title) do - SaveToFile(UTF8ToSys(ContentsDir + PropertyListFileName)); + // create 'applicationname.app/Contents/MacOS/' directory + ContentsDir := AppBundleDir + ContentsDirName + PathDelim; + MacOSDir := ContentsDir + MacOSDirName + PathDelim; + Result:=ForceDirectoryInteractive(MacOSDir,[mbIgnore,mbRetry]); + if Result<>mrOk then exit; - // create PkgInfo file - CreatePackageInfoFile(ContentsDir); + // create Info.plist file + sl:=TApplicationPropertyList.Create(ExtractFileNameOnly(Filename), Title); + Result:=SaveStringListToFile(ContentsDir + PropertyListFileName,'Info.plist part of Application bundle',sl); + sl.Free; + if Result<>mrOk then exit; - // create 'applicationname.app/Contents/Resources/' directory - ResourcesDir:=ContentsDir + ResourcesDirName + PathDelim; - CreateDirectoryInteractive(ResourcesDir); - end; - end; + // create PkgInfo file + 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; + Result:=ForceDirectoryInteractive(ResourcesDir,[mbIgnore,mbRetry]); + if Result<>mrOk then exit; + + 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), - PChar(LinkFilename)) <> 0 then - raise EApplicationBundleException.CreateFmt(rsCreatingSymLinkFailed, [LinkFilename]); + if (not Recreate) and (FileExistsUTF8(LinkFilename)) then exit(mrOk); + Result:=CreateSymlinkInteractive(LinkFilename,'..' + PathDelim + '..' + PathDelim + '..' + PathDelim + ShortExeName,[mbIgnore,mbRetry]); {$ELSE} - raise EApplicationBundleException.Create(rsCreatingSymLinkNotSupported); + Result:=mrIgnore; {$ENDIF} end; - - end. diff --git a/ide/dialogprocs.pas b/ide/dialogprocs.pas index f1c37eb18d..b468162448 100644 --- a/ide/dialogprocs.pas +++ b/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; diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index 9791404483..55482fc57f 100644 --- a/ide/lazarusidestrconsts.pas +++ b/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 diff --git a/ide/main.pp b/ide/main.pp index 29898fc143..4007ade058 100644 --- a/ide/main.pp +++ b/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( diff --git a/ide/projectopts.pp b/ide/projectopts.pp index 89995191fd..3226a2f9e6 100644 --- a/ide/projectopts.pp +++ b/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); + if AProject.IsVirtual then + TargetExeName := EnvironmentOptions.GetTestBuildDirectory + ExtractFilename(AProject.MainUnitInfo.Filename) + else + TargetExeName := AProject.CompilerOptions.CreateTargetFilename(AProject.MainFilename); - CreateApplicationBundle(TargetExeName, AProject.Title); - CreateSymbolicLink(TargetExeName); - Result := True; - except - on E: Exception do - MessageDlg(lisABCreationFailed + E.Message, mtError, [mbCancel], 0); - end; + if not (CreateApplicationBundle(TargetExeName, AProject.Title,true) in [mrOk,mrIgnore]) then exit; + if not (CreateAppBundleSymbolicLink(TargetExeName,true) in [mrOk,mrIgnore]) then exit; + Result := True; end; function ProjectSessionStorageToLocalizedName(s: TProjectSessionStorage