ac2d39e0e1
The old strategy of switching a transparent window to solid and back doesn't work on 10.11; it appears that queued messages must be handled for the window to become visible, but that's not allowed during a GC. The strategy for 10.11 and up create an OpenGL canvas, which acts as a direct-to-screen drawing area that a GC callback can affect without Racket-level allocation.
92 lines
2.7 KiB
Racket
92 lines
2.7 KiB
Racket
#lang racket/base
|
|
(require ffi/unsafe/objc
|
|
ffi/unsafe
|
|
ffi/unsafe/alloc
|
|
ffi/unsafe/define
|
|
ffi/unsafe/nsalloc
|
|
"../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
|
|
clean-menu-label
|
|
->wxb
|
|
->wx
|
|
old-cocoa?
|
|
version-10.6-or-later?
|
|
version-10.7-or-later?
|
|
version-10.9-or-later?
|
|
version-10.10-or-later?
|
|
version-10.11-or-later?)
|
|
with-autorelease
|
|
call-with-autorelease
|
|
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)
|
|
(tellv o release))
|
|
|
|
(define (clean-up-deleted)
|
|
(free-remembered-now objc-delete))
|
|
|
|
(define objc-allocator (allocator remember-to-free-later))
|
|
|
|
(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))))
|
|
|
|
(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)))
|
|
|
|
(define-appkit NSAppKitVersionNumber _double)
|
|
|
|
(define old-cocoa?
|
|
; earlier than 10.5?
|
|
(NSAppKitVersionNumber . < . 949))
|
|
(define (version-10.6-or-later?)
|
|
(NSAppKitVersionNumber . >= . 1038))
|
|
(define (version-10.7-or-later?)
|
|
(NSAppKitVersionNumber . >= . 1138))
|
|
(define (version-10.9-or-later?)
|
|
(NSAppKitVersionNumber . >= . 1265))
|
|
(define (version-10.10-or-later?)
|
|
(NSAppKitVersionNumber . >= . 1331))
|
|
(define (version-10.11-or-later?)
|
|
(NSAppKitVersionNumber . >= . 1404))
|