add uti-exports support (thanks to Dave Gurnell for help)

svn: r10129

collects/compiler/embed-unit.ss

@@ -142,6 +142,10 @@
                            (and m
                                 (pair? (cdr m))
                                 (cdr m)))]
+             [uti-exports (let ([m (assq 'uti-exports aux)])
+                            (and m
+                                 (pair? (cdr m))
+                                 (cdr m)))]
              [resource-files (let ([m (assq 'resource-files aux)])
                                (and m
                                     (cdr m)))])
@@ -212,10 +216,25 @@
                              
                              "CFBundleIdentifier" 
                              (format "org.plt-scheme.~a" (path->string name)))]
+                 [new-plist (if uti-exports
+                                (plist-replace
+                                 new-plist
+                                 "UTExportedTypeDeclarations"
+                                 (cons 'array
+                                       (map (lambda (spec)
+                                              (cons
+                                               'dict
+                                               (map (lambda (p)
+                                                      (list
+                                                       'assoc-pair
+                                                       (car p)
+                                                       (cadr p)))
+                                                    spec)))
+                                            uti-exports)))
+                                new-plist)]
                  [new-plist (if file-types
                                 (plist-replace
                                  new-plist                                 
-                                 
                                  "CFBundleDocumentTypes"
                                  (cons 'array
                                        (map (lambda (spec)
@@ -228,7 +247,6 @@
                                                        (cadr p)))
                                                     spec)))
                                             file-types)))                                
-                                
                                 new-plist)])
             (call-with-output-file (build-path dest 
                                                "Contents" 

collects/drscheme/drscheme.utiexports

@@ -0,0 +1,15 @@
+((("UTTypeConformsTo"
+   (array
+    "public.text"
+    "public.plain-text"))
+  ("UTTypeDescription"
+   "PLT Scheme program source")
+  ("UTTypeIdentifier"
+   "org.plt-scheme.source")
+  ("UTTypeTagSpecification"
+   (dict
+    (assoc-pair "com.apple.ostype"
+                "TEXT")
+    (assoc-pair "public.filename-extension"
+                (array "ss"
+                       "scm"))))))

collects/launcher/launcher-unit.ss

@@ -582,7 +582,16 @@
                                     d))])
                          (list
                           (cons 'file-types d)
-                          (cons 'resource-files icon-files))))))))))))))
+                          (cons 'resource-files icon-files))))))))))
+       (let ([l (try 'file-types #".utiexports")])
+         (if (null? l)
+             l
+             (with-handlers ([exn:fail:filesystem? (lambda (x) null)])
+               (with-input-from-file (cdar l)
+                 (lambda () 
+                   (let ([d (read)])
+                     (list
+                      (cons 'uti-exports d))))))))))))
 
 (define (make-mred-program-launcher file collection dest)
   (make-mred-launcher (list "-l-" (string-append collection "/" file))

collects/scribblings/mzc/exe-api.scrbl

@@ -148,7 +148,8 @@ distribution that contains the executable).
 The optional @scheme[#:aux] argument is an association list for
 platform-specific options (i.e., it is a list of pairs where the first
 element of the pair is a key symbol and the second element is the
-value for that key). The currently supported keys are as follows:
+value for that key). See also @scheme[build-aux-from-path]. The
+currently supported keys are as follows:
 
 @itemize{
 
@@ -169,8 +170,17 @@ value for that key). The currently supported keys are as follows:
         association lists, one for each type of file handled by the
         application; each association is a two-element list, where the
         first (key) element is a string recognized by Finder, and the
-        second element is a plist value. See
+        second element is a plist value (see
-        @filepath{drscheme.filetypes} in the @filepath{drscheme}
+        @schememodname[xml/plist]). See @filepath{drscheme.filetypes}
+        in the @filepath{drscheme} collection for an example.}
+
+  @item{@scheme['uti-exports] (Mac OS X) : Provides a list of
+        association lists, one for each @as-index{Uniform Type
+        Identifier} (UTI) exported by the executable; each association
+        is a two-element list, where the first (key) element is a
+        string recognized in a UTI declaration, and the second element
+        is a plist value (see @schememodname[xml/plist]). See
+        @filepath{drscheme.utiexports} in the @filepath{drscheme}
         collection for an example.}
 
   @item{@scheme['resource-files] (Mac OS X) : extra files to copy into
@@ -225,9 +235,6 @@ value for that key). The currently supported keys are as follows:
 
 }
 
-See also @scheme[build-aux-from-path]. The default @scheme[aux] is
-@scheme[null].
-
 If the @scheme[#:collects-path] argument is @scheme[#f], then the
 created executable maintains its built-in (relative) path to the main
 @filepath{collects} directory---which will be the result of

collects/scribblings/mzc/launcher.scrbl

@@ -38,10 +38,10 @@ or directory, it is replaced.
 The optional @scheme[aux] argument is an association list for
 platform-specific options (i.e., it is a list of pairs where the first
 element of the pair is a key symbol and the second element is the
-value for that key). See @scheme[create-embedding-executable] for a
+value for that key). See also @scheme[build-aux-from-path]. See
-list that applies to both stand-alone executables and launchers under
+@scheme[create-embedding-executable] for a list that applies to both
-Windows and Mac OS X MrEd; the following additional associations apply
+stand-alone executables and launchers under Windows and Mac OS X MrEd;
-to launchers:
+the following additional associations apply to launchers:
 
 @itemize{
 
@@ -62,8 +62,6 @@ to launchers:
 
 }
 
-See also @scheme[build-aux-from-path].
-
 For Unix/X, the script created by @scheme[make-mred-launcher] detects
 and handles X Windows flags specially when they appear as the initial
 arguments to the script. Instead of appending these arguments to the
@@ -263,6 +261,10 @@ The recognized suffixes are as follows:
        @scheme["CFBundleTypeIconFile"] entries in
        @scheme['file-types]; for use under Mac OS X}
 
+ @item{@filepath{.utiexports} @'rarr @scheme['uti-exports] as
+       @scheme[read] content (a single S-expression); for use under
+       Mac OS X}
+
 }}
 
 @defparam[current-launcher-variant variant symbol?]{