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

Last change on this file since 12834 was 12834, checked in by palter, 10 years ago

Add :if-exists :supersede when copying Windows alt console application.

File size: 5.0 KB
Line 
1;;-*-Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 2007 Clozure Associates
4;;;
5
6(in-package "CCL")
7
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.
11
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))))
63
64;;; This runs "make install" to generate
65;;; "ccl:cocoa-ide;altconsole;AltConsole.app",
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  #-cocotron
73  (let* ((altconsole-path (merge-pathnames ";Contents;Resources;AltConsole.app;" bundle-path))
74         (build-directory "ccl:cocoa-ide;altconsole;")
75         (build-bundle-path "ccl:cocoa-ide;altconsole;AltConsole.app")
76         (make-output (make-string-output-stream))
77         (args `("-C" ,(native-translated-namestring build-directory) "install")))
78    (recursive-delete-directory altconsole-path :if-does-not-exist nil)
79    (unwind-protect
80         (multiple-value-bind (exit-status code)
81             (external-process-status
82              (run-program "make" args :output make-output :error make-output))
83           (unless (and (eq exit-status :exited) (zerop code))
84             (format t "~&'make install' of AltConsole.app failed:~&~a"
85                     (get-output-stream-string make-output))
86             (return-from install-altconsole nil)))
87      (close make-output))
88    ;;(ensure-directories-exist altconsole-path)
89    (recursive-copy-directory build-bundle-path altconsole-path)
90    (ccl::touch altconsole-path)
91    t)
92  #+cocotron
93  (let* ((path (probe-file "ccl:cocotron;WaltConsole;WaltConsole.exe")))
94    (when path
95      (copy-file path (merge-pathnames ";Contents;Resources;WaltConsole.exe" bundle-path)
96                 :preserve-attributes t :if-exists :supersede)
97      t))
98  )
99
100(progn
101  (require "FAKE-CFBUNDLE-PATH")
102  (create-ide-bundle *cocoa-application-path*)
103  (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* #+windows-target "ccl:cocoa-ide;ide-contents;resources;openmcl-icon.ico"))
Note: See TracBrowser for help on using the repository browser.