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

Last change on this file since 12820 was 12820, checked in by palter, 11 years ago

Arrange for the CCL icon to appear with the right name so Cocotron will
put it in the title bar of all its windows.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.3 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        (dolist (framework install-frameworks)
75          (recursive-copy-directory framework (subdir framework executable-dir) :if-exists :overwrite))))
76    #+windows-target
77    (copy-file icon-path (merge-pathnames
78                          (make-pathname :directory "Contents/Resources/"
79                                         :name bundle-name
80                                         :type "ico")
81                          translated-root)
82               :preserve-attributes t :if-exists :supersede)
83    (setenv "CFProcessPath" (native-translated-namestring executable-path))))
Note: See TracBrowser for help on using the repository browser.