Changeset 6743

Timestamp:

Jun 16, 2007, 7:15:23 PM (17 years ago)

Author:

Gary Byers

Message:

Use a prototype info.plist, touch the kernel, etc.

File:

• branches/ide-1.0/ccl/examples/fake-cfbundle-path.lisp (modified) (1 diff)

branches/ide-1.0/ccl/examples/fake-cfbundle-path.lisp

@@ -11 +11 @@
 ;;; before the CoreFoundation library's initialized.
 
-(defun fake-cfbundle-path (executable-path)
-  (when executable-path
-    (unless (probe-file executable-path)
-      (cerror "Create an empty file."
-              "The specified executable path (~s) doesn't exist"
-              executable-path)
-      (create-file executable-path))
-    (let* ((fakepath
-            (native-translated-namestring executable-path)))
-      (setenv "CFProcessPath" fakepath))))
+(defun fake-cfbundle-path (bundle-root)
+  (let* ((kernel-name (standard-kernel-name))
+         (needle "OPENMCL-KERNEL")
+         (translated-root (translate-logical-pathname bundle-root))
+         (executable-path (merge-pathnames
+                           (make-pathname :directory "Contents/MacOS/"
+                                          :name kernel-name)
+                           translated-root))
+         (info-plist-proto-path (merge-pathnames "Contents/Info.plist-proto"
+                                                 translated-root)))
+    (unless (probe-file info-plist-proto-path)
+      (error "Can't find Info.plist prototype in ~s" info-plist-proto-path))
+    (with-open-file (in info-plist-proto-path 
+                        :direction :input
+                        :external-format :utf-8)
+      (with-open-file (out (make-pathname :directory (pathname-directory info-plist-proto-path)
+                                          :name "Info"
+                                          :type "plist")
+                           :direction :output
+                           :if-does-not-exist :create
+                           :if-exists :supersede
+                           :external-format :utf-8)
+        (do* ((line (read-line in nil nil) (read-line in nil nil)))
+             ((null line))
+          (let* ((pos (search needle line)))
+            (when pos
+              (setq line
+                    (concatenate 'string
+                                 (subseq line 0 pos)
+                                 kernel-name
+                                 (subseq line (+ pos (length needle)))))))
+          (write-line line out))))
+    (touch executable-path)
+    (setenv "CFProcessPath" (native-translated-namestring executable-path))))