Changeset 15200


Ignore:
Timestamp:
Feb 8, 2012, 10:17:31 PM (7 years ago)
Author:
rme
Message:

Move the fake-cfbundle-path crud out of the Objective-C
bridge directory.

Location:
trunk/source
Files:
1 deleted
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/ide-bundle.lisp

    r15110 r15200  
    9797  )
    9898
     99;;; Before loading any Cocoa code which depends on CFBundle/NSBundle
     100;;; being able to find an application bundle, it -may- be neccessary
     101;;; to point the environment variable "CFProcessPath" to some file
     102;;; that's where the bundle's executable would be.
     103;;; This should only be necessary if the current application isn't
     104;;; already "inside a bundle".  If it is necessary, it has to happen
     105;;; before the CoreFoundation library's initialized.
     106
     107(defun fake-cfbundle-path (bundle-root info-plist-proto-path bundle-prefix  bundle-suffix install-frameworks install-libraries #+windows-target icon-path)
     108  (let* ((kernel-name (standard-kernel-name))
     109         (translated-root (translate-logical-pathname bundle-root))
     110         (bundle-name (let* ((name (if (directory-pathname-p translated-root)
     111                                       (car (last (pathname-directory translated-root)))
     112                                       (file-namestring translated-root)))
     113                             (len (length name)))
     114                        (if (and (> len 4)
     115                                 (string-equal name ".app" :start1 (- len 4)))
     116                                  (subseq name 0 (- len 4))
     117                                  name)))
     118         (bundle-id (concatenate 'string bundle-prefix "." (or bundle-suffix bundle-name)))
     119         (bundle-version (multiple-value-bind (os bits cpu)
     120                             (ccl::host-platform)
     121                           (declare (ignore os))
     122                           (format nil "~d (~a~d)" *openmcl-svn-revision* cpu bits)))
     123         (needles `(("OPENMCL-KERNEL" . ,kernel-name)
     124                    ("OPENMCL-NAME" . ,bundle-name)
     125                    ("OPENMCL-IDENTIFIER" . ,bundle-id)
     126                    ("OPENMCL-VERSION" . ,bundle-version)
     127                    ("OPENMCL-MAJOR-VERSION" . ,(format nil "~d" *openmcl-major-version*))
     128                    ("OPENMCL-MINOR-VERSION" . ,(format nil "~d" *openmcl-minor-version*))
     129                    ("OPENMCL-REVISION" . ,(if *openmcl-revision* (format nil "-~a" *openmcl-revision*) ""))
     130                    ("CURRENT-YEAR" . ,(format nil "~a" (nth-value 5 (decode-universal-time (get-universal-time)))))))
     131         (executable-dir (merge-pathnames
     132                           (make-pathname :directory (format nil "Contents/~a/"
     133                                                             #+windows-target
     134                                                             "Windows"
     135                                                             #+darwin-target
     136                                                             "MacOS"
     137                                                             #-(or windows-target darwin-target) "Unknown"))
     138                           translated-root))
     139         (executable-path (merge-pathnames executable-dir (make-pathname :name kernel-name :defaults nil))))
     140    (unless (probe-file info-plist-proto-path)
     141      (error "Can't find Info.plist prototype in ~s" info-plist-proto-path))
     142    (with-open-file (in info-plist-proto-path
     143                        :direction :input
     144                        :external-format :utf-8)
     145      (with-open-file (out (merge-pathnames
     146                            (make-pathname :directory "Contents/"
     147                                           :name "Info"
     148                                           :type "plist")
     149                            translated-root)
     150                           :direction :output
     151                           :if-does-not-exist :create
     152                           :if-exists :supersede
     153                           :external-format :utf-8)
     154        (do* ((line (read-line in nil nil) (read-line in nil nil)))
     155             ((null line))
     156          (dolist (needle needles)
     157            (let* ((pos (search (car needle) line)))
     158              (when pos
     159                (setq line
     160                      (concatenate 'string
     161                                   (subseq line 0 pos)
     162                                   (cdr needle)
     163                                   (subseq line (+ pos (length (car needle)))))))))
     164          (write-line line out))))
     165   
     166    (touch executable-path)
     167    (dolist (lib install-libraries)
     168      (copy-file lib executable-dir :preserve-attributes t :if-exists :supersede))
     169    (when install-frameworks
     170      (flet ((subdir (framework target)
     171               (ensure-directory-pathname (make-pathname :name (car (last (pathname-directory framework))) :defaults target)))
     172             (ignore-test (p)
     173               (let ((source-ignore '(".svn" "cvs" ".cvsignore")))
     174                 (flet ((backup-p (name)
     175                          (and (stringp name)
     176                               (let ((len (length name)))
     177                                 (and (> len 0)
     178                                      (or (eql (aref name (1- len)) #\~)
     179                                          (eql (aref name 0) #\#)))))))
     180                   (not (or (member (car (last (pathname-directory p))) source-ignore
     181                                    :test #'equalp)
     182                            (backup-p (file-namestring p))
     183                            (member (file-namestring p) source-ignore :test #'equalp)))))))
     184        (dolist (framework install-frameworks)
     185          (recursive-copy-directory framework (subdir framework executable-dir)
     186                                    :if-exists :overwrite :test #'ignore-test))))
     187    #+windows-target
     188    (copy-file icon-path (merge-pathnames
     189                          (make-pathname :directory "Contents/Resources/"
     190                                         :name bundle-name
     191                                         :type "ico")
     192                          translated-root)
     193               :preserve-attributes t :if-exists :supersede)
     194    (setenv "CFProcessPath" (native-translated-namestring executable-path))))
     195
     196
     197
     198
    99199(progn
    100   (require "FAKE-CFBUNDLE-PATH")
    101200  (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"))
     201  (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 TracChangeset for help on using the changeset viewer.