source: trunk/source/cocoa-ide/ide-bundle.lisp @ 12460

Last change on this file since 12460 was 12460, checked in by gb, 11 years ago

When creating an application bundle, optionally copy specified libraries and framework
resources into the bundle's executable directory.

File size: 4.7 KB
1;;-*-Mode: Lisp; Package: CCL -*-
3;;;   Copyright (C) 2007 Clozure Associates
6(in-package "CCL")
8;;; We need to be able to point the CoreFoundation and Cocoa libraries
9;;; at some bundle very early in the process, so do that before anything
10;;; else.
12(defun create-ide-bundle (bundle-path &key (source "ccl:cocoa-ide;ide-contents;")
13                                           (source-ignore '(".svn" "cvs" ".cvsignore"))
14                                           (copy-headers *cocoa-application-copy-headers-p*)
15                                           (install-altconsole *cocoa-application-install-altconsole*)
16                                           (if-exists :overwrite))
17  ;; TODO: Right now if the bundle exists, we leave alone any files that we don't replace.
18  ;; I'd like :if-exists :supersede mean to remove such files, for clean builds, but
19  ;; recursive-copy-directory doesn't support :if-exists :supersede yet...
20  (flet ((subdir (dir sub)
21           (ensure-directory-pathname (make-pathname :name sub :defaults dir)))
22         (ignore-test (p)
23           (flet ((backup-p (name)
24                    (and (stringp name)
25                         (let ((len (length name)))
26                           (and (> len 0)
27                                (or (eql (aref name (1- len)) #\~)
28                                    (eql (aref name 0) #\#)))))))
29             (not (or (member (car (last (pathname-directory p))) source-ignore :test #'equalp)
30                      (backup-p (pathname-name p))
31                      (backup-p (pathname-type p))
32                      (member (pathname-name p) source-ignore :test #'equalp))))))
33    (let* ((source-dir (ensure-directory-pathname source))
34           (target-dir (ensure-directory-pathname bundle-path))
35           (contents-dir (subdir target-dir "Contents")))
36      (recursive-copy-directory source-dir contents-dir :if-exists if-exists :test #'ignore-test)
37      (when copy-headers
38        (let* ((subdirs (ccl::cdb-subdirectory-path))
39               (ccl-headers (make-pathname :host "ccl" :directory `(:absolute ,@subdirs)))
40               (dest-headers (make-pathname :host (pathname-host contents-dir)
41                                            :directory (append (pathname-directory contents-dir)
42                                                               (cons "Resources" subdirs)))))
43          (recursive-copy-directory ccl-headers dest-headers :if-exists if-exists :test #'ignore-test)))
44      (when install-altconsole
45        (install-altconsole bundle-path))
46      ;; Is this necessary?
47      ;; At one point in the past, it was necessary for the bundle to
48      ;; contain an executable file whose name matched what was specified
49      ;; in its Info.plist file.  That executable file could be practically
50      ;; anything, as long as its executable bits were set.
51      (let* ((image-name (ccl::standard-kernel-name))
52             #+ignore
53             (ccl-image (make-pathname :name image-name :host "ccl"))
54             (dest-image (make-pathname :name image-name
55                                        :defaults (subdir contents-dir #+darwin-target "MacOS" #+windows-target "Windows"))))
56        (ensure-directories-exist dest-image)
57        #+no
58        (copy-file ccl-image dest-image :if-exists :supersede :preserve-attributes t)
59        (ccl::touch dest-image)
60        )
61      #-windows-target
62      (ccl::touch target-dir))))
64;;; This runs "make install" to generate
65;;; "ccl:cocoa-ide;altconsole;",
66;;; then copies that application bundle into the "Resources" directory
67;;; of the target bundle.  It might be simpler to just have "make install"
68;;; put things in the right place, but "the right place" is likely to
69;;; be a pathname that contains a space. Quoting such a pathname -
70;;; and figuring out how to get make to do so - is left as an exercise.
71(defun install-altconsole (bundle-path)
72  (let* ((altconsole-path (merge-pathnames ";Contents;Resources;;" bundle-path))
73         (build-directory "ccl:cocoa-ide;altconsole;")
74         (build-bundle-path "ccl:cocoa-ide;altconsole;")
75         (make-output (make-string-output-stream))
76         (args `("-C" ,(native-translated-namestring build-directory) "install")))
77    (recursive-delete-directory altconsole-path :if-does-not-exist nil)
78    (unwind-protect
79         (multiple-value-bind (exit-status code)
80             (external-process-status
81              (run-program "make" args :output make-output :error make-output))
82           (unless (and (eq exit-status :exited) (zerop code))
83             (format t "~&'make install' of failed:~&~a"
84                     (get-output-stream-string make-output))
85             (return-from install-altconsole nil)))
86      (close make-output))
87    ;;(ensure-directories-exist altconsole-path)
88    (recursive-copy-directory build-bundle-path altconsole-path)
89    (ccl::touch altconsole-path)
90    t))
93  (require "FAKE-CFBUNDLE-PATH")
94  (create-ide-bundle *cocoa-application-path*)
95  (ccl::fake-cfbundle-path *cocoa-application-path* "ccl:cocoa-ide;Info.plist-proto" "com.clozure" *cocoa-application-bundle-suffix* *cocoa-application-frameworks* *cocoa-application-libraries*))
Note: See TracBrowser for help on using the repository browser.