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

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

added some error checks to the plist reader

File size: 7.7 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 copy-nibfile (srcnib dest-directory &key (if-exists :overwrite))
21  (setq if-exists (require-type if-exists '(member :overwrite :error)))
22  (let* ((basename (basename srcnib))
23         (dest (path dest-directory basename)))
24    (if (probe-file dest)
25        (case if-exists
26          (:overwrite (progn
27                        (if (directoryp dest)
28                            (recursive-delete-directory dest)
29                            (delete-file dest))))
30          (:error (error "The nibfile '~A' already exists" dest))))
31    (if (directoryp srcnib)
32        (recursive-copy-directory srcnib dest)
33        (copy-file srcnib dest))))
34
35;;; BASENAME path
36;;; returns the final component of a pathname--that is, the
37;;; filename (with type extension) if it names a file, or the
38;;; last directory name if it names a directory
39
40(defun basename (path)
41  ;; first probe to see whether the path exists.  if it does, then
42  ;; PROBE-FILE returns a canonical pathname for it which, among other
43  ;; things, ensures the pathame represents a directory if it's really
44  ;; a directory, and a file if it's really a file
45  (let* ((path (or (probe-file path)
46                   path))
47         (dir (pathname-directory path))
48         (name (pathname-name path))
49         (type (pathname-type path)))
50    (if name
51        (if type
52            (make-pathname :name name :type type)
53            (make-pathname :name name))
54        ;; it's possible to have a pathname with a type but no name
55        ;; e.g. "/Users/foo/.emacs"
56        (if type
57            (make-pathname :type type)
58            (make-pathname :directory (first (last dir)))))))
59
60;;; PATH (&rest components)
61;;; returns a pathname. The input COMPONENTS are treated as
62;;; directory names, each contained in the one to the left, except
63;;; for the last. The last is treated as a directory if it ends
64;;; with a path separator, and a file if it doesn't
65(defun path (&rest components)
66  (if (null components)
67      (pathname "")
68      (if (null (cdr components))
69          (pathname (car components))
70          (merge-pathnames (apply #'path (cdr components))
71                           (ensure-directory-pathname (car components))))))
72
73
74;;; WRITE-PKGINFO path package-type bundle-signature
75;;; Writes a PkgInfo file of the sort used by Cocoa applications
76;;; to identify their package types and signatures. Writes
77;;; PACKAGE-TYPE and BUNDLE-SIGNATURE to the file at PATH,
78;;; clobbering it if it already exists.
79(defun write-pkginfo (path package-type bundle-signature)
80  (with-open-file (out path
81                       :direction :output
82                       :if-does-not-exist :create
83                       :if-exists :supersede)
84    (format out "~A~A" package-type bundle-signature)))
85
86;;; READ-INFO-PLIST info-path
87;;; returns a newly-created NSDictionary with the contents
88;;; of the plist file at INFO-PATH
89(defun read-info-plist (info-path)
90  (let* ((info-path (pathname info-path)) ; make sure it's a pathname to start
91         (verified-path (probe-file info-path)))
92    (assert (and verified-path
93                 (string-equal (pathname-type verified-path) "plist"))
94            (info-path)
95            "The input path for READ-INFO-PLIST must be the name of a valid 'plist' file.")
96    (let* ((info-path-str (namestring info-path)))
97      (#/dictionaryWithContentsOfFile: ns:ns-mutable-dictionary 
98                                       info-path-str))))
99
100;;; WRITE-INFO-PLIST path name package-type bundle-signature
101;;; Reads the Info.plist file of the running IDE application
102;;; into an NSMutableDictionary; sets the name, package-type,
103;;; and bundle-signature from the inputs; writes the changed
104;;; dictionary to a new Info.plist file at PATH.
105;;;
106;;; TODO: this function is extremely specialized to the case
107;;;       of writing an Info.plist for an app bundle that is
108;;;       copied from the IDE. Should separate the IDE-specific
109;;;       behavior from more general behavior that can be used
110;;;       by the batch builder, which does not depend on the IDE.
111(defun write-info-plist (out-path name package-type bundle-signature
112                         &key main-nib-name)
113  ;; read the Info.plist of the IDE app, change
114  ;; the fields needed, write the results to PATH
115  (assert (or (null main-nib-name)
116              (stringp main-nib-name))
117          (main-nib-name)
118          "The main-nib-name must be a string or NIL, not ~S" main-nib-name)
119  (with-autorelease-pool
120    (let* ((bundle-name-key (%make-nsstring "CFBundleName"))
121           (bundle-name-str (%make-nsstring name))
122           (type-key (%make-nsstring "CFBundlePackageType"))
123           (type-str (%make-nsstring package-type))
124           (sig-key (%make-nsstring "CFBundleSignature"))
125           (sig-str (%make-nsstring bundle-signature))
126           (ide-bundle (#/mainBundle ns:ns-bundle))
127           (ide-bundle-path-nsstring (#/bundlePath ide-bundle))
128           (ide-bundle-path (ensure-directory-pathname 
129                             (lisp-string-from-nsstring ide-bundle-path-nsstring)))
130           (ide-plist-path-str (namestring (path ide-bundle-path 
131                                                 "Contents" "Info.plist")))
132           (info-dict (#/dictionaryWithContentsOfFile: ns:ns-mutable-dictionary 
133                                                       ide-plist-path-str))
134           (app-name-key (%make-nsstring "CFBundleExecutable"))
135           (app-name-str (%make-nsstring name))
136           (app-plist-path-str (%make-nsstring (namestring out-path))))
137      (#/setValue:forKey: info-dict bundle-name-str bundle-name-key)
138      (#/setValue:forKey: info-dict app-name-str app-name-key)
139      (#/setValue:forKey: info-dict type-str type-key)
140      (#/setValue:forKey: info-dict sig-str sig-key)
141      (when main-nib-name
142        (#/setValue:forKey: info-dict 
143                            (%make-nsstring main-nib-name)
144                            #@"NSMainNibFile"))
145      (#/writeToFile:atomically: info-dict app-plist-path-str #$YES))))
146
147
148
149;;; MAKE-APPLICATION-BUNDLE name package-type bundle-signature project-path
150;;; Build the directory structure of a Cocoa application bundle and
151;;; populate it with the required PkgInfo and Info.plist files.
152(defun make-application-bundle (name package-type bundle-signature project-path
153                                &key main-nib-name)
154  (let* ((app-bundle (path project-path 
155                           (ensure-directory-pathname (concatenate 'string name ".app"))))
156         (contents-dir (path app-bundle (ensure-directory-pathname "Contents")))
157         (macos-dir (path contents-dir (ensure-directory-pathname "MacOS")))
158         (rsrc-dir (path contents-dir  "Resources" 
159                         (ensure-directory-pathname "English.lproj"))))
160    (ensure-directories-exist macos-dir)
161    (ensure-directories-exist rsrc-dir)
162    (write-info-plist (path app-bundle "Contents" "Info.plist")
163                      name package-type bundle-signature :main-nib-name main-nib-name)
164    (write-pkginfo (path app-bundle "Contents" "PkgInfo")
165                   package-type bundle-signature)
166    app-bundle))
Note: See TracBrowser for help on using the repository browser.