1 { /***************************************************************************
2 ApplicationBundle.pas - Lazarus IDE unit
3 ------------------------------------------
4
5 ***************************************************************************/
6
7 ***************************************************************************
8 * *
9 * This source is free software; you can redistribute it and/or modify *
10 * it under the terms of the GNU General Public License as published by *
11 * the Free Software Foundation; either version 2 of the License, or *
12 * (at your option) any later version. *
13 * *
14 * This code is distributed in the hope that it will be useful, but *
15 * WITHOUT ANY WARRANTY; without even the implied warranty of *
16 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
17 * General Public License for more details. *
18 * *
19 * A copy of the GNU General Public License is available on the World *
20 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
21 * obtain it by writing to the Free Software Foundation, *
22 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
23 * *
24 ***************************************************************************
25
26 Abstract:
27 Application Bundle utilities
28
29 }
30 unit ApplicationBundle;
31
32 {$mode objfpc}{$H+}
33
34 interface
35
36 uses
37 Classes, SysUtils, Forms, Controls, Dialogs, FileUtil, LazFileUtils,
38 DialogProcs, Project;
39
40 type
41 EApplicationBundleException = Exception;
42
43 { TApplicationPropertyList }
44
45 TApplicationPropertyList = class(TStringList)
46 public
47 constructor Create(const ExeName: String; Title: String = ''; const Version: String = '0.1'; AProject: TProject = nil);
48 end;
49
CreateApplicationBundlenull50 function CreateApplicationBundle(const Filename: String; Title: String = ''; Recreate: boolean = false; AProject: TProject = nil): TModalResult;
CreateAppBundleSymbolicLinknull51 function CreateAppBundleSymbolicLink(const {%H-}Filename: String; {%H-}Recreate: boolean = false): TModalResult;
52
53 const
54 ApplicationBundleExt = '.app';
55 ContentsDirName = 'Contents';
56 MacOSDirName = 'MacOS';
57 ResourcesDirName = 'Resources';
58 PropertyListFileName = 'Info.plist';
59 PackageInfoFileName = 'PkgInfo';
60 PackageInfoHeader = 'APPL????';
61
62 implementation
63
64 { TApplicationPropertyList }
65
66 constructor TApplicationPropertyList.Create(const ExeName: String;
67 Title: String; const Version: String; AProject: TProject);
68 begin
69 inherited Create;
70
71 if Title = '' then Title := ExeName;
72
73 Add('<?xml version="1.0" encoding="UTF-8"?>');
74 Add('<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">');
75 Add('<plist version="1.0">');
76 Add('<dict>');
77 if (AProject <> nil) and (AProject.NSPrincipalClass <> '') then begin
78 Add(' <key>NSPrincipalClass</key>');
79 Add(' <string>' + AProject.NSPrincipalClass + '</string>');
80 end;
81 Add(' <key>CFBundleDevelopmentRegion</key>');
82 Add(' <string>English</string>');
83 Add(' <key>CFBundleExecutable</key>');
84 Add(' <string>' + ExeName + '</string>');
85 Add(' <key>CFBundleName</key>');
86 Add(' <string>' + Title + '</string>');
87 Add(' <key>CFBundleIdentifier</key>');
88 Add(' <string>com.company.' + ExeName + '</string>');
89 Add(' <key>CFBundleInfoDictionaryVersion</key>');
90 Add(' <string>6.0</string>');
91 Add(' <key>CFBundlePackageType</key>');
92 Add(' <string>APPL</string>');
93 Add(' <key>CFBundleSignature</key>');
94 Add(' <string>' + Copy(ExeName + '????', 1, 4) + '</string>');
95 Add(' <key>CFBundleShortVersionString</key>');
96 Add(' <string>' + Version + '</string>');
97 Add(' <key>CFBundleVersion</key>');
98 Add(' <string>1</string>');
99 Add(' <key>CSResourcesFileMapped</key>');
100 Add(' <true/>');
101 // for accepting files dropped on the dock icon:
102 Add(' <key>CFBundleDocumentTypes</key>');
103 Add(' <array>');
104 Add(' <dict>');
105 Add(' <key>CFBundleTypeRole</key>');
106 Add(' <string>Viewer</string>');
107 Add(' <key>CFBundleTypeExtensions</key>');
108 Add(' <array>');
109 Add(' <string>*</string>');
110 Add(' </array>');
111 Add(' <key>CFBundleTypeOSTypes</key>');
112 Add(' <array>');
113 Add(' <string>fold</string>');
114 Add(' <string>disk</string>');
115 Add(' <string>****</string>');
116 Add(' </array>');
117 Add(' </dict>');
118 Add(' </array>');
119 // needed for retina
120 Add(' <key>NSHighResolutionCapable</key>');
121 Add(' <true/>');
122 Add('</dict>');
123 Add('</plist>');
124 end;
125
CreateApplicationBundlenull126 function CreateApplicationBundle(const Filename: String; Title: String;
127 Recreate: boolean; AProject: TProject): TModalResult;
128 var
129 AppBundleDir: String;
130 ContentsDir: String;
131 MacOSDir: String;
132 ResourcesDir: String;
133 sl: TStrings;
134 begin
135 AppBundleDir := ExtractFileNameWithoutExt(Filename) + ApplicationBundleExt + PathDelim;
136 if not Recreate and DirectoryExistsUTF8(AppBundleDir) then exit(mrOk);
137
138 // create 'applicationname.app/Contents/MacOS/' directory
139 ContentsDir := AppBundleDir + ContentsDirName + PathDelim;
140 MacOSDir := ContentsDir + MacOSDirName + PathDelim;
141 Result:=ForceDirectoryInteractive(MacOSDir,[mbIgnore,mbRetry]);
142 if Result<>mrOk then exit;
143
144 // create Info.plist file
145 sl:=TApplicationPropertyList.Create(ExtractFileNameOnly(Filename), Title, '0.1', AProject);
146 Result:=SaveStringListToFile(ContentsDir + PropertyListFileName,'Info.plist part of Application bundle',sl);
147 sl.Free;
148 if Result<>mrOk then exit;
149
150 // create PkgInfo file
151 sl:=TStringList.Create;
152 sl.Add(PackageInfoHeader);
153 Result:=SaveStringListToFile(ContentsDir+PackageInfoFileName,'PkgInfo part of Application bundle',sl);
154 sl.Free;
155 if Result<>mrOk then exit;
156
157 // create 'applicationname.app/Contents/Resources/' directory
158 ResourcesDir:=ContentsDir + ResourcesDirName + PathDelim;
159 Result:=ForceDirectoryInteractive(ResourcesDir,[mbIgnore,mbRetry]);
160 if Result<>mrOk then exit;
161
162 Result:=mrOk;
163 end;
164
CreateAppBundleSymbolicLinknull165 function CreateAppBundleSymbolicLink(const Filename: String;
166 Recreate: boolean): TModalResult;
167 {$IFDEF UNIX}
168 var
169 ShortExeName: String;
170 LinkFilename: String;
171 {$ENDIF}
172 begin
173 {$IFDEF UNIX}
174 ShortExeName := ExtractFileNameOnly(Filename);
175 LinkFilename := ExtractFileNameWithoutExt(Filename) + ApplicationBundleExt + PathDelim +
176 ContentsDirName + PathDelim + MacOSDirName + PathDelim + ShortExeName;
177 if (not Recreate) and (FileExistsUTF8(LinkFilename)) then exit(mrOk);
178 Result:=CreateSymlinkInteractive(LinkFilename,'..' + PathDelim + '..' + PathDelim + '..' + PathDelim + ShortExeName,[mbIgnore,mbRetry]);
179 {$ELSE}
180 Result:=mrIgnore;
181 {$ENDIF}
182 end;
183
184 end.
185