source: trunk/source/objc-bridge/fake-cfbundle-path.lisp @ 13537

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

Don't copy SVN files into the bundle

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.1 KB
Line 
1;;;-*-Mode: LISP; Package: CCL -*-
2
3(in-package "CCL")
4
5;;; Before loading any Cocoa code which depends on CFBundle/NSBundle
6;;; being able to find an application bundle, it -may- be neccessary
7;;; to point the environment variable "CFProcessPath" to some file
8;;; that's where the bundle's executable would be.
9;;; This should only be necessary if the current application isn't
10;;; already "inside a bundle".  If it is necessary, it has to happen
11;;; before the CoreFoundation library's initialized.
12
13(defun fake-cfbundle-path (bundle-root info-plist-proto-path bundle-prefix  bundle-suffix install-frameworks install-libraries #+windows-target icon-path)
14  (let* ((kernel-name (standard-kernel-name))
15         (translated-root (translate-logical-pathname bundle-root))
16         (bundle-name (let* ((name (if (directory-pathname-p translated-root)
17                                       (car (last (pathname-directory translated-root)))
18                                       (file-namestring translated-root)))
19                             (len (length name)))
20                        (if (and (> len 4)
21                                 (string-equal name ".app" :start1 (- len 4)))
22                                  (subseq name 0 (- len 4))
23                                  name)))
24         (bundle-id (concatenate 'string bundle-prefix "." (or bundle-suffix bundle-name)))
25         (bundle-version (multiple-value-bind (os bits cpu)
26                             (ccl::host-platform)
27                           (declare (ignore os))
28                           (format nil "~d (~a~d)" *openmcl-svn-revision* cpu bits)))
29         (needles `(("OPENMCL-KERNEL" . ,kernel-name)
30                    ("OPENMCL-NAME" . ,bundle-name)
31                    ("OPENMCL-IDENTIFIER" . ,bundle-id)
32                    ("OPENMCL-VERSION" . ,bundle-version)))
33         (executable-dir (merge-pathnames
34                           (make-pathname :directory (format nil "Contents/~a/"
35                                                             #+windows-target
36                                                             "Windows"
37                                                             #+darwin-target
38                                                             "MacOS"
39                                                             #-(or windows-target darwin-target) "Unknown"))
40                           translated-root))
41         (executable-path (merge-pathnames executable-dir (make-pathname :name kernel-name :defaults nil))))
42    (unless (probe-file info-plist-proto-path)
43      (error "Can't find Info.plist prototype in ~s" info-plist-proto-path))
44    (with-open-file (in info-plist-proto-path 
45                        :direction :input
46                        :external-format :utf-8)
47      (with-open-file (out (merge-pathnames
48                            (make-pathname :directory "Contents/"
49                                           :name "Info"
50                                           :type "plist")
51                            translated-root)
52                           :direction :output
53                           :if-does-not-exist :create
54                           :if-exists :supersede
55                           :external-format :utf-8)
56        (do* ((line (read-line in nil nil) (read-line in nil nil)))
57             ((null line))
58          (dolist (needle needles)
59            (let* ((pos (search (car needle) line)))
60              (when pos
61                (setq line
62                      (concatenate 'string
63                                   (subseq line 0 pos)
64                                   (cdr needle)
65                                   (subseq line (+ pos (length (car needle)))))))))
66          (write-line line out))))
67   
68    (touch executable-path)
69    (dolist (lib install-libraries)
70      (copy-file lib executable-dir :preserve-attributes t :if-exists :supersede))
71    (when install-frameworks
72      (flet ((subdir (framework target)
73               (ensure-directory-pathname (make-pathname :name (car (last (pathname-directory framework))) :defaults target)))
74             (ignore-test (p)
75               (let ((source-ignore '(".svn" "cvs" ".cvsignore")))
76                 (flet ((backup-p (name)
77                          (and (stringp name)
78                               (let ((len (length name)))
79                                 (and (> len 0)
80                                      (or (eql (aref name (1- len)) #\~)
81                                          (eql (aref name 0) #\#)))))))
82                   (not (or (member (car (last (pathname-directory p))) source-ignore
83                                    :test #'equalp)
84                            (backup-p (file-namestring p))
85                            (member (file-namestring p) source-ignore :test #'equalp)))))))
86        (dolist (framework install-frameworks)
87          (recursive-copy-directory framework (subdir framework executable-dir)
88                                    :if-exists :overwrite :test #'ignore-test))))
89    #+windows-target
90    (copy-file icon-path (merge-pathnames
91                          (make-pathname :directory "Contents/Resources/"
92                                         :name bundle-name
93                                         :type "ico")
94                          translated-root)
95               :preserve-attributes t :if-exists :supersede)
96    (setenv "CFProcessPath" (native-translated-namestring executable-path))))
Note: See TracBrowser for help on using the repository browser.