Thu Jul 2 21:12:45 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* move emit slot code to new function ACTIVATE & image startup fix for STATIC-META-OBJECT

--- old-qt.gui/src/object.lisp 2014-10-30 07:00:51.000000000 +0100

+++ new-qt.gui/src/object.lisp 2014-10-30 07:00:51.000000000 +0100

@@ -1,11 +1,13 @@

(in-package :cl-smoke.qt-impl)

-(let ((object (make-instance 'qt:object)))

- (defmethod cxx:static-meta-object ((class (eql (find-class 'qt:object))))

- "No OBJECT.STATIC-META-OBJECT (r558420)."

- (cxx:meta-object object))

- (defmethod cxx:static-meta-object ((class cxx:class))

- (cxx:static-meta-object (smoke::find-smoke-class class))))

+(smoke:eval-startup (:load-toplevel :compile-toplevel :execute)

+ (let ((object (make-instance 'qt:object)))

+ (defmethod cxx:static-meta-object ((class (eql (find-class 'qt:object))))

+ "No OBJECT.STATIC-META-OBJECT (r558420)."

+ (cxx:meta-object object))))

+

+(defmethod cxx:static-meta-object ((class cxx:class))

+ (cxx:static-meta-object (smoke::find-smoke-class class)))

(defmethod documentation :around ((class smoke::smoke-standard-class)

(doc-type (eql 't)))

--- old-qt.gui/src/signal-slot/signal.lisp 2014-10-30 07:00:51.000000000 +0100

+++ new-qt.gui/src/signal-slot/signal.lisp 2014-10-30 07:00:51.000000000 +0100

@@ -86,16 +86,18 @@

(defun emit (qsignal &rest arguments)

"Emits the signal QSIGNAL."

+ (activate qsignal (id qsignal) (argument-types qsignal) arguments))

+

+(defun activate (object id types arguments)

;;; The first element of args would be used for the return value

;;; by QMetaObject::invokeMethod(), but for signal-slot connection

;;; it is ignored.

- (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

+ (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 types

+ do

(setf (mem-aref args :pointer i)

(if (or (not (typep type (find-class 'smoke::smoke-type)))

(= 0 (smoke::type-id type))

@@ -110,11 +112,9 @@

'smoke::smoke-stack-item

i)

'smoke::smoke-stack-item 'smoke::voidp))))

- (setf (mem-aref args :pointer 0)

- (null-pointer))

- (qt:meta-object.activate qsignal (cxx:meta-object qsignal)

- (id qsignal)

- args)))))

+ (setf (mem-aref args :pointer 0)

+ (null-pointer))

+ (qt:meta-object.activate object id args))))

(defmethod qt:disconnect-all ((qsignal qsignal))

(unless (disconnect-id (signal-object qsignal)