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/signal-slot/slot.lisp
2010-01-10 tobias
1
(in-package :cl-smoke.qt.core)
2009-04-05 tobias
2
2009-06-11 tobias
3
(defclass qslot (qt:object)
2009-04-05 tobias
4
((arguments :reader arguments :initarg :argument-types
17:56:16 '
5
:documentation "List of the argument types for the slot.")
'
6
(function :reader slot-function :initarg :slot-function
2009-08-02 tobias
7
:initform (error "no slot function specified")
2009-04-05 tobias
8
:documentation "The function called when the slot is invoked."))
2009-05-31 tobias
9
(:metaclass cxx:class)
2009-04-05 tobias
10
(:documentation "A Qt slot that calls its associated function"))
17:56:16 '
11
2009-06-11 tobias
12
(defun qt:make-slot (function &optional (arguments nil arguments-p))
2009-04-05 tobias
13
"Returns a slot that calls FUNCTION when it receives a signal."
17:56:16 '
14
(if arguments-p
'
15
(make-instance 'qslot
'
16
:slot-function function
'
17
:argument-types arguments)
'
18
(make-instance 'qslot
'
19
:slot-function function)))
'
20
'
21
(defmethod id ((slot qslot))
'
22
(cxx:method-count (cxx:meta-object slot)))
'
23
2009-06-05 tobias
24
(defparameter *sender* nil "The sender of the signal.")
07:45:07 '
25
(defparameter *this* nil "The slot that is invoked.")
2009-06-11 tobias
26
(defmacro qt:sender ()
2009-04-05 tobias
27
"Returns the sender that invoked the slot."
17:56:16 '
28
`*sender*)
'
29
2009-04-12 tobias
30
(defmethod cxx:qt-metacall ((slot qslot) call id arguments)
2009-04-05 tobias
31
"Invoke the slots function when it is called. The return value
17:56:16 '
32
of the invoked slot function is ignored."
2009-07-01 tobias
33
(declare (ignore id))
2009-04-05 tobias
34
(let ((id (call-next-method)))
17:56:16 '
35
(if (< id 0)
'
36
id
2009-06-11 tobias
37
(if (enum= call qt:meta-object.+invoke-meta-method+)
2009-04-05 tobias
38
(progn
2009-06-03 tobias
39
(ccase id
2009-06-05 tobias
40
(0 (let ((*sender* (cxx:sender slot))
07:45:07 '
41
(*this* slot))
2009-06-03 tobias
42
(with-simple-restart
22:02:12 '
43
(continue "Skip the function ~A of slot ~A."
'
44
(slot-function slot) slot)
'
45
(apply (slot-function slot)
'
46
(arguments-to-lisp arguments (arguments slot)))))))
2009-04-05 tobias
47
(1- id))
17:56:16 '
48
id))))
'
49
'
50
(defun find-signal-id (sender signal)
'
51
"Returns the ID of SIGNAL from SENDER."
2009-07-22 tobias
52
;; For efficiency assume that SIGNAL is normalized and fallback to
22:21:01 '
53
;; normalizing when not. (Just like Qt does.)
2009-04-05 tobias
54
(let ((id (cxx:index-of-signal (cxx:meta-object sender)
2009-06-04 tobias
55
signal)))
10:58:29 '
56
(when (< id 0)
'
57
(setf id (cxx:index-of-signal (cxx:meta-object sender)
2009-07-24 tobias
58
(qt:meta-object.normalized-signature signal))))
2009-04-05 tobias
59
(when (< id 0)
17:56:16 '
60
(error "No signal ~S for class ~S."
'
61
signal (class-of sender)))
'
62
id))
'
63