-
Notifications
You must be signed in to change notification settings - Fork 1
/
util.lisp
37 lines (31 loc) · 1.27 KB
/
util.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
(in-package :midi)
(defun now ()
(* 1.0d-9 #+ccl(ccl::current-time-in-nanoseconds)
#-ccl(cffi:foreign-funcall "mach_absolute_time" :int64)))
(defconstant +k-cf-string-encoding-utf-8+ #x08000100
"The kCFStringEncodingUTF8 constant.")
(defun cf-string (string)
"Create a UTF8 CoreFoundation string out of STRING.
This string needs to be released after use."
(cffi:foreign-funcall "CFStringCreateWithCString"
:pointer (cffi:foreign-funcall "CFAllocatorGetDefault" :pointer)
:string string
:int +k-cf-string-encoding-utf-8+
:pointer))
(defun cf-release (cf-object)
"Release CF-OBJECT."
(cffi:foreign-funcall "CFRelease" :pointer cf-object))
(defmacro with-cf-strings (bindings &body body)
"Execute BODY with a set of BINDINGS to CoreFoundation strings.
Each binding looks like (VAR STRING). every VAR will be bound to a newly
created CoreFoundation string initialized from plain STRING. Those strings
will be released afterwards."
`(let ,(mapcar #'car bindings)
;; #### FIXME: we can do better in terms of error handling.
(unwind-protect
(progn
(setq ,@(loop :for form :in bindings
:nconc `(,(car form) (cf-string ,(cadr form)))))
,@body)
,@(loop :for form :in (reverse bindings)
:collect `(cf-release ,(car form))))))