/ src / signal-slot /
/src/signal-slot/slot.lisp
1 (in-package :cl-smoke.qt.core)
2
3 (defclass qslot (qt:object)
4 ((arguments :reader arguments :initarg :argument-types
5 :documentation "List of the argument types for the slot.")
6 (function :reader slot-function :initarg :slot-function
7 :initform (error "no slot function specified")
8 :documentation "The function called when the slot is invoked."))
9 (:metaclass cxx:class)
10 (:documentation "A Qt slot that calls its associated function"))
11
12 (defun qt:make-slot (function &optional (arguments nil arguments-p))
13 "Returns a slot that calls FUNCTION when it receives a signal."
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
24 (defparameter *sender* nil "The sender of the signal.")
25 (defparameter *this* nil "The slot that is invoked.")
26 (defmacro qt:sender ()
27 "Returns the sender that invoked the slot."
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 (declare (ignore id))
34 (let ((id (call-next-method)))
35 (if (< id 0)
36 id
37 (if (enum= call qt:meta-object.+invoke-meta-method+)
38 (progn
39 (ccase id
40 (0 (let ((*sender* (cxx:sender slot))
41 (*this* slot))
42 (with-simple-restart
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)))))))
47 (1- id))
48 id))))
49
50 (defun find-signal-id (sender signal)
51 "Returns the ID of SIGNAL from SENDER."
52 ;; For efficiency assume that SIGNAL is normalized and fallback to
53 ;; normalizing when not. (Just like Qt does.)
54 (let ((id (cxx:index-of-signal (cxx:meta-object sender)
55 signal)))
56 (when (< id 0)
57 (setf id (cxx:index-of-signal (cxx:meta-object sender)
58 (qt: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