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

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

Use file-namestring to properly ignore ".cvsignore" files

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 (file-namestring p))
31                      (member (file-namestring p) source-ignore :test #'equalp))))))
32    (let* ((source-dir (ensure-directory-pathname source))
33           (target-dir (ensure-directory-pathname bundle-path))
34           (contents-dir (subdir target-dir "Contents")))
35      (recursive-copy-directory source-dir contents-dir :if-exists if-exists :test #'ignore-test)
36      (when copy-headers
37        (let* ((subdirs (ccl::cdb-subdirectory-path))
38               (ccl-headers (make-pathname :host "ccl" :directory `(:absolute ,@subdirs)))
39               (dest-headers (make-pathname :host (pathname-host contents-dir)
40                                            :directory (append (pathname-directory contents-dir)
41                                                               (cons "Resources" subdirs)))))
42          (recursive-copy-directory ccl-headers dest-headers :if-exists if-exists :test #'ignore-test)))
43      (when install-altconsole
44        (install-altconsole bundle-path))
45      ;; Is this necessary?
46      ;; At one point in the past, it was necessary for the bundle to
47      ;; contain an executable file whose name matched what was specified
48      ;; in its Info.plist file.  That executable file could be practically
49      ;; anything, as long as its executable bits were set.
50      (let* ((image-name (ccl::standard-kernel-name))
51             #+ignore
52             (ccl-image (make-pathname :name image-name :host "ccl"))
53             (dest-image (make-pathname :name image-name
54                                        :defaults (subdir contents-dir #+darwin-target "MacOS" #+windows-target "Windows"))))
55        (ensure-directories-exist dest-image)
56        #+no
57        (copy-file ccl-image dest-image :if-exists :supersede :preserve-attributes t)
58        (ccl::touch dest-image)
59        )
60      #-windows-target
61      (ccl::touch target-dir))))
62
63;;; This runs "make install" to generate
64;;; "ccl:cocoa-ide;altconsole;AltConsole.app",
65;;; then copies that application bundle into the "Resources" directory
66;;; of the target bundle.  It might be simpler to just have "make install"
67;;; put things in the right place, but "the right place" is likely to
68;;; be a pathname that contains a space. Quoting such a pathname -
69;;; and figuring out how to get make to do so - is left as an exercise.
70(defun install-altconsole (bundle-path)
71  #-cocotron
72  (let* ((altconsole-path (merge-pathnames ";Contents;Resources;AltConsole.app;" bundle-path))
73         (build-directory "ccl:cocoa-ide;altconsole;")
74         (build-bundle-path "ccl:cocoa-ide;altconsole;AltConsole.app")
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 AltConsole.app 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)
91  #+cocotron
92  (let* ((path (probe-file "ccl:cocotron;WaltConsole;WaltConsole.exe")))
93    (when path
94      (copy-file path (merge-pathnames ";Contents;Resources;WaltConsole.exe" bundle-path)
95                 :preserve-attributes t :if-exists :supersede)
96      t))
97  )
98
99(progn
100  (require "FAKE-CFBUNDLE-PATH")
101  (create-ide-bundle *cocoa-application-path*)
102  (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.