Wed Apr 8 17:16:04 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Fix receiving C++ arguments in signals
diff -rN -u old-qt.gui/src/signal-slot/translate.lisp new-qt.gui/src/signal-slot/translate.lisp
--- old-qt.gui/src/signal-slot/translate.lisp 2014-10-30 07:50:41.000000000 +0100
+++ new-qt.gui/src/signal-slot/translate.lisp 2014-10-30 07:50:41.000000000 +0100
@@ -31,23 +31,44 @@
(defun arguments-to-lisp2 (argument types values)
(if (null types)
values
- (arguments-to-lisp2 (inc-pointer argument (foreign-type-size :pointer))
- (rest types)
- (nconc values
- (list
- (typecase (first types)
- ;(smoke::smoke-standard-object
- ; (smoke::object-to-lisp
- ; (mem-ref
- ; (mem-ref argument
- ; :pointer) :pointer)
- ; (first types)))
- (smoke::smoke-type
- (smoke::type-to-lisp argument
- (first types)))
- (t
- (translate-cxx-lisp-object
- (mem-ref argument :pointer)))))))))
+ (arguments-to-lisp2 (inc-pointer argument (foreign-type-size :pointer))
+ (rest types)
+ (nconc values
+ (list
+ (typecase (first types)
+ (smoke::smoke-type
+ (pointer-to-lisp (mem-ref argument :pointer)
+ (first types)))
+
+ (t
+ (translate-cxx-lisp-object
+ (mem-ref argument :pointer)))))))))
+
+(defun pointer-to-lisp (pointer type)
+ (if (smoke::class-p type)
+ (smoke::object-to-lisp (mem-ref pointer :pointer) type)
+ (ecase (smoke::type-id type)
+ (0 (let ((cffi-type (smoke::get-type (name type))))
+ (if (null cffi-type)
+ (progn
+ pointer)
+ (convert-from-foreign pointer
+ cffi-type))))
+ (1 (mem-ref pointer 'cxx-bool))
+ (2 (code-char (mem-ref pointer :char)))
+ (3 (code-char (mem-ref pointer :unsigned-char)))
+ (4 (code-char (mem-ref pointer :short)))
+ (5 (code-char (mem-ref pointer :unsigned-short)))
+ (6 (mem-ref pointer :int))
+ (7 (mem-ref pointer :unsigned-int))
+ (8 (mem-ref pointer :long))
+ (9 (mem-ref pointer :unsigned-long))
+ (10 (mem-ref pointer :float))
+ (11 (mem-ref pointer :double))
+ (12 (make-instance 'enum
+ :value (mem-ref pointer :long)
+ :type type)))))
+
(defun arguments-to-lisp (arguments types)
(arguments-to-lisp2 (inc-pointer arguments ;; index 0 is for the return value