repos
/
qt.gui
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
filehistory
normal
|
plain
|
shade
|
zebra
Normalize signal and slot names at compile time.
Annotate for file src/signal-slot/slot.lisp
2009-06-11 tobias
1
(in-package :qt)
14:59:48 '
2
(declaim (optimize (debug 3)))
2010-01-10 tobias
3
2009-06-11 tobias
4
(defclass qslot (object)
2010-01-10 tobias
5
((arguments :reader arguments :initarg :argument-types
08:52:49 '
6
:documentation "List of the argument types for the slot.")
'
7
(function :reader slot-function :initarg :slot-function
2009-08-02 tobias
8
:initform (error "no function specified")
2010-01-10 tobias
9
:documentation "The function called when the slot is invoked."))
08:52:49 '
10
(:metaclass cxx:class)
'
11
(:documentation "A Qt slot that calls its associated function"))
'
12
2009-06-11 tobias
13
(defun make-slot (function &optional (arguments nil arguments-p))
2010-01-10 tobias
14
"Returns a slot that calls FUNCTION when it receives a signal."
08:52:49 '
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
2009-06-05 tobias
25
(defparameter *sender* nil)
2009-06-11 tobias
26
(defmacro sender ()
2010-01-10 tobias
27
"Returns the sender that invoked the slot."
08:52:49 '
28
`*sender*)
'
29
'
30
(defmethod cxx:qt-metacall ((slot qslot) call id arguments)
'
31
"Invoke the slots function when it is called. The return value
'
32
of the invoked slot function is ignored."
'
33
(let ((id (call-next-method)))
'
34
(if (< id 0)
'
35
id
2009-06-11 tobias
36
(if (enum= call meta-object.+invoke-meta-method+)
2010-01-10 tobias
37
(progn
08:52:49 '
38
(ccase id
2009-06-05 tobias
39
(0 (let ((*sender* (cxx:sender slot)))
2010-01-10 tobias
40
(with-simple-restart
08:52:49 '
41
(continue "Skip the function ~A of slot ~A."
'
42
(slot-function slot) slot)
'
43
(apply (slot-function slot)
'
44
(arguments-to-lisp arguments (arguments slot)))))))
'
45
(1- id))
'
46
id))))
'
47
'
48
(defun find-signal-id (sender signal)
'
49
"Returns the ID of SIGNAL from SENDER."
2009-06-04 tobias
50
;; For efficency assume that SIGNAL is normalized and fallback
10:58:29 '
51
;; to normalzing when not. (Just like Qt does.)
2010-01-10 tobias
52
(let ((id (cxx:index-of-signal (cxx:meta-object sender)
2009-06-04 tobias
53
signal)))
10:58:29 '
54
(when (< id 0)
'
55
(setf id (cxx:index-of-signal (cxx:meta-object sender)
'
56
(cxx:data (meta-object.normalized-signature signal)))))
2010-01-10 tobias
57
(when (< id 0)
08:52:49 '
58
(error "No signal ~S for class ~S."
'
59
signal (class-of sender)))
'
60
id))
'
61
2009-06-05 tobias
62
(defun connect-function (sender signal function &optional (type 0))
07:45:07 '
63
"Connects FUNCTION to the SIGNAL of SENDER.
'
64
The return value of FUNCTION is ignored."
'
65
(let* ((signal-id (find-signal-id sender signal))
'
66
(slot (make-instance 'qslot
'
67
:args (list sender)
'
68
:slot-function function
'
69
:argument-types (method-arguments-type
'
70
(cxx:meta-object sender)
'
71
signal-id))))
'
72
(let ((ret (meta-object.connect sender signal-id
'
73
slot (id slot)
'
74
type (types (arguments slot)))))
'
75
(if ret
'
76
(cxx:connect-notify sender signal)
'
77
(cerror "Failed to connect the signal ~S of ~S to the function ~S."
'
78
signal sender function)))))