gui/collects/mred/private/wx/cocoa/utils.rkt
Matthew Flatt 8a1032af6c fix constrained-reply to use delim continuations
original commit: 88f75dbc133313c715eb290c1ff4abeb3d42aff5
2010-11-05 15:54:01 -06:00

49 lines
1.4 KiB
Racket

#lang scheme/base
(require ffi/unsafe/objc
ffi/unsafe
ffi/unsafe/alloc
ffi/unsafe/define
"../common/utils.rkt")
(provide cocoa-lib
cf-lib
define-cocoa
define-cf
define-appserv
define-mz
as-objc-allocation
retain release
with-autorelease)
(define cocoa-lib (ffi-lib (format "/System/Library/Frameworks/Cocoa.framework/Cocoa")))
(define cf-lib (ffi-lib (format "/System/Library/Frameworks/CoreFoundation.framework/CoreFoundation")))
(define appserv-lib (ffi-lib (format "/System/Library/Frameworks/ApplicationServices.framework/ApplicationServices")))
(define-ffi-definer define-cocoa cocoa-lib)
(define-ffi-definer define-cf cf-lib)
(define-ffi-definer define-appserv appserv-lib)
(define (objc-delete v)
(tellv v release))
(define objc-allocator (allocator objc-delete))
(define-syntax-rule (as-objc-allocation expr)
((objc-allocator (lambda () expr))))
(define release ((deallocator) objc-delete))
(define retain ((retainer release car)
(lambda (obj)
(tellv obj retain))))
(import-class NSAutoreleasePool)
(define-syntax-rule (with-autorelease expr)
(call-with-autorelease (lambda () expr)))
(define (call-with-autorelease thunk)
(let ([pool (as-objc-allocation
(tell (tell NSAutoreleasePool alloc) init))])
(begin0
(thunk)
(release pool))))