Tue May 26 11:57:44 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Use argument conversion/promotion when emiting signals
diff -rN -u old-qt.gui/src/qstring.lisp new-qt.gui/src/qstring.lisp
--- old-qt.gui/src/qstring.lisp 2014-10-30 07:01:17.000000000 +0100
+++ new-qt.gui/src/qstring.lisp 2014-10-30 07:01:18.000000000 +0100
@@ -65,5 +65,5 @@
(free-translated-object pointer (make-instance 'qt::qstring)
nil))))
-(define-from-lisp-translation "const QString&" string
+(define-from-lisp-translation ("const QString&" "QString") string
coerce-qstring)
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-30 07:01:17.000000000 +0100
+++ new-qt.gui/src/signal-slot/signal.lisp 2014-10-30 07:01:18.000000000 +0100
@@ -112,38 +112,54 @@
(smoke::push-stack2 stack
cxx-object
0)))
+
+(defun make-lisp-object (object)
+ (smoke::make-cleanup-pointer (make-cxx-lisp-object object)
+ #'qt-smoke-free-lisp-object))
+(defun convert-arguments (arguments types)
+ "Returns a list of ARGUMENTS converted to TYPES."
+ (mapcar #'(lambda (argument type)
+ (if (typep type 'smoke::smoke-type)
+ (smoke::convert-argument argument type)
+ (progn (assert (typep argument type)
+ ()
+ "The argument ~S is not of type ~S.")
+ (make-lisp-object argument))))
+ arguments types))
+
(defun emit (qsignal &rest arguments)
"Emits the signal QSIGNAL."
;;; The first element of args would be used for the return value
;;; by QMetaObject::invokeMethod(), but for signal-slot connection
;;; it is ignored.
- (smoke::with-stack (stack arguments
- (argument-types qsignal))
- (cffi:with-foreign-object (args :pointer (1+ (length arguments)))
- (loop for i from 1 to (smoke::size stack)
- for type in (argument-types qsignal)
- do
- (setf (mem-aref args :pointer i)
- (if (or (not (typep type (find-class 'smoke::smoke-type)))
- (= 0 (smoke::type-id type))
- (= 13 (smoke::type-id type)))
- (foreign-slot-value
- (mem-aref (pointer stack)
- 'smoke::smoke-stack-item
- i)
- 'smoke::smoke-stack-item 'smoke::voidp)
- (foreign-slot-pointer
- (mem-aref (pointer stack)
- 'smoke::smoke-stack-item
- i)
- 'smoke::smoke-stack-item 'smoke::voidp))))
- (setf (mem-aref args :pointer 0)
- (null-pointer))
- (meta-object.activate qsignal (cxx:meta-object qsignal)
- (id qsignal)
- args))))
+ (let ((types (argument-types qsignal)))
+ (smoke::with-stack (stack (convert-arguments arguments types)
+ types)
+ (cffi:with-foreign-object (args :pointer (1+ (length arguments)))
+ (loop for i from 1 to (smoke::size stack)
+ for type in (argument-types qsignal)
+ do
+ (setf (mem-aref args :pointer i)
+ (if (or (not (typep type (find-class 'smoke::smoke-type)))
+ (= 0 (smoke::type-id type))
+ (= 13 (smoke::type-id type)))
+ (foreign-slot-value
+ (mem-aref (pointer stack)
+ 'smoke::smoke-stack-item
+ i)
+ 'smoke::smoke-stack-item 'smoke::voidp)
+ (foreign-slot-pointer
+ (mem-aref (pointer stack)
+ 'smoke::smoke-stack-item
+ i)
+ 'smoke::smoke-stack-item 'smoke::voidp))))
+ (setf (mem-aref args :pointer 0)
+ (null-pointer))
+ (meta-object.activate qsignal (cxx:meta-object qsignal)
+ (id qsignal)
+ args)))))
(defmethod disconnect-all ((qsignal qsignal))
(unless (disconnect-id (signal-object qsignal)