source: trunk/source/cocoa-ide/builder-utilities.lisp @ 12704

Last change on this file since 12704 was 12704, checked in by palter, 10 years ago

Update build-application so that it can build
standalone applications on Windows. Add a :private-frameworks
argument to include private frameworks in the bundle. The code
which copies the frameworks knows how to structure them on
both Mac and Windows.

With these changes, I can build a standalone version of XMLisp.

Still need to figure out how to arrange for a console window to
popup when needed.

File size: 19.2 KB
Line 
1;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: cl-user -*-
2;;;; ***********************************************************************
3;;;; FILE IDENTIFICATION
4;;;;
5;;;; Name:          builder-utilities.lisp
6;;;; Version:       0.9
7;;;; Project:       bosco - Cocoa application builder
8;;;; Purpose:       utilities used by both batch and interactive builders
9;;;;
10;;;; ***********************************************************************
11
12(in-package :ccl)
13
14;;; ABOUT
15;;; ------------------------------------------------------------------------
16;;; Builder-utilities contains several functions used by OpenMCL
17;;; application-building tools for building and copying bundles,
18;;; resource directories, and magic files used by OSX applications.
19
20(defun %temp-nsstring (s) (#/autorelease (%make-nsstring s)))
21
22;;; Info Defaults
23;;; Some useful values for use when creating application bundles
24
25(defparameter $default-application-bundle-name "MyApplication")
26(defparameter $default-application-type-string "APPL")
27(defparameter $default-application-creator-string "OMCL")
28(defparameter $default-application-version-number "1.0")
29
30;;; defaults related to Info.plist files
31(defparameter $cfbundle-development-region-key #@"CFBundleDevelopmentRegion")
32(defparameter $default-info-plist-development-region "English")
33
34(defparameter $cfbundle-executable-key #@"CFBundleExecutable")
35(defparameter $default-info-plist-executable $default-application-bundle-name)
36
37(defparameter $cfbundle-getinfo-string-key #@"CFBundleGetInfoString")
38(defparameter $default-info-plist-getInfo-string "\"1.0 Copyright © 2008\"")
39
40(defparameter $cfbundle-help-book-folder-key #@"CFBundleHelpBookFolder")
41(defparameter $default-info-plist-help-book-folder "MyApplicationHelp")
42
43(defparameter $cfbundle-help-book-name-key #@"CFBundleHelpBookName")
44(defparameter $default-info-plist-help-book-name "\"MyApplication Help\"")
45
46(defparameter $cfbundle-icon-file-key #@"CFBundleIconFile")
47(defparameter $default-info-plist-icon-file "\"MyApplication.icns\"")
48
49(defparameter $cfbundle-bundle-identifier-key #@"CFBundleIdentifier")
50(defparameter $default-info-plist-bundle-identifier "\"com.clozure.apps.myapplication\"")
51
52(defparameter $cfbundle-dictionary-version-key #@"CFBundleInfoDictionaryVersion")
53(defparameter $default-info-dictionary-version "\"6.0\"")
54
55(defparameter $cfbundle-bundle-name-key #@"CFBundleName")
56(defparameter $default-info-plist-bundle-name "MyApplication")
57
58(defparameter $cfbundle-bundle-package-type-key #@"CFBundlePackageType")
59(defparameter $default-info-plist-bundle-package-type "APPL")
60
61(defparameter $cfbundle-short-version-string-key #@"CFBundleShortVersionString")
62(defparameter $default-info-plist-short-version-string "\"1.0\"")
63
64(defparameter $cfbundle-bundle-signature-key #@"CFBundleSignature")
65(defparameter $default-info-plist-bundle-signature "OMCL")
66
67(defparameter $cfbundle-version-key #@"CFBundleVersion")
68(defparameter $default-info-plist-version "\"1.0\"")
69
70(defparameter $ls-has-localized-display-name-key #@"LSHasLocalizedDisplayName")
71(defparameter $default-info-plist-has-localized-display-name "0")
72
73(defparameter $ls-minimum-system-version-key #@"LSMinimumSystemVersion")
74(defparameter $default-info-plist-minimum-system-version "\"10.5\"")
75
76(defparameter $ns-main-nib-file-key #@"NSMainNibFile")
77(defparameter $default-info-plist-main-nib-file "MainMenu")
78
79(defparameter $ns-principal-class-key #@"NSPrincipalClass")
80(defparameter $default-info-plist-principal-class "LispApplication")
81
82;;; keys for document-types dicts
83(defparameter $cfbundle-type-extensions-key #@"CFBundleTypeExtensions")
84(defparameter $cfbundle-type-icon-file-key #@"CFBundleTypeIconFile")
85(defparameter $cfbundle-type-mime-types-key #@"CFBundleTypeMIMETypes")
86(defparameter $cfbundle-type-name-key #@"CFBundleTypeName")
87(defparameter $cfbundle-type-ostypes-key #@"CFBundleTypeOSTypes")
88(defparameter $cfbundle-type-role-key #@"CFBundleTypeRole")
89(defparameter $ls-item-content-types-key #@"LSItemContentTypes")
90(defparameter $ls-type-is-package-key #@"LSTypeIsPackage")
91(defparameter $ns-document-class-key #@"NSDocumentClass")
92(defparameter $ns-exportable-as-key #@"NSExportableAs")
93
94;;; COPY-NIBFILE (srcnib dest-directory &key (if-exists :overwrite))
95;;; ------------------------------------------------------------------------
96;;; Copies a nibfile (which may in fact be a directory) to the
97;;; destination path (which may already exist, and may need to
98;;; be overwritten
99
100(defun copy-nibfile (srcnib dest-directory &key (if-exists :overwrite))
101  (setq if-exists (require-type if-exists '(member :overwrite :error)))
102  (let* ((basename (basename srcnib))
103         (dest (path dest-directory basename)))
104    (if (probe-file dest)
105        (case if-exists
106          (:overwrite (progn
107                        (if (directoryp dest)
108                            (recursive-delete-directory dest)
109                            (delete-file dest))))
110          (:error (error "The nibfile '~A' already exists" dest))))
111    (if (directoryp srcnib)
112        (recursive-copy-directory srcnib dest)
113        (copy-file srcnib dest))))
114
115;;; BASENAME path
116;;; ------------------------------------------------------------------------
117;;; returns the final component of a pathname--that is, the
118;;; filename (with type extension) if it names a file, or the
119;;; last directory name if it names a directory
120
121(defun basename (path)
122  ;; first probe to see whether the path exists.  if it does, then
123  ;; PROBE-FILE returns a canonical pathname for it which, among other
124  ;; things, ensures the pathame represents a directory if it's really
125  ;; a directory, and a file if it's really a file
126  (let* ((path (or (probe-file path)
127                   path))
128         (dir (pathname-directory path))
129         (name (pathname-name path))
130         (type (pathname-type path)))
131    (if name
132        (if type
133            (make-pathname :name name :type type)
134            (make-pathname :name name))
135        ;; it's possible to have a pathname with a type but no name
136        ;; e.g. "/Users/foo/.emacs"
137        (if type
138            (make-pathname :type type)
139            (make-pathname :directory (first (last dir)))))))
140
141;;; PATH (&rest components)
142;;; ------------------------------------------------------------------------
143;;; returns a pathname. The input COMPONENTS are treated as
144;;; directory names, each contained in the one to the left, except
145;;; for the last. The last is treated as a directory if it ends
146;;; with a path separator, and a file if it doesn't
147(defun path (&rest components)
148  (if (null components)
149      (pathname "")
150      (if (null (cdr components))
151          (pathname (car components))
152          (merge-pathnames (apply #'path (cdr components))
153                           (ensure-directory-pathname (car components))))))
154
155
156;;; WRITE-PKGINFO path package-type bundle-signature
157;;; ------------------------------------------------------------------------
158;;; Writes a PkgInfo file of the sort used by Cocoa applications
159;;; to identify their package types and signatures. Writes
160;;; PACKAGE-TYPE and BUNDLE-SIGNATURE to the file at PATH,
161;;; clobbering it if it already exists.
162(defun write-pkginfo (path package-type bundle-signature)
163  (with-open-file (out path
164                       :direction :output
165                       :if-does-not-exist :create
166                       :if-exists :supersede)
167    (format out "~A~A" package-type bundle-signature)))
168
169;;; MAKE-INFO-DICT
170;;; ------------------------------------------------------------------------
171;;; returns a newly-created NSDictionary with contents
172;;; specified by the input parameters
173(defun make-info-dict (&key
174                       (development-region $default-info-plist-development-region)
175                       (executable $default-info-plist-executable)
176                       (getinfo-string $default-info-plist-getinfo-string)
177                       (help-book-folder $default-info-plist-help-book-folder)
178                       (help-book-name $default-info-plist-help-book-name)
179                       (icon-file $default-info-plist-icon-file)
180                       (bundle-identifier $default-info-plist-bundle-identifier)
181                       (dictionary-version $default-info-dictionary-version)
182                       (bundle-name $default-info-plist-bundle-name)
183                       (bundle-package-type $default-info-plist-bundle-package-type)
184                       (short-version-string $default-info-plist-short-version-string)
185                       (bundle-signature $default-info-plist-bundle-signature)
186                       (version $default-info-plist-version)
187                       (has-localized-display-name $default-info-plist-has-localized-display-name)
188                       (minimum-system-version $default-info-plist-minimum-system-version)
189                       (main-nib-file $default-info-plist-main-nib-file)
190                       (principal-class $default-info-plist-principal-class))
191  (#/dictionaryWithObjectsAndKeys: ns:ns-mutable-dictionary
192                                   (%temp-nsstring development-region) $cfbundle-development-region-key
193                                   (%temp-nsstring executable) $cfbundle-executable-key
194                                   (%temp-nsstring getinfo-string) $cfbundle-getinfo-string-key
195                                   (%temp-nsstring help-book-folder) $cfbundle-help-book-folder-key
196                                   (%temp-nsstring help-book-name) $cfbundle-help-book-name-key
197                                   (%temp-nsstring icon-file) $cfbundle-icon-file-key
198                                   (%temp-nsstring bundle-identifier) $cfbundle-bundle-identifier-key
199                                   (%temp-nsstring dictionary-version) $cfbundle-dictionary-version-key
200                                   (%temp-nsstring bundle-name) $cfbundle-bundle-name-key
201                                   (%temp-nsstring bundle-package-type) $cfbundle-bundle-package-type-key
202                                   (%temp-nsstring short-version-string) $cfbundle-short-version-string-key
203                                   (%temp-nsstring bundle-signature) $cfbundle-bundle-signature-key
204                                   (%temp-nsstring version) $cfbundle-version-key
205                                   (%temp-nsstring has-localized-display-name) $ls-has-localized-display-name-key
206                                   (%temp-nsstring minimum-system-version) $ls-minimum-system-version-key
207                                   (%temp-nsstring main-nib-file) $ns-main-nib-file-key
208                                   (%temp-nsstring principal-class) $ns-principal-class-key
209                                   +null-ptr+))
210
211(defun make-doctype-dict (&key
212                          (extensions nil)
213                          (icon-file "Icons.icns")
214                          (mime-types nil)
215                          (type-name nil)
216                          (ostypes nil)
217                          (role nil)
218                          (ls-item-content-types nil)
219                          (bundlep nil)
220                          (document-class nil)
221                          (exportable-as nil))
222  ;; certain values are required
223  (assert (or ls-item-content-types extensions mime-types ostypes)
224          ()
225          "You must supply a list of strings as the value for one of the keywords :ls-item-content-types, :extensions, :mime-types, or :ostypes")
226  (assert type-name () "You must supply a string as a value for the keyword :type-name")
227  (assert role () 
228          "You must supply one of the strings \"Editor\", \"Viewer\", \"Shell\", or \"None\" as a value for the keyword :role")
229  (assert document-class ()
230          "You must supply the name of an NSDocument subclass (as a string) as the value of the keyword :document-class")
231  )
232
233;;; READ-INFO-PLIST info-path
234;;; ------------------------------------------------------------------------
235;;; returns a newly-created NSDictionary with the contents
236;;; of the plist file at INFO-PATH
237(defun read-info-plist (info-path)
238  (let* ((info-path (pathname info-path)) ; make sure it's a pathname to start
239         (verified-path (probe-file info-path)))
240    (assert (and verified-path
241                 (string-equal (pathname-type verified-path) "plist"))
242            (info-path)
243            "The input path for READ-INFO-PLIST must be the name of a valid 'plist' file.")
244    (let* ((info-path-str (%temp-nsstring (namestring info-path))))
245      (#/dictionaryWithContentsOfFile: ns:ns-mutable-dictionary 
246                                       info-path-str))))
247
248;;; WRITE-INFO-PLIST info-plist path name package-type bundle-signature
249;;; ------------------------------------------------------------------------
250;;; sets the name, package-type, and bundle-signature of the
251;;; info-plist from the inputs; writes the changed dictionary to a new
252;;; Info.plist file at PATH.
253
254(defun write-info-plist (info-dict out-path name package-type bundle-signature
255                         &key main-nib-name)
256  ;; change the fields needed, write the results to PATH
257  (assert (or (null main-nib-name)
258              (stringp main-nib-name))
259          (main-nib-name)
260          "The main-nib-name must be a string or NIL, not ~S" main-nib-name)
261  (with-autorelease-pool
262    (let* ((bundle-name-str (%make-nsstring name))
263           (type-str (%make-nsstring package-type))
264           (sig-str (%make-nsstring bundle-signature))
265           (app-name-str (%make-nsstring (bundle-executable-name name)))
266           (app-plist-path-str (%make-nsstring (namestring out-path))))
267      (#/setValue:forKey: info-dict bundle-name-str $cfbundle-bundle-name-key)
268      (#/setValue:forKey: info-dict app-name-str $cfbundle-executable-key)
269      (#/setValue:forKey: info-dict type-str $cfbundle-bundle-package-type-key)
270      (#/setValue:forKey: info-dict sig-str $cfbundle-bundle-signature-key)
271      (when main-nib-name
272        (#/setValue:forKey: info-dict 
273                            (%make-nsstring main-nib-name)
274                            $ns-main-nib-file-key))
275      (#/writeToFile:atomically: info-dict app-plist-path-str #$YES))))
276
277;;; GET-IDE-BUNDLE-PATH
278;;; ------------------------------------------------------------------------
279;;; Returns the llisp pathname of the running IDE bundle
280
281(defun get-ide-bundle-path ()
282  (let* ((ide-bundle (#/mainBundle ns:ns-bundle))
283         (ide-bundle-path-nsstring (#/bundlePath ide-bundle)))
284    (pathname 
285     (ensure-directory-pathname 
286      (lisp-string-from-nsstring ide-bundle-path-nsstring)))))
287
288;;; GET-IDE-BUNDLE-INFO-PLIST
289;;; ------------------------------------------------------------------------
290;;; Returns an NSDictionary instance created by reading the Info.plist
291;;; file from the running IDE's application bundle
292
293(defun get-ide-bundle-info-plist ()
294  (let* ((ide-bundle (#/mainBundle ns:ns-bundle))
295         (ide-bundle-path-nsstring (#/bundlePath ide-bundle))
296         (ide-bundle-path (ensure-directory-pathname 
297                           (lisp-string-from-nsstring ide-bundle-path-nsstring)))
298         (ide-plist-path-str (namestring (path ide-bundle-path 
299                                               "Contents" "Info.plist"))))
300    (read-info-plist ide-plist-path-str)))
301
302;;; BUNNDLE-EXECUTABLE-PATH app-path
303;;; ------------------------------------------------------------------------
304;;; Returns the pathname of the executable directory given the pathname of
305;;; an application bundle
306(defun bundle-executable-path (app-path)
307  (path app-path "Contents" 
308        #-windows-target (ensure-directory-pathname "MacOS")
309        #+windows-target (ensure-directory-pathname "Windows")))
310
311;;; BUNNDLE-EXECUTABLE-NAME name
312;;; ------------------------------------------------------------------------
313;;; Returns the name of the executable file for an application bundle
314(defun bundle-executable-name (name)
315  #-windows-target name
316  #+windows-target (concatenate 'string name ".exe"))
317
318;;; MAKE-APPLICATION-BUNDLE name package-type bundle-signature project-path
319;;; ------------------------------------------------------------------------
320;;; Build the directory structure of a Cocoa application bundle and
321;;; populate it with the required PkgInfo and Info.plist files.
322(defun make-application-bundle (&key 
323                                (name $default-application-bundle-name)
324                                (project-path (current-directory)))
325  (let* ((app-bundle (path project-path 
326                           (ensure-directory-pathname (concatenate 'string name ".app"))))
327         (contents-dir (path app-bundle (ensure-directory-pathname "Contents")))
328         (executable-dir (bundle-executable-path app-bundle))
329         (rsrc-dir (path contents-dir  "Resources" 
330                         (ensure-directory-pathname "English.lproj"))))
331    (ensure-directories-exist executable-dir)
332    (ensure-directories-exist rsrc-dir)
333    app-bundle))
334
335;;; BUNDLE-FRAMEWORKS-PATH app-path
336;;; ------------------------------------------------------------------------
337;;; Returns the pathname of the frameworks directory given the pathname of
338;;; an application bundle
339(defun bundle-frameworks-path (app-path)
340  (path app-path "Contents"
341        #-windows-target (ensure-directory-pathname "Frameworks")
342        #+windows-target (ensure-directory-pathname "Windows")))
343
344;;; FIND-FRAMEWORK-EXECUTABLE framework-path
345;;; ------------------------------------------------------------------------
346;;; Returns the pathname of the framework's executable file given the
347;;; pathname of a framework
348(defun find-framework-executable (framework-path)
349  (let* ((raw-framework-name (car (last (pathname-directory framework-path))))
350         (framework-name (subseq raw-framework-name 0 (- (length raw-framework-name)
351                                                         #.(length ".framework"))))
352         (executable-wildcard (path framework-path
353                                    (concatenate 'string framework-name "*.dll")))
354         (executables (directory executable-wildcard)))
355    (when executables
356      (truename (first executables)))))
357
358;;; COPY-PRIVATE-FRAMEWORKS private-frameworks app-path
359;;; ------------------------------------------------------------------------
360;;; Copy any private frameworks into the bundle taking into account the
361;;; different directory structures used by Cocoa and Cocotron (Windows).
362(defun copy-private-frameworks (private-frameworks app-path)
363  (let ((private-frameworks #+windows-target (append *cocoa-application-frameworks*
364                                                     private-frameworks)
365                            #-windows-target private-frameworks)
366        (frameworks-dir (bundle-frameworks-path app-path)))
367    #+windows-target
368    (dolist (lib *cocoa-application-libraries*)
369      (copy-file lib frameworks-dir :preserve-attributes t :if-exists :supersede))
370    (when private-frameworks
371      (flet ((subdir (framework target)
372               (ensure-directory-pathname
373                (make-pathname :name (car (last (pathname-directory framework)))
374                               :defaults target))))
375        (dolist (framework private-frameworks)
376          (recursive-copy-directory framework (subdir framework frameworks-dir)
377                                    :if-exists :overwrite)
378          #+windows-target
379          (let ((executable (find-framework-executable framework)))
380            (when executable
381              (copy-file executable frameworks-dir 
382                         :preserve-attributes t :if-exists :supersede))))))))
Note: See TracBrowser for help on using the repository browser.