ds-store/alias: fix for Mac OS X 10.4

pkgs/ds-store-pkgs/ds-store-lib/alias.rkt

@@ -14,7 +14,29 @@
   (get-ffi-obj 'FSNewAliasFromPath
                CoreServices
                (_fun _path _path _int (h : (_ptr o _pointer)) (_ptr io _int) -> (r : _int) -> (if (zero? r) h #f))
+               (lambda () #f)))
+
+;; Fallback when FSNewAliasFromPath is not available:
+(define _FSRef _pointer) ; 80 bytes
+(define FSPathMakeRef 
+  (get-ffi-obj 'FSPathMakeRef 
+               CoreServices
+               (_fun _path _FSRef (_pointer = #f) -> (r : _int) 
+                     -> (unless (zero? r)
+                          (error 'FSPathMakeRef "failed")))))
+(define FSNewAliasUnicode
+  (get-ffi-obj 'FSNewAliasUnicode
+               CoreServices
+               (_fun _FSRef
+                     _FSRef
+                     _uint 
+                     _string/utf-16
+                     (h : (_ptr o _pointer)) 
+                     (_ptr io _int)
+                     -> (r : _int)
+                     -> (if (zero? r) h #f))
                make-unavailable))
+
 (define GetAliasSize
   (get-ffi-obj 'GetAliasSize
                CoreServices
@@ -29,10 +51,21 @@
 (define (path->alias-bytes file
                            #:wrt [wrt #f])
   (define h
+    (if FSNewAliasFromPath
         (FSNewAliasFromPath wrt
                             file
                             0
-                        0))
+                            0)
+        (let ([wrt-fs (and wrt (malloc 80))]
+              [fs (malloc 80)])
+          (when wrt (FSPathMakeRef wrt wrt-fs))
+          (define-values (base name dir?) (split-path file))
+          (FSPathMakeRef base fs)
+          (FSNewAliasUnicode wrt-fs
+                             fs
+                             (string-length (path->string name)) ; FIXME: should be utf-16 count
+                             (path->string name)
+                             0))))
   (and h
        (let ([sz (GetAliasSize h)])
          (define bstr (make-bytes sz))