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

Last change on this file since 9309 was 9309, checked in by mikel, 13 years ago

more work toward un-hardwiring Info.plist data in build-application, and eventually adding support for user-defined delegate classes

File size: 11.2 KB
1;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: cl-user -*-
2;;;; ***********************************************************************
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
10;;;; ***********************************************************************
12(in-package :ccl)
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.
21;;; Some useful default values for use when creating application bundles
23(defparameter $default-application-bundle-name "MyApplication")
24(defparameter $default-application-type-string "APPL")
25(defparameter $default-application-creator-string "OMCL")
26(defparameter $default-application-version-number "1.0")
28;;; defaults related to Info.plist files
30(defparameter $default-info-plist-development-region "English")
31(defparameter $default-info-plist-executable $default-application-bundle-name)
32(defparameter $default-info-plist-getInfo-string (format nil "~A Copyright ~C 2008" 
33                                                         $default-application-version-number
34                                                         #\Copyright_Sign))
35(defparameter $default-info-plist-help-book-folder (format nil "~AHelp" $default-application-bundle-name))
36(defparameter $default-info-plist-help-book-name (format nil "~A Help" $default-application-bundle-name))
37(defparameter $default-info-plist-icon-file (format nil "~A.icns" $default-application-bundle-name))
38(defparameter $default-info-plist-bundle-identifier (format nil "com.clozure.ccl.apps.~A" 
39                                                            (string-downcase $default-application-bundle-name)))
40(defparameter $default-info-dictionary-version "6.0")
41(defparameter $default-info-plist-bundle-name $default-application-bundle-name)
42(defparameter $default-info-plist-bundle-package-type "APPL")
43(defparameter $default-info-plist-short-version-string $default-application-version-number)
44(defparameter $default-info-plist-bundle-signature "OMCL")
45(defparameter $default-info-plist-version $default-application-version-number)
46(defparameter $default-info-plist-has-localized-display-name 0)
47(defparameter $default-info-plist-minimum-system-version "10.5")
48(defparameter $default-info-plist-main-nib-file "MainMenu")
49(defparameter $default-info-plist-principal-class "LispApplication")
52;;; COPY-NIBFILE (srcnib dest-directory &key (if-exists :overwrite))
53;;; Copies a nibfile (which may in fact be a directory) to the
54;;; destination path (which may already exist, and may need to
55;;; be overwritten
57(defun copy-nibfile (srcnib dest-directory &key (if-exists :overwrite))
58  (setq if-exists (require-type if-exists '(member :overwrite :error)))
59  (let* ((basename (basename srcnib))
60         (dest (path dest-directory basename)))
61    (if (probe-file dest)
62        (case if-exists
63          (:overwrite (progn
64                        (if (directoryp dest)
65                            (recursive-delete-directory dest)
66                            (delete-file dest))))
67          (:error (error "The nibfile '~A' already exists" dest))))
68    (if (directoryp srcnib)
69        (recursive-copy-directory srcnib dest)
70        (copy-file srcnib dest))))
72;;; BASENAME path
73;;; returns the final component of a pathname--that is, the
74;;; filename (with type extension) if it names a file, or the
75;;; last directory name if it names a directory
77(defun basename (path)
78  ;; first probe to see whether the path exists.  if it does, then
79  ;; PROBE-FILE returns a canonical pathname for it which, among other
80  ;; things, ensures the pathame represents a directory if it's really
81  ;; a directory, and a file if it's really a file
82  (let* ((path (or (probe-file path)
83                   path))
84         (dir (pathname-directory path))
85         (name (pathname-name path))
86         (type (pathname-type path)))
87    (if name
88        (if type
89            (make-pathname :name name :type type)
90            (make-pathname :name name))
91        ;; it's possible to have a pathname with a type but no name
92        ;; e.g. "/Users/foo/.emacs"
93        (if type
94            (make-pathname :type type)
95            (make-pathname :directory (first (last dir)))))))
97;;; PATH (&rest components)
98;;; returns a pathname. The input COMPONENTS are treated as
99;;; directory names, each contained in the one to the left, except
100;;; for the last. The last is treated as a directory if it ends
101;;; with a path separator, and a file if it doesn't
102(defun path (&rest components)
103  (if (null components)
104      (pathname "")
105      (if (null (cdr components))
106          (pathname (car components))
107          (merge-pathnames (apply #'path (cdr components))
108                           (ensure-directory-pathname (car components))))))
111;;; WRITE-PKGINFO path package-type bundle-signature
112;;; Writes a PkgInfo file of the sort used by Cocoa applications
113;;; to identify their package types and signatures. Writes
114;;; PACKAGE-TYPE and BUNDLE-SIGNATURE to the file at PATH,
115;;; clobbering it if it already exists.
116(defun write-pkginfo (path package-type bundle-signature)
117  (with-open-file (out path
118                       :direction :output
119                       :if-does-not-exist :create
120                       :if-exists :supersede)
121    (format out "~A~A" package-type bundle-signature)))
124;;; returns a newly-created NSDictionary with contents
125;;; specified by the input parameters
126(defun make-info-plist (&key
127                        (development-region $default-info-plist-development-region)
128                        (executable $default-info-plist-executable)
129                        (getinfo-string $default-info-plist-getinfo-string)
130                        (help-book-folder $default-info-plist-help-book-folder)
131                        (help-book-name $default-info-plist-help-book-name)
132                        (icon-file $default-info-plist-icon-file)
133                        (bundle-identifier $default-info-plist-bundle-identifier)
134                        (dictionary-version $default-info-dictionary-version)
135                        (bundle-name $default-info-plist-bundle-name)
136                        (bundle-package-type $default-info-plist-bundle-package-type)
137                        (short-version-string $default-info-plist-short-version-string)
138                        (bundle-signature $default-info-plist-bundle-signature)
139                        (version $default-info-plist-version)
140                        (has-localized-display-name $default-info-plist-has-localized-display-name)
141                        (minimum-system-version $default-info-plist-minimum-system-version)
142                        (main-nib-file $default-info-plist-main-nib-file)
143                        (principal-class $default-info-plist-principal-class))
144  (error "Not yet implemented"))
146;;; READ-INFO-PLIST info-path
147;;; returns a newly-created NSDictionary with the contents
148;;; of the plist file at INFO-PATH
149(defun read-info-plist (info-path)
150  (let* ((info-path (pathname info-path)) ; make sure it's a pathname to start
151         (verified-path (probe-file info-path)))
152    (assert (and verified-path
153                 (string-equal (pathname-type verified-path) "plist"))
154            (info-path)
155            "The input path for READ-INFO-PLIST must be the name of a valid 'plist' file.")
156    (let* ((info-path-str (namestring info-path)))
157      (#/dictionaryWithContentsOfFile: ns:ns-mutable-dictionary 
158                                       info-path-str))))
160;;; WRITE-INFO-PLIST path name package-type bundle-signature
161;;; Reads the Info.plist file of the running IDE application
162;;; into an NSMutableDictionary; sets the name, package-type,
163;;; and bundle-signature from the inputs; writes the changed
164;;; dictionary to a new Info.plist file at PATH.
166;;; TODO: this function is extremely specialized to the case
167;;;       of writing an Info.plist for an app bundle that is
168;;;       copied from the IDE. Should separate the IDE-specific
169;;;       behavior from more general behavior that can be used
170;;;       by the batch builder, which does not depend on the IDE.
171(defun write-info-plist (out-path name package-type bundle-signature
172                         &key main-nib-name)
173  ;; read the Info.plist of the IDE app, change
174  ;; the fields needed, write the results to PATH
175  (assert (or (null main-nib-name)
176              (stringp main-nib-name))
177          (main-nib-name)
178          "The main-nib-name must be a string or NIL, not ~S" main-nib-name)
179  (with-autorelease-pool
180    (let* ((bundle-name-key (%make-nsstring "CFBundleName"))
181           (bundle-name-str (%make-nsstring name))
182           (type-key (%make-nsstring "CFBundlePackageType"))
183           (type-str (%make-nsstring package-type))
184           (sig-key (%make-nsstring "CFBundleSignature"))
185           (sig-str (%make-nsstring bundle-signature))
186           (ide-bundle (#/mainBundle ns:ns-bundle))
187           (ide-bundle-path-nsstring (#/bundlePath ide-bundle))
188           (ide-bundle-path (ensure-directory-pathname 
189                             (lisp-string-from-nsstring ide-bundle-path-nsstring)))
190           (ide-plist-path-str (namestring (path ide-bundle-path 
191                                                 "Contents" "Info.plist")))
192           (info-dict (read-info-plist ide-plist-path-str))
193           (app-name-key (%make-nsstring "CFBundleExecutable"))
194           (app-name-str (%make-nsstring name))
195           (app-plist-path-str (%make-nsstring (namestring out-path))))
196      (#/setValue:forKey: info-dict bundle-name-str bundle-name-key)
197      (#/setValue:forKey: info-dict app-name-str app-name-key)
198      (#/setValue:forKey: info-dict type-str type-key)
199      (#/setValue:forKey: info-dict sig-str sig-key)
200      (when main-nib-name
201        (#/setValue:forKey: info-dict 
202                            (%make-nsstring main-nib-name)
203                            #@"NSMainNibFile"))
204      (#/writeToFile:atomically: info-dict app-plist-path-str #$YES))))
208;;; MAKE-APPLICATION-BUNDLE name package-type bundle-signature project-path
209;;; Build the directory structure of a Cocoa application bundle and
210;;; populate it with the required PkgInfo and Info.plist files.
211(defun make-application-bundle (name package-type bundle-signature project-path
212                                &key main-nib-name)
213  (let* ((app-bundle (path project-path 
214                           (ensure-directory-pathname (concatenate 'string name ".app"))))
215         (contents-dir (path app-bundle (ensure-directory-pathname "Contents")))
216         (macos-dir (path contents-dir (ensure-directory-pathname "MacOS")))
217         (rsrc-dir (path contents-dir  "Resources" 
218                         (ensure-directory-pathname "English.lproj"))))
219    (ensure-directories-exist macos-dir)
220    (ensure-directories-exist rsrc-dir)
221    (write-info-plist (path app-bundle "Contents" "Info.plist")
222                      name package-type bundle-signature :main-nib-name main-nib-name)
223    (write-pkginfo (path app-bundle "Contents" "PkgInfo")
224                   package-type bundle-signature)
225    app-bundle))
Note: See TracBrowser for help on using the repository browser.