Thu Jul 2 23:49:43 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Fix signal to custom signal connection.

--- old-commonqt/src/commonqt.lisp 2014-10-24 16:12:46.000000000 +0200

+++ new-commonqt/src/commonqt.lisp 2014-10-24 16:12:46.000000000 +0200

@@ -66,14 +66,14 @@

(defun make-qapplication (&rest arguments)

"Returns a new QApplication instance with ARGUMENTS as command line

arguments argv. argv[0] is set to (LISP-IMPLEMNTATION-TYPE)."

- (let* ((argc ;(smoke::make-auto-pointer

+ (let* ((argc (smoke::make-auto-pointer

(cffi:foreign-alloc :int

- :initial-element (1+ (length arguments))))

- (argv ;(smoke::make-auto-pointer

+ :initial-element (1+ (length arguments)))))

+ (argv (smoke::make-auto-pointer

(cffi:foreign-alloc :string

:initial-contents

(cons (lisp-implementation-type) ;; arg0

- arguments)))

+ arguments))))

(application (make-instance 'cl-smoke.qt:application :args

(list argc argv))))

;; argc & argv must remain valid during the lifetime of application.

@@ -113,8 +113,9 @@

(index 0))

(dolist (signal-name (slot-value class 'signals))

(setf (aref methods index)

- #'(lambda (this &rest args)

- (apply #'emit-signal this signal-name args)))

+ (let ((signal-name (first signal-name)))

+ #'(lambda (this &rest args)

+ (apply #'emit-signal this signal-name args))))

(incf index))

(dolist (slot (slot-value class 'qt-slots))

(setf (aref methods index)

@@ -193,6 +194,7 @@

(defun emit-signal (object signal-name &rest arguments)

"Emits the signal SIGNAL-NAME of OBJECT using ARGUMENTS."

+ (declare (string signal-name))

(let* ((meta-object (slot-value (class-of object) 'meta-object))

(id (#_indexOfSignal meta-object signal-name)))

(assert (>= id 0)

@@ -215,10 +217,14 @@

;;; Type disambiguation

;;;

+(defun bool (value)

+ (ccase value

+ (1 t)

+ (0 nil)))

+

;; No-op since we have overload resolution.

(setf (fdefinition 'uint) #'identity

(fdefinition 'int) #'identity

- (fdefinition 'bool) #'identity

(fdefinition 'qstring) #'identity)

(defun find-qclass (class-name)

--- old-commonqt/tests/test.lisp 2014-10-24 16:12:46.000000000 +0200

+++ new-commonqt/tests/test.lisp 2014-10-24 16:12:46.000000000 +0200

@@ -63,7 +63,7 @@

(:slots ("listen(int)" (lambda (this &optional value)

(5am:is (= 37 value))

(setf (mumble-called this) t))))

- (:signals ("say(int)")))

+ (:signals ("say(int)") ("think(int)")))

(defmethod initialize-instance :after ((instance mumble) &rest initargs)

(declare (ignore initargs))

@@ -82,6 +82,20 @@

(5am:is (string= "QObject"

(#_className (#_superClass (#_metaObject mumble)))))))

+(5am:test (signal-signal :depends-on signal-slot)

+ (let ((mumble (make-instance 'mumble)))

+ (5am:is (eql t

+ (#_connect "QObject"

+ mumble (qt:qsignal "say(int)")

+ mumble (qt:qslot "listen(int)"))))

+ (5am:is (eql t

+ (#_connect "QObject"

+ mumble (qt:qsignal "think(int)")

+ mumble (qt:qsignal "say(int)"))))

+ (5am:is (eql nil (mumble-called mumble)))

+ (emit-signal mumble "think(int)" 37)

+ (5am:is (eql t (mumble-called mumble)))))

+

(5am:test make-qapplication

(let ((application (make-qapplication)))

(5am:is (eql (#_instance "QCoreApplication")