blob: d7357737724422b16f6d624196dac47cf1f4f39b (
plain)
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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
(in-package #:mulk.objective-cl)
(define-foreign-library libobjcl
(unix "/home/mulk/Dokumente/Projekte/Objective-CL/Objective-C/shared_obj/libobjcl.so"))
(use-foreign-library libobjcl)
(defcfun "objcl_initialise_runtime" :void)
(defcfun "objcl_shutdown_runtime" :void)
(defcfun ("objcl_invoke_instance_method"
%objcl-invoke-instance-method) obj-data
(receiver obj-data)
(method-name :string)
(argc :int)
&rest)
(defcfun ("objcl_invoke_class_method"
%objcl-invoke-class-method) obj-data
(receiver obj-data)
(method-name :string)
(argc :int)
&rest)
(defcfun ("objcl_find_class" %objcl-find-class) :pointer
(class-name :string))
(defcfun ("objcl_class_name" %objcl-class-name) :string
(class obj-data))
(defun objcl-find-class (class-name)
(let ((obj-data (%objcl-find-class class-name)))
(prog1
(if (null-pointer-p (foreign-slot-value
(foreign-slot-value obj-data 'obj-data 'data)
'obj-data-union
'class-val))
nil
(obj-data->lisp obj-data))
(dealloc-obj-data obj-data))))
(defun objcl-class-name (class)
(declare (type (or objc-class objc-id objc-exception) class))
(let ((obj-data (foreign-alloc 'obj-data)))
(with-foreign-slots ((type data) obj-data obj-data)
(setf (foreign-slot-value obj-data
'obj-data-union
(etypecase class
(objc-class 'class-val)
(objc-id 'id-val)
(objc-exception 'exc-val)))
(pointer-to class))
(setf type (foreign-string-alloc (etypecase class
(objc-class "#")
(objc-id "@")
(objc-exception "E")))))
(prog1
(%objcl-class-name obj-data)
(dealloc-obj-data obj-data))))
|
