get-slot for function with this argument
Fri Jun 5 09:45:07 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* get-slot for function with this argument
hunk ./src/package.lisp 42
- #:connect-signal
- #:connect-function
hunk ./src/signal-slot/connect.lisp 65
-(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)))
hunk ./src/signal-slot/signal.lisp 71
-(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))))
hunk ./src/signal-slot/slot.lisp 25
-(defparameter *sender* nil)
+(defparameter *sender* nil "The sender of the signal.")
+(defparameter *this* nil "The slot that is invoked.")
hunk ./src/signal-slot/slot.lisp 40
- (0 (let ((*sender* (cxx:sender slot)))
+ (0 (let ((*sender* (cxx:sender slot))
+ (*this* slot))
hunk ./src/signal-slot/slot.lisp 64
-(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)))))