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

Last change on this file since 7351 was 7351, checked in by mikel, 14 years ago

fixed pathname bug in builder-utilities

File size: 8.3 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;;; returns the character used to separate elements of a pathname
22;;; on this platform.
23;;; TODO: add conditional compiles to support platforms where
24;;;       the path separator is not "/" (if we ever care about that)
25(defun pathname-separator () #\/)
28;;; Returns the input pathname P, but ensures that it ends with a
29;;; path separator, so that it will be parsed as a directory
30(defmethod ensure-directory-pathname ((p string))
31  (let ((pstr (namestring p)))
32    (if (char= (pathname-separator)
33               (elt pstr (1- (length pstr))))
34        p
35        (pathname (concatenate 'string p (string (pathname-separator)))))))
37(defmethod ensure-directory-pathname ((p pathname)) 
38  (ensure-directory-pathname (namestring p)))
40;;; BASENAME path
41;;; returns the final component of a pathname--that is, the
42;;; filename (with type extension) if it names a file, or the
43;;; last directory name if it names a directory
44;;; TODO: perhaps BASENAME should check the file or directory
45;;;       named by PATH and ensure that, if the named file
46;;;       or directory exists, then the choice of returning
47;;;       a file or directory is based on what the actual target
48;;;       is, rather than on what the text of PATH suggests?
50(defun basename (path)
51  (let* ((dir (pathname-directory path))
52         (name (pathname-name path))
53         (type (pathname-type path)))
54    (if name
55        (if type
56            (make-pathname :name name :type type)
57            (make-pathname :name name))
58        (make-pathname :directory (first (last dir))))))
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))))))
74;;; RECURSIVE-COPY-DIRECTORY source-path dest-path
75;;; Copies the contents of the SOURCE-PATH to the DEST-PATH.
77;;; TODO: - add an ignore-list ability, so I can prevent
78;;;         this function from copying CVS and .svn directories
79;;;       - add some flags to control what do do if the dest
80;;;         already exists, and that sort of thing. Currently,
81;;;         this function just clobbers naything that is already
82;;;         in DEST-PATH
83(defun recursive-copy-directory (source-path dest-path)
84  (ensure-directories-exist (ensure-directory-pathname dest-path))
85  (let ((files (directory (path source-path "*.*") :directories nil :files t))
86        (subdirs (directory (path source-path "*.*") :directories t :files nil)))
87;    (format t "~%files = ~S" files)
88;    (format t "~%subdirs = ~S~%" subdirs)
89    (dolist (f files)
90      (let* ((src-name (file-namestring f))
91             (dest-file (path dest-path src-name)))
92        (ccl:copy-file f dest-file
93                       :if-exists :supersede
94                       :preserve-attributes t)))
95    (dolist (d subdirs)
96      (let* ((subdir-name (first (last (pathname-directory d))))
97             (dest-dir (ensure-directory-pathname (path dest-path subdir-name))))
98        (recursive-copy-directory d dest-dir)))
99    dest-path
100    ))
102;;; WRITE-PKGINFO path package-type bundle-signature
103;;; Writes a PkgInfo file of the sort used by Cocoa applications
104;;; to identify their package types and signatures. Writes
105;;; PACKAGE-TYPE and BUNDLE-SIGNATURE to the file at PATH,
106;;; clobbering it if it already exists.
107(defun write-pkginfo (path package-type bundle-signature)
108  (with-open-file (out path
109                       :direction :output
110                       :if-does-not-exist :create
111                       :if-exists :supersede)
112    (format out "~A~A" package-type bundle-signature)))
114;;; WRITE-INFO-PLIST path name package-type bundle-signature
115;;; Reads the Info.plist file of the running IDE application
116;;; into an NSMutableDictionary; sets the name, package-type,
117;;; and bundle-signature from the inputs; writes the changed
118;;; dictionary to a new Info.plist file at PATH.
120;;; TODO: this function is extremely specialized to the case
121;;;       of writing an Info.plist for an app bundle that is
122;;;       copied from the IDE. Should separate the IDE-specific
123;;;       behavior from more general behavior that can be used
124;;;       by the batch builder, which does not depend on the IDE.
125(defun write-info-plist (path name package-type bundle-signature
126                         &key main-nib-name)
127  ;; read the Info.plist of the IDE app, change
128  ;; the fields needed, write the results to PATH
129  (assert (or (null main-nib-name)
130              (stringp main-nib-name))
131          (main-nib-name)
132          "The main-nib-name must be a string or NIL, not ~S" main-nib-name)
133  (with-autorelease-pool
134    (let* ((bundle-name-key (%make-nsstring "CFBundleName"))
135           (bundle-name-str (%make-nsstring name))
136           (type-key (%make-nsstring "CFBundlePackageType"))
137           (type-str (%make-nsstring package-type))
138           (sig-key (%make-nsstring "CFBundleSignature"))
139           (sig-str (%make-nsstring bundle-signature))
140           (ide-bundle (#/mainBundle ns:ns-bundle))
141           (ide-bundle-path-nsstring (#/bundlePath ide-bundle))
142           (ide-bundle-path (pathname 
143                             (ensure-directory-pathname 
144                              (lisp-string-from-nsstring ide-bundle-path-nsstring))))
145           (ide-plist-path-str (namestring (path ide-bundle-path 
146                                                 "Contents" "Info.plist")))
147           (info-dict (#/dictionaryWithContentsOfFile: ns:ns-mutable-dictionary 
148                                                       ide-plist-path-str))
149           (app-name-key (%make-nsstring "CFBundleExecutable"))
150           (app-name-str (%make-nsstring name))
151           (app-plist-path-str (%make-nsstring (namestring path))))
152      (#/setValue:forKey: info-dict bundle-name-str bundle-name-key)
153      (#/setValue:forKey: info-dict app-name-str app-name-key)
154      (#/setValue:forKey: info-dict type-str type-key)
155      (#/setValue:forKey: info-dict sig-str sig-key)
156      (when main-nib-name
157        (#/setValue:forKey: info-dict 
158                            (%make-nsstring main-nib-name)
159                            #@"NSMainNibFile"))
160      (#/writeToFile:atomically: info-dict app-plist-path-str #$YES))))
162;;; MAKE-APPLICATION-BUNDLE name package-type bundle-signature project-path
163;;; Build the directory structure of a Cocoa application bundle and
164;;; populate it with the required PkgInfo and Info.plist files.
165(defun make-application-bundle (name package-type bundle-signature project-path
166                                &key main-nib-name)
167  (let* ((app-bundle (path project-path 
168                           (ensure-directory-pathname (concatenate 'string name ".app"))))
169         (contents-dir (path app-bundle (ensure-directory-pathname "Contents")))
170         (macos-dir (path contents-dir (ensure-directory-pathname "MacOS")))
171         (rsrc-dir (path contents-dir  "Resources" 
172                         (ensure-directory-pathname "English.lproj"))))
173    (ensure-directories-exist macos-dir)
174    (ensure-directories-exist rsrc-dir)
175    (write-info-plist (path app-bundle "Contents" "Info.plist")
176                      name package-type bundle-signature :main-nib-name main-nib-name)
177    (write-pkginfo (path app-bundle "Contents" "PkgInfo")
178                   package-type bundle-signature)
179    app-bundle))
Note: See TracBrowser for help on using the repository browser.