source: tags/1.2/source/objc-bridge/fake-cfbundle-path.lisp

Last change on this file was 7505, checked in by rme, 13 years ago

Put the value of *openmcl-svn-revision* into Info.plist as
the value of CFBundleVersion. (This shows up in the about
box.)

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.7 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)
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 "." bundle-name))
25         (bundle-version (format nil "~d" *openmcl-svn-revision*))
26         (needles `(("OPENMCL-KERNEL" . ,kernel-name)
27                    ("OPENMCL-NAME" . ,bundle-name)
28                    ("OPENMCL-IDENTIFIER" . ,bundle-id)
29                    ("OPENMCL-VERSION" . ,bundle-version)))
30         (executable-path (merge-pathnames
31                           (make-pathname :directory "Contents/MacOS/"
32                                          :name kernel-name)
33                           translated-root)))
34    (unless (probe-file info-plist-proto-path)
35      (error "Can't find Info.plist prototype in ~s" info-plist-proto-path))
36    (with-open-file (in info-plist-proto-path 
37                        :direction :input
38                        :external-format :utf-8)
39      (with-open-file (out (merge-pathnames
40                            (make-pathname :directory "Contents/"
41                                           :name "Info"
42                                           :type "plist")
43                            translated-root)
44                           :direction :output
45                           :if-does-not-exist :create
46                           :if-exists :supersede
47                           :external-format :utf-8)
48        (do* ((line (read-line in nil nil) (read-line in nil nil)))
49             ((null line))
50          (dolist (needle needles)
51            (let* ((pos (search (car needle) line)))
52              (when pos
53                (setq line
54                      (concatenate 'string
55                                   (subseq line 0 pos)
56                                   (cdr needle)
57                                   (subseq line (+ pos (length (car needle)))))))))
58          (write-line line out))))
59    (touch executable-path)
60    (setenv "CFProcessPath" (native-translated-namestring executable-path))))
Note: See TracBrowser for help on using the repository browser.