mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 19:18:01 +02:00
IDE: auto creating application bundle on compile
git-svn-id: trunk@16387 -
This commit is contained in:
mattias
parent
d84640530a
commit
b161bf5808
@ -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('</plist>');
|
||||
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.
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
17
ide/main.pp
17
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(
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user