From 1829a03bb6b6c23f56d246a736e03a314e17a266 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 10 Sep 2013 07:47:31 -0600
Subject: [PATCH] ds-store/alias: fix for Mac OS X 10.4

---
 pkgs/ds-store-pkgs/ds-store-lib/alias.rkt | 41 ++++++++++++++++++++---
 1 file changed, 37 insertions(+), 4 deletions(-)

diff --git a/pkgs/ds-store-pkgs/ds-store-lib/alias.rkt b/pkgs/ds-store-pkgs/ds-store-lib/alias.rkt
index 1f5ba90a4e..f2c864dd90 100644
--- a/pkgs/ds-store-pkgs/ds-store-lib/alias.rkt
+++ b/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
-    (FSNewAliasFromPath wrt
-                        file
-                        0
-                        0))
+    (if FSNewAliasFromPath
+        (FSNewAliasFromPath wrt
+                            file
+                            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))