91 lines
2.7 KiB
Racket
91 lines
2.7 KiB
Racket
#lang racket/base
|
|
(require ffi/unsafe/objc
|
|
ffi/unsafe
|
|
ffi/unsafe/alloc
|
|
ffi/unsafe/define
|
|
"../common/utils.rkt"
|
|
"../../lock.rkt")
|
|
|
|
(provide
|
|
(protect-out cocoa-lib
|
|
cf-lib
|
|
define-cocoa
|
|
define-cf
|
|
define-appserv
|
|
define-appkit
|
|
as-objc-allocation
|
|
as-objc-allocation-with-retain
|
|
clean-up-deleted
|
|
retain release
|
|
with-autorelease
|
|
clean-menu-label
|
|
->wxb
|
|
->wx
|
|
old-cocoa?)
|
|
define-mz)
|
|
|
|
(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 delete-me null)
|
|
|
|
(define (objc-delete o)
|
|
(atomically
|
|
(set! delete-me (cons o delete-me))))
|
|
|
|
(define (clean-up-deleted)
|
|
;; called outside the event loop to actually delete objects
|
|
;; that might otherwise be in use during a callback
|
|
(for ([o (in-list (begin0
|
|
delete-me
|
|
(set! delete-me null)))])
|
|
(tellv o 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)
|
|
(tellv pool release))))
|
|
|
|
(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)))
|
|
|
|
;; FIXME: need a better test:
|
|
(define old-cocoa? (equal? (path->string (system-library-subpath #f))
|
|
"ppc-macosx"))
|