72 lines
2.1 KiB
Racket
72 lines
2.1 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-appkit
|
|
define-mz
|
|
as-objc-allocation
|
|
as-objc-allocation-with-retain
|
|
retain release
|
|
with-autorelease
|
|
clean-menu-label
|
|
->wxb
|
|
->wx)
|
|
|
|
(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 appkit-lib (ffi-lib (format "/System/Library/Frameworks/AppKit.framework/AppKit")))
|
|
|
|
(define-ffi-definer define-cocoa cocoa-lib)
|
|
(define-ffi-definer define-cf cf-lib)
|
|
(define-ffi-definer define-appserv appserv-lib)
|
|
(define-ffi-definer define-appkit appkit-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-syntax-rule (as-objc-allocation-with-retain expr)
|
|
((objc-allocator (lambda () (let ([v expr])
|
|
(tellv v retain)
|
|
v)))))
|
|
|
|
(define release ((deallocator) objc-delete))
|
|
(define retain ((retainer release car)
|
|
(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)
|
|
(release pool))))
|
|
|
|
(define (clean-menu-label str)
|
|
(regexp-replace* #rx"&(.)" str "\\1"))
|
|
|
|
(define (->wxb wx)
|
|
(make-weak-box wx))
|
|
|
|
(define (->wx wxb)
|
|
(and wxb
|
|
(weak-box-value wxb)))
|