repos
/
qt.core
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
initial import
Annotate for file src/signal-slot/slot.lisp
2009-04-05 tobias
1
(in-package :qt)
17:56:16 '
2
(declaim (optimize (debug 3)))
'
3
'
4
(defclass qslot (object)
'
5
((arguments :reader arguments :initarg :argument-types
'
6
:documentation "List of the argument types for the slot.")
'
7
(function :reader slot-function :initarg :slot-function
'
8
:initform (error "no function specified")
'
9
:documentation "The function called when the slot is invoked."))
'
10
(:metaclass smoke::smoke-wrapper-class)
'
11
(:documentation "A Qt slot that calls its associated function"))
'
12
'
13
(defun make-slot (function &optional (arguments nil arguments-p))
'
14
"Returns a slot that calls FUNCTION when it receives a signal."
'
15
(if arguments-p
'
16
(make-instance 'qslot
'
17
:slot-function function
'
18
:argument-types arguments)
'
19
(make-instance 'qslot
'
20
:slot-function function)))
'
21
'
22
(defmethod id ((slot qslot))
'
23
(cxx:method-count (cxx:meta-object slot)))
'
24
'
25
(defparameter *sender* nil)
'
26
(defmacro sender ()
'
27
"Returns the sender that invoked the slot."
'
28
`*sender*)
'
29
'
30
(defun method-argument-count (metaobject index)
'
31
"Returns the number of arguments for the method INDEX of METAOBJECT."
'
32
(let ((signature (cxx:signature (cxx:method metaobject index))))
'
33
(setf signature (subseq signature (1+ (position #\( signature))
'
34
(position #\) signature :from-end t)))
'
35
(if (= 0 (length signature))
'
36
0
'
37
(1+ (count #\, signature)))))
'
38
'
39
(defmethod cxx::qt-metacall ((slot qslot) &rest args
'
40
&aux (a (third args)))
'
41
"Invoke the slots function when it is called. The return value
'
42
of the invoked slot function is ignored."
'
43
(let ((id (call-next-method)))
'
44
(if (< id 0)
'
45
id
'
46
(if (enum= (first args) meta-object.+invoke-meta-method+)
'
47
(progn
'
48
(case id
'
49
(0 (let ((*sender* (cxx:sender slot)))
'
50
(apply (slot-function slot)
'
51
(arguments-to-lisp a (arguments slot))))))
'
52
(1- id))
'
53
id))))
'
54
'
55
(defun find-signal-id (sender signal)
'
56
"Returns the ID of SIGNAL from SENDER."
'
57
(let ((id (cxx:index-of-signal (cxx:meta-object sender)
'
58
(cxx:data (meta-object.normalized-signature signal)))))
'
59
(when (< id 0)
'
60
(error "No signal ~S for class ~S."
'
61
signal (class-of sender)))
'
62
id))
'
63
'
64
(defun connect-function (sender signal function &optional (type 0))
'
65
"Connects FUNCTION to the SIGNAL of SENDER.
'
66
The return value of FUNCTION is ignored."
'
67
(let* ((signal-id (find-signal-id sender signal))
'
68
(slot (make-instance 'qslot
'
69
:args (list sender)
'
70
:slot-function function
'
71
:argument-types (method-arguments-type
'
72
(cxx:meta-object sender)
'
73
signal-id))))
'
74
(let ((ret (static-call "QMetaObject" "connect#$#$$$"
'
75
sender
'
76
signal-id
'
77
slot
'
78
(id slot)
'
79
type
'
80
(types (arguments slot)))))
'
81
(if ret
'
82
(cxx:connect-notify sender signal)
'
83
(cerror "Failed to connect the signal ~S of ~S to the function ~S."
'
84
signal sender function)))))