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

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

moved load-nibfile to builder-utilities

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