Updating code to use with-out-parameters

[factor.git] / basis / core-foundation / strings / strings.factor

diff --git a/basis/core-foundation/strings/strings.factor b/basis/core-foundation/strings/strings.factor
index 50c17dc6fd03e6fc0e9eff86852df9b3af037a28..b78e1046fee3822c33447aeb584e6ae9ed54a6ed 100644 (file)
--- a/basis/core-foundation/strings/strings.factor
+++ b/basis/core-foundation/strings/strings.factor
@@ -1,7 +1,9 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax alien.strings kernel sequences byte-arrays
-io.encodings.utf8 math core-foundation core-foundation.arrays ;
+USING: alien.c-types alien.data alien.syntax alien.strings
+io.encodings.string kernel sequences byte-arrays
+io.encodings.utf8 math core-foundation core-foundation.arrays
+destructors parser fry alien words ;
 IN: core-foundation.strings
 
 TYPEDEF: void* CFStringRef
@@ -36,31 +38,58 @@ FUNCTION: void CFStringGetCharacters ( void* theString, CFIndex start, CFIndex l
 
 FUNCTION: Boolean CFStringGetCString (
     CFStringRef theString,
-    char* buffer,
+    UInt8* buffer,
     CFIndex bufferSize,
     CFStringEncoding encoding
 ) ;
 
+FUNCTION: CFIndex CFStringGetBytes (
+   CFStringRef theString,
+   CFRange range,
+   CFStringEncoding encoding,
+   UInt8 lossByte,
+   Boolean isExternalRepresentation,
+   UInt8* buffer,
+   CFIndex maxBufLen,
+   CFIndex* usedBufLen
+) ;
+
 FUNCTION: CFStringRef CFStringCreateWithCString (
     CFAllocatorRef alloc,
-    char* cStr,
+    UInt8* cStr,
     CFStringEncoding encoding
 ) ;
 
+: prepare-CFString ( string -- byte-array )
+    [
+        dup HEX: 10ffff >
+        [ drop HEX: fffd ] when
+    ] map utf8 encode ;
+
 : <CFString> ( string -- alien )
-    f swap utf8 string>alien kCFStringEncodingUTF8 CFStringCreateWithCString
-    [ "CFStringCreateWithCString failed" throw ] unless* ;
+    [ f ] dip
+    prepare-CFString dup length
+    kCFStringEncodingUTF8 f
+    CFStringCreateWithBytes
+    [ "CFStringCreateWithBytes failed" throw ] unless* ;
 
 : CF>string ( alien -- string )
-    dup CFStringGetLength 4 * 1 + <byte-array> [
+    dup CFStringGetLength
+    [ 0 swap <CFRange> kCFStringEncodingUTF8 0 f ] keep
+    4 * 1 + <byte-array> [
         dup length
-        kCFStringEncodingUTF8
-        CFStringGetCString
-        [ "CFStringGetCString failed" throw ] unless
-    ] keep utf8 alien>string ;
+        { CFIndex } [ CFStringGetBytes drop ] [ ]
+        with-out-parameters
+    ] keep
+    swap head-slice utf8 decode ;
 
 : CF>string-array ( alien -- seq )
     CF>array [ CF>string ] map ;
 
 : <CFStringArray> ( seq -- alien )
-    [ <CFString> ] map [ <CFArray> ] [ [ CFRelease ] each ] bi ;
+    [ [ <CFString> &CFRelease ] map <CFArray> ] with-destructors ;
+
+SYNTAX: CFSTRING: 
+    CREATE scan-object 
+    [ drop ] [ '[ _ [ _ <CFString> ] initialize-alien ] ] 2bi
+    (( -- alien )) define-declared ;