add ffi/unsafe/nsalloc' and ffi/unsafe/nsstring'

collects/ffi/unsafe/nsalloc.rkt

@@ -0,0 +1,28 @@
+#lang racket/base
+(require ffi/unsafe/objc
+         ffi/unsafe
+         ffi/unsafe/atomic)
+
+(provide (protect-out with-autorelease
+                      call-with-autorelease))
+
+;; Make sure Foundation is loaded:
+(void (ffi-lib "/System/Library/Frameworks/Foundation.framework/Foundation"
+               #:fail (lambda () #f)))
+
+(import-class NSAutoreleasePool)
+
+(define-syntax-rule (with-autorelease expr ...)
+  (call-with-autorelease (lambda () expr ...)))
+
+(define (call-with-autorelease thunk)
+  (unless NSAutoreleasePool
+    (error 'NSAutoreleasePool "not available"))
+  (call-as-atomic
+   (lambda ()
+     (let ([pool (tell (tell NSAutoreleasePool alloc) init)])
+       (dynamic-wind
+           void
+           thunk
+           (lambda ()
+             (tellv pool release)))))))

collects/ffi/unsafe/nsstring.rkt

@@ -0,0 +1,45 @@
+#lang racket/base
+(require ffi/unsafe/objc
+         ffi/unsafe
+         ffi/unsafe/alloc
+         ffi/unsafe/atomic
+         "nsalloc.rkt")
+
+(provide (protect-out _NSString))
+
+(import-class NSString)
+
+(define-syntax-rule (atomically e)
+  (begin
+    (start-atomic)
+    (begin0
+     e
+     (end-atomic))))
+
+;; Access this table on only in atomic mode, so
+;; that _NSString can be used in atomic mode:
+(define strings (make-weak-hash))
+
+(define (release-string s) 
+  (tellv s release))
+
+(define allocate-string
+  ((allocator release-string)
+   (lambda (v)
+     (with-autorelease
+      (tell (tell NSString alloc)
+            initWithUTF8String:
+            #:type _string
+            v)))))
+
+(define _NSString (make-ctype _id
+                              (lambda (v)
+                                (or (atomically
+                                     (hash-ref strings v #f))
+                                    (let ([s (allocate-string v)])
+                                      (atomically (hash-set! strings v s))
+                                      s)))
+                              (lambda (v)
+                                (with-autorelease
+                                 (let ([s (tell #:type _bytes v UTF8String)])
+                                   (bytes->string/utf-8 s))))))

collects/mred/private/wx/cocoa/types.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 (require ffi/unsafe/objc
          ffi/unsafe
+         ffi/unsafe/nsstring
          "../../lock.rkt"
          "utils.rkt")
 
@@ -12,8 +13,8 @@
               _NSRect _NSRect-pointer (struct-out NSRect)
               _NSRange _NSRange-pointer (struct-out NSRange)
               NSObject
-              NSString _NSString
-              NSNotFound))
+              NSNotFound)
+ _NSString)
 
 (define _NSInteger _long)
 (define _NSUInteger _ulong)
@@ -41,23 +42,6 @@
 
 (import-class NSObject NSString)
 
-(define strings (make-weak-hash))
-(define _NSString (make-ctype _id
-                              (lambda (v)
-                                (or (hash-ref strings v #f)
-                                    (let ([s (as-objc-allocation
-                                              (tell (tell NSString alloc)
-                                                    initWithUTF8String:
-                                                    #:type _string
-                                                    v))])
-                                      (hash-set! strings v s)
-                                      s)))
-                              (lambda (v)
-                                (atomically
-                                 (with-autorelease
-                                  (let ([s (tell #:type _bytes v UTF8String)])
-                                    (bytes->string/utf-8 s)))))))
-
 (define NSNotFound (if 64-bit?
                        #x7fffffffffffffff
                        #x7fffffff))

collects/mred/private/wx/cocoa/utils.rkt

@@ -3,6 +3,7 @@
          ffi/unsafe
          ffi/unsafe/alloc
          ffi/unsafe/define
+         ffi/unsafe/nsalloc
          "../common/utils.rkt"
          "../../lock.rkt")
 
@@ -17,13 +18,14 @@
               as-objc-allocation-with-retain
               clean-up-deleted
               retain release
-              with-autorelease
               clean-menu-label
               ->wxb
               ->wx
               old-cocoa?
               version-10.6-or-later?
               version-10.7-or-later?)
+ with-autorelease
+ call-with-autorelease
  define-mz)
 
 (define cocoa-lib (ffi-lib (format "/System/Library/Frameworks/Cocoa.framework/Cocoa")))
@@ -59,18 +61,6 @@
                 (lambda (obj)
                   (tellv obj retain))))
 
-(import-class NSAutoreleasePool)
-
-;; Use `with-autorelease' and `call-with-autorelease' 
-;; in atomic mode
-(define-syntax-rule (with-autorelease expr ...)
-  (call-with-autorelease (lambda () expr ...)))
-(define (call-with-autorelease thunk)
-  (let ([pool (tell (tell NSAutoreleasePool alloc) init)])
-    (begin0
-     (thunk)
-     (tellv pool release))))
-
 (define (clean-menu-label str)
   (regexp-replace* #rx"&(.)" str "\\1"))
 

collects/scribblings/foreign/derived.scrbl

@@ -14,6 +14,7 @@
 @include-section["atomic.scrbl"]
 @include-section["try-atomic.scrbl"]
 @include-section["objc.scrbl"]
+@include-section["ns.scrbl"]
 @include-section["com.scrbl"]
 @include-section["file.scrbl"]
 @include-section["winapi.scrbl"]

collects/scribblings/foreign/ns.scrbl

@@ -0,0 +1,53 @@
+#lang scribble/doc
+@(require scribble/manual
+          (for-label racket/base
+                     ffi/unsafe/nsalloc
+                     ffi/unsafe/nsstring))
+
+@title[#:tag "ns"]{Cocoa Foundation}
+
+The @racketmodname[ffi/unsafe/nsalloc] and
+@racketmodname[ffi/unsafe/nsstring] libraries provide basic
+facilities for working with Cocoa and/or Mac OS X Foundation
+libraries (usually along with @racket[ffi/objc]).
+
+@; ----------------------------------------
+
+@section{Strings}
+
+@defmodule[ffi/unsafe/nsstring]
+
+@defthing[_NSString ctype?]{
+
+A type that converts between Racket strings and
+@as-index{@tt{NSString}} (a.k.a. @as-index{@tt{CFString}})
+values. That is, use @tt{_NSString} as a type for a foreign-function
+@tt{NSString} argument or result.
+
+The @racket[_NSString] conversion keeps a weak mapping from Racket
+strings to converted strings, so that converting the same string (in
+the @racket[equal?] sense) multiple times may avoid allocating
+multiple @tt{NSString} objects.}
+
+
+@; ----------------------------------------
+
+@section{Allocation Pools}
+
+@defmodule[ffi/unsafe/nsalloc]{Calling any Foundation API that
+allocates requires an @tt{NSAutoreleasePool} installed. The
+@racketmodname[ffi/unsafe/nsalloc] library provides a function and
+shorthand syntactic form for setting up such a context. (The
+@racket[_NSString] type creates an autorelease pool implicitly while
+converting from/to a Racket string, however.)}
+
+@defproc[(call-with-autorelease [thunk (-> any)]) any]{
+
+Calls @racket[thunk] in atomic mode and with a fresh
+@tt{NSAutoreleasePool} that is @tt{releas}ed after @racket[thunk]
+returns.}
+
+
+@defform[(with-autorelease expr)]{
+
+A shorthand for @racket[(call-with-autorelease (lambda () expr))].}