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

Last change on this file was 16686, checked in by rme, 4 years ago

Update copyright/license headers in cocoa-ide directory.

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