source: trunk/source/cocoa-ide/builder-utilities.lisp @ 9309

;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: cl-user -*-
;;;; ***********************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name:          builder-utilities.lisp
;;;; Version:       0.9
;;;; Project:       bosco - Cocoa application builder
;;;; Purpose:       utilities used by both batch and interactive builders
;;;;
;;;; ***********************************************************************

(in-package :ccl)

;;; ABOUT
;;; ------------------------------------------------------------------------
;;; Builder-utilities contains several functions used by OpenMCL
;;; application-building tools for building and copying bundles,
;;; resource directories, and magic files used by OSX applications.

;;; DEFAULTS
;;; Some useful default values for use when creating application bundles

(defparameter $default-application-bundle-name "MyApplication")
(defparameter $default-application-type-string "APPL")
(defparameter $default-application-creator-string "OMCL")
(defparameter $default-application-version-number "1.0")

;;; defaults related to Info.plist files

(defparameter $default-info-plist-development-region "English")
(defparameter $default-info-plist-executable $default-application-bundle-name)
(defparameter $default-info-plist-getInfo-string (format nil "~A Copyright ~C 2008" 
                                                         $default-application-version-number
                                                         #\Copyright_Sign))
(defparameter $default-info-plist-help-book-folder (format nil "~AHelp" $default-application-bundle-name))
(defparameter $default-info-plist-help-book-name (format nil "~A Help" $default-application-bundle-name))
(defparameter $default-info-plist-icon-file (format nil "~A.icns" $default-application-bundle-name))
(defparameter $default-info-plist-bundle-identifier (format nil "com.clozure.ccl.apps.~A" 
                                                            (string-downcase $default-application-bundle-name)))
(defparameter $default-info-dictionary-version "6.0")
(defparameter $default-info-plist-bundle-name $default-application-bundle-name)
(defparameter $default-info-plist-bundle-package-type "APPL")
(defparameter $default-info-plist-short-version-string $default-application-version-number)
(defparameter $default-info-plist-bundle-signature "OMCL")
(defparameter $default-info-plist-version $default-application-version-number)
(defparameter $default-info-plist-has-localized-display-name 0)
(defparameter $default-info-plist-minimum-system-version "10.5")
(defparameter $default-info-plist-main-nib-file "MainMenu")
(defparameter $default-info-plist-principal-class "LispApplication")


;;; COPY-NIBFILE (srcnib dest-directory &key (if-exists :overwrite))
;;; Copies a nibfile (which may in fact be a directory) to the
;;; destination path (which may already exist, and may need to
;;; be overwritten

(defun copy-nibfile (srcnib dest-directory &key (if-exists :overwrite))
  (setq if-exists (require-type if-exists '(member :overwrite :error)))
  (let* ((basename (basename srcnib))
         (dest (path dest-directory basename)))
    (if (probe-file dest)
        (case if-exists
          (:overwrite (progn
                        (if (directoryp dest)
                            (recursive-delete-directory dest)
                            (delete-file dest))))
          (:error (error "The nibfile '~A' already exists" dest))))
    (if (directoryp srcnib)
        (recursive-copy-directory srcnib dest)
        (copy-file srcnib dest))))

;;; BASENAME path
;;; returns the final component of a pathname--that is, the
;;; filename (with type extension) if it names a file, or the
;;; last directory name if it names a directory

(defun basename (path)
  ;; first probe to see whether the path exists.  if it does, then
  ;; PROBE-FILE returns a canonical pathname for it which, among other
  ;; things, ensures the pathame represents a directory if it's really
  ;; a directory, and a file if it's really a file
  (let* ((path (or (probe-file path)
                   path))
         (dir (pathname-directory path))
         (name (pathname-name path))
         (type (pathname-type path)))
    (if name
        (if type
            (make-pathname :name name :type type)
            (make-pathname :name name))
        ;; it's possible to have a pathname with a type but no name
        ;; e.g. "/Users/foo/.emacs"
        (if type
            (make-pathname :type type)
            (make-pathname :directory (first (last dir)))))))

;;; PATH (&rest components)
;;; returns a pathname. The input COMPONENTS are treated as 
;;; directory names, each contained in the one to the left, except
;;; for the last. The last is treated as a directory if it ends
;;; with a path separator, and a file if it doesn't
(defun path (&rest components)
  (if (null components)
      (pathname "")
      (if (null (cdr components))
          (pathname (car components))
          (merge-pathnames (apply #'path (cdr components))
                           (ensure-directory-pathname (car components))))))


;;; WRITE-PKGINFO path package-type bundle-signature
;;; Writes a PkgInfo file of the sort used by Cocoa applications
;;; to identify their package types and signatures. Writes
;;; PACKAGE-TYPE and BUNDLE-SIGNATURE to the file at PATH,
;;; clobbering it if it already exists.
(defun write-pkginfo (path package-type bundle-signature)
  (with-open-file (out path
                       :direction :output
                       :if-does-not-exist :create
                       :if-exists :supersede)
    (format out "~A~A" package-type bundle-signature)))

;;; MAKE-INFO-PLIST
;;; returns a newly-created NSDictionary with contents
;;; specified by the input parameters
(defun make-info-plist (&key
                        (development-region $default-info-plist-development-region)
                        (executable $default-info-plist-executable)
                        (getinfo-string $default-info-plist-getinfo-string)
                        (help-book-folder $default-info-plist-help-book-folder)
                        (help-book-name $default-info-plist-help-book-name)
                        (icon-file $default-info-plist-icon-file)
                        (bundle-identifier $default-info-plist-bundle-identifier)
                        (dictionary-version $default-info-dictionary-version)
                        (bundle-name $default-info-plist-bundle-name)
                        (bundle-package-type $default-info-plist-bundle-package-type)
                        (short-version-string $default-info-plist-short-version-string)
                        (bundle-signature $default-info-plist-bundle-signature)
                        (version $default-info-plist-version)
                        (has-localized-display-name $default-info-plist-has-localized-display-name)
                        (minimum-system-version $default-info-plist-minimum-system-version)
                        (main-nib-file $default-info-plist-main-nib-file)
                        (principal-class $default-info-plist-principal-class))
  (error "Not yet implemented"))

;;; READ-INFO-PLIST info-path
;;; returns a newly-created NSDictionary with the contents
;;; of the plist file at INFO-PATH 
(defun read-info-plist (info-path)
  (let* ((info-path (pathname info-path)) ; make sure it's a pathname to start
         (verified-path (probe-file info-path)))
    (assert (and verified-path
                 (string-equal (pathname-type verified-path) "plist"))
            (info-path)
            "The input path for READ-INFO-PLIST must be the name of a valid 'plist' file.")
    (let* ((info-path-str (namestring info-path)))
      (#/dictionaryWithContentsOfFile: ns:ns-mutable-dictionary 
                                       info-path-str))))

;;; WRITE-INFO-PLIST path name package-type bundle-signature
;;; Reads the Info.plist file of the running IDE application
;;; into an NSMutableDictionary; sets the name, package-type,
;;; and bundle-signature from the inputs; writes the changed
;;; dictionary to a new Info.plist file at PATH.
;;;
;;; TODO: this function is extremely specialized to the case
;;;       of writing an Info.plist for an app bundle that is
;;;       copied from the IDE. Should separate the IDE-specific
;;;       behavior from more general behavior that can be used
;;;       by the batch builder, which does not depend on the IDE.
(defun write-info-plist (out-path name package-type bundle-signature
                         &key main-nib-name)
  ;; read the Info.plist of the IDE app, change
  ;; the fields needed, write the results to PATH
  (assert (or (null main-nib-name)
              (stringp main-nib-name))
          (main-nib-name)
          "The main-nib-name must be a string or NIL, not ~S" main-nib-name)
  (with-autorelease-pool
    (let* ((bundle-name-key (%make-nsstring "CFBundleName"))
           (bundle-name-str (%make-nsstring name))
           (type-key (%make-nsstring "CFBundlePackageType"))
           (type-str (%make-nsstring package-type))
           (sig-key (%make-nsstring "CFBundleSignature"))
           (sig-str (%make-nsstring bundle-signature))
           (ide-bundle (#/mainBundle ns:ns-bundle))
           (ide-bundle-path-nsstring (#/bundlePath ide-bundle))
           (ide-bundle-path (ensure-directory-pathname 
                             (lisp-string-from-nsstring ide-bundle-path-nsstring)))
           (ide-plist-path-str (namestring (path ide-bundle-path 
                                                 "Contents" "Info.plist")))
           (info-dict (read-info-plist ide-plist-path-str))
           (app-name-key (%make-nsstring "CFBundleExecutable"))
           (app-name-str (%make-nsstring name))
           (app-plist-path-str (%make-nsstring (namestring out-path))))
      (#/setValue:forKey: info-dict bundle-name-str bundle-name-key)
      (#/setValue:forKey: info-dict app-name-str app-name-key)
      (#/setValue:forKey: info-dict type-str type-key)
      (#/setValue:forKey: info-dict sig-str sig-key)
      (when main-nib-name
        (#/setValue:forKey: info-dict 
                            (%make-nsstring main-nib-name)
                            #@"NSMainNibFile"))
      (#/writeToFile:atomically: info-dict app-plist-path-str #$YES))))



;;; MAKE-APPLICATION-BUNDLE name package-type bundle-signature project-path
;;; Build the directory structure of a Cocoa application bundle and
;;; populate it with the required PkgInfo and Info.plist files.
(defun make-application-bundle (name package-type bundle-signature project-path
                                &key main-nib-name)
  (let* ((app-bundle (path project-path 
                           (ensure-directory-pathname (concatenate 'string name ".app"))))
         (contents-dir (path app-bundle (ensure-directory-pathname "Contents")))
         (macos-dir (path contents-dir (ensure-directory-pathname "MacOS")))
         (rsrc-dir (path contents-dir  "Resources" 
                         (ensure-directory-pathname "English.lproj"))))
    (ensure-directories-exist macos-dir)
    (ensure-directories-exist rsrc-dir)
    (write-info-plist (path app-bundle "Contents" "Info.plist")
                      name package-type bundle-signature :main-nib-name main-nib-name)
    (write-pkginfo (path app-bundle "Contents" "PkgInfo")
                   package-type bundle-signature)
    app-bundle))