repos
/
qt.core
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
Split up in qt.core.
Annotate for file /src/lisp-object.lisp
2010-01-10 tobias
1
(in-package :cl-smoke.qt.core)
2009-04-05 tobias
2
2009-05-31 tobias
3
(defvar *cxx-lisp-objects* (smoke::make-synchronized-hash-table)
2009-04-05 tobias
4
"Objects that are currently passed in a C++ class.")
17:56:16 '
5
'
6
(let ((id 0))
2009-07-02 tobias
7
(declare (type (smoke::c-integer :unsigned-int) id))
2009-04-05 tobias
8
(defun gen-cxx-lisp-object-id ()
17:56:16 '
9
"Returns a new unique ID."
2009-07-02 tobias
10
(loop do
19:37:42 '
11
(setf id
'
12
(logand (1- (expt 2 (* 8 (foreign-type-size :unsigned-int) )))
'
13
(1+ id)))
'
14
while (nth-value 1 (gethash id *cxx-lisp-objects*)))
'
15
id))
'
16
2010-01-10 tobias
17
(defcfun cl-smoke-setup-lisp-object :int
2009-04-05 tobias
18
(destruct :pointer))
17:56:16 '
19
2010-01-10 tobias
20
(defcfun cl-smoke-lisp-object-id :unsigned-int
2009-04-05 tobias
21
(object :pointer))
17:56:16 '
22
2010-01-10 tobias
23
(defcfun cl-smoke-lisp-object-is-set :int
2009-04-05 tobias
24
(object :pointer))
17:56:16 '
25
2010-01-10 tobias
26
(defcfun cl-smoke-make-lisp-object :pointer
2009-07-02 tobias
27
(id :unsigned-int))
2009-04-05 tobias
28
2010-01-10 tobias
29
(defcfun cl-smoke-free-lisp-object :void
2009-04-05 tobias
30
(object :pointer))
17:56:16 '
31
'
32
(defcallback destruct-cxx-lisp-object :void
2009-07-02 tobias
33
((id :unsigned-int))
2009-04-05 tobias
34
(remhash id *cxx-lisp-objects*))
17:56:16 '
35
2009-05-31 tobias
36
(defvar *cxx-lisp-object-metatype* "Metatype ID of the C++ lisp_object.")
2009-04-05 tobias
37
2009-05-14 tobias
38
(eval-startup ()
2009-04-05 tobias
39
(setf *cxx-lisp-object-metatype*
2010-01-10 tobias
40
(cl-smoke-setup-lisp-object (callback destruct-cxx-lisp-object)))
2009-04-05 tobias
41
(assert (>= *cxx-lisp-object-metatype*
2009-06-11 tobias
42
(smoke::value qt:meta-type.+user+))
2009-04-05 tobias
43
(*cxx-lisp-object-metatype*)
17:56:16 '
44
"setup of lisp-object failed"))
'
45
'
46
(defun make-cxx-lisp-object (object)
'
47
"Constructs a C++ object wrapper for OBJECT."
'
48
(let ((id (gen-cxx-lisp-object-id)))
'
49
(setf (gethash id *cxx-lisp-objects*) object)
2010-01-10 tobias
50
(cl-smoke-make-lisp-object id)))
2009-04-05 tobias
51
17:56:16 '
52
(defun free-cxx-lisp-object (pointer)
'
53
"Deletes the lisp_object at POINTER."
2010-01-10 tobias
54
(cl-smoke-free-lisp-object pointer))
2009-04-05 tobias
55
;; (qmetatype.destroy *cxx-lisp-object-metatype* pointer)) ;; FIXME use this?
17:56:16 '
56
'
57
(defun translate-cxx-lisp-object (pointer)
'
58
"Returns the object of the cxx-lisp-object at POINTER.
'
59
2009-07-01 tobias
60
When being received as an argument by a slot,
2009-04-05 tobias
61
the object must not be deallocated."
17:56:16 '
62
(multiple-value-bind (value present-p)
2010-01-10 tobias
63
(gethash (cl-smoke-lisp-object-id pointer)
2009-04-05 tobias
64
*cxx-lisp-objects*)
17:56:16 '
65
(assert present-p (value present-p)
'
66
"No object for ~A in ~A" pointer *cxx-lisp-objects*)
'
67
value))