Fri Jun 5 09:45:07 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* get-slot for function with this argument
diff -rN -u old-qt.gui/src/package.lisp new-qt.gui/src/package.lisp
--- old-qt.gui/src/package.lisp 2014-10-22 11:20:59.000000000 +0200
+++ new-qt.gui/src/package.lisp 2014-10-22 11:20:59.000000000 +0200
@@ -39,7 +39,5 @@
#:get-signal
#:make-slot
#:make-signal
- #:connect-signal
- #:connect-function
#:sender))
diff -rN -u old-qt.gui/src/signal-slot/connect.lisp new-qt.gui/src/signal-slot/connect.lisp
--- old-qt.gui/src/signal-slot/connect.lisp 2014-10-22 11:20:59.000000000 +0200
+++ new-qt.gui/src/signal-slot/connect.lisp 2014-10-22 11:20:59.000000000 +0200
@@ -62,9 +62,18 @@
:reader receiver))
(:documentation "Qt C++ slot."))
-(defun get-slot (receiver name)
- "Returns the slot of RECEIVER with NAME."
- (make-instance 'qt-slot :receiver receiver :name name))
+(defgeneric get-slot (receiver name)
+ (:documentation "Returns the slot of RECEIVER with NAME.")
+ (:method (receiver name)
+ (make-instance 'qt-slot :receiver receiver :name name))
+ (:method (receiver (function function))
+ "Returns a slot for RECEIVER that calls function
+with RECEIVER as the first argument."
+ (let ((slot (make-slot #'(lambda (&rest args)
+ (apply function (cxx:parent *this*)
+ args)))))
+ (cxx:set-parent slot receiver)
+ slot)))
(define-compiler-macro get-slot (&whole form receiver name)
"Normalize the slot name."
diff -rN -u old-qt.gui/src/signal-slot/signal.lisp new-qt.gui/src/signal-slot/signal.lisp
--- old-qt.gui/src/signal-slot/signal.lisp 2014-10-22 11:20:59.000000000 +0200
+++ new-qt.gui/src/signal-slot/signal.lisp 2014-10-22 11:20:59.000000000 +0200
@@ -68,45 +68,6 @@
(class-slots (class-of receiver))))
id))
-(defun connect-signal (qsignal receiver slot &optional (type 0))
- "Connects a signal to a slot. Returns T on success and NIL otherwise."
-
- (let ((qsignal (signal-object qsignal))
- (slot-id (find-slot-id receiver slot)))
- (when (not (slot-boundp qsignal 'argument-types))
- (setf (argument-types qsignal)
- (method-arguments-type (cxx:meta-object receiver)
- slot-id)))
- (assert (>= slot-id 0)
- ()
- "No slot ~S for class ~S."
- slot (class-name receiver))
- (or (meta-object.connect qsignal (id qsignal)
- receiver slot-id
- type
- ;; QMetaObject::connect is responsible
- ;; for freeing the types array.
- (types (method-arguments-type
- (cxx:meta-object receiver)
- slot-id)))
- (cerror "Ignore"
- "Failed to connect ~S to the slot ~S of ~S."
- qsignal slot receiver))))
-
-(defun disconnect-signal (qsignal receiver slot)
- (let ((qsignal (signal-object qsignal))
- (slot-id (cxx:index-of-slot (cxx:meta-object receiver)
- (cxx:data
- (meta-object.normalized-signature slot)))))
- (assert (>= slot-id 0)
- ()
- "No slot ~S for class ~S."
- slot (class-name receiver))
- (or (meta-object.disconnect qsignal (id qsignal)
- receiver slot-id)
- (cerror "Ignore"
- "Failed to disconnect ~S to the slot ~S of ~S."
- qsignal slot receiver))))
(defun make-lisp-object (object)
(smoke::make-cleanup-pointer (make-cxx-lisp-object object)
diff -rN -u old-qt.gui/src/signal-slot/slot.lisp new-qt.gui/src/signal-slot/slot.lisp
--- old-qt.gui/src/signal-slot/slot.lisp 2014-10-22 11:20:59.000000000 +0200
+++ new-qt.gui/src/signal-slot/slot.lisp 2014-10-22 11:20:59.000000000 +0200
@@ -22,7 +22,8 @@
(defmethod id ((slot qslot))
(cxx:method-count (cxx:meta-object slot)))
-(defparameter *sender* nil)
+(defparameter *sender* nil "The sender of the signal.")
+(defparameter *this* nil "The slot that is invoked.")
(defmacro sender ()
"Returns the sender that invoked the slot."
`*sender*)
@@ -36,7 +37,8 @@
(if (enum= call meta-object.+invoke-meta-method+)
(progn
(ccase id
- (0 (let ((*sender* (cxx:sender slot)))
+ (0 (let ((*sender* (cxx:sender slot))
+ (*this* slot))
(with-simple-restart
(continue "Skip the function ~A of slot ~A."
(slot-function slot) slot)
@@ -59,20 +61,3 @@
signal (class-of sender)))
id))
-(defun connect-function (sender signal function &optional (type 0))
- "Connects FUNCTION to the SIGNAL of SENDER.
-The return value of FUNCTION is ignored."
- (let* ((signal-id (find-signal-id sender signal))
- (slot (make-instance 'qslot
- :args (list sender)
- :slot-function function
- :argument-types (method-arguments-type
- (cxx:meta-object sender)
- signal-id))))
- (let ((ret (meta-object.connect sender signal-id
- slot (id slot)
- type (types (arguments slot)))))
- (if ret
- (cxx:connect-notify sender signal)
- (cerror "Failed to connect the signal ~S of ~S to the function ~S."
- signal sender function)))))