Sun Aug 2 13:15:21 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Support ownership transfer to non smoke wrapped QObjects & cleanup C++ to Lisp translation.

--- old-qt.gui/src/signal-slot/connect.lisp 2014-10-30 07:44:44.000000000 +0100

+++ new-qt.gui/src/signal-slot/connect.lisp 2014-10-30 07:44:44.000000000 +0100

@@ -13,7 +13,9 @@

(assert (= (length signal-arguments) (length slot-arguments)))

(loop for signal-arg in signal-arguments

for slot-arg in slot-arguments do

- (assert (subtypep signal-arg slot-arg))))

+ (if (typep signal-arg 'smoke::smoke-type)

+ (assert (smoke-type= signal-arg slot-arg))

+ (assert (subtypep signal-arg slot-arg)))))

;;FIXME check argument-types

(defmethod qt:connect ((qsignal qsignal) (qslot qslot) &optional type)

@@ -39,9 +41,10 @@

(defmethod qt:connect ((sender qsignal) (function function) &optional type)

(let ((slot (make-instance 'qslot

- :args (list (signal-object sender))

+ :arg0 (signal-object sender)

:argument-types (argument-types (signal-object sender))

:slot-function function)))

+

(unless (connect-id (signal-object sender) (id (signal-object sender))

slot (id slot)

type

@@ -63,6 +66,14 @@

:reader receiver))

(:documentation "Qt C++ slot."))

+(defmethod print-object ((qt-signal qt-signal) stream)

+ (print-unreadable-object (qt-signal stream :type t :identity t)

+ (when (slot-boundp qt-signal 'sender)

+ (princ (qsender qt-signal) stream))

+ (princ " " stream)

+ (when (slot-boundp qt-signal 'name)

+ (princ (name qt-signal) stream))))

+

(defgeneric qt:get-slot (receiver name)

(:documentation "Returns the slot of RECEIVER with NAME.")

(:method (receiver name)

@@ -70,18 +81,18 @@

(:method (receiver (function function))

"Returns a slot for RECEIVER that calls function

with RECEIVER as the first argument."

- (let ((slot (qt:make-slot #'(lambda (&rest args)

- (apply function (cxx:parent *this*)

- args)))))

- (cxx:set-parent slot receiver)

- slot)))

+ (make-instance 'qslot

+ :arg0 receiver

+ :slot-function #'(lambda (&rest args)

+ (apply function (cxx:parent *this*)

+ args)))))

(define-compiler-macro qt:get-slot (&whole form receiver name)

"Normalize the slot name."

(if (stringp name)

(let ((normalized-name (cxx:data

(qt:meta-object.normalized-signature name))))

- (if (string= name normalized-name) ;; Avoid loop

+ (if (string= name normalized-name) ;; Avoid infinite recursion

form

`(qt:get-slot ,receiver ,normalized-name)))

form))

@@ -95,7 +106,7 @@

(if (stringp name)

(let ((normalized-name (cxx:data

(qt:meta-object.normalized-signature name))))

- (if (string= name normalized-name) ;; Avoid loop

+ (if (string= name normalized-name) ;; Avoid infinite recursion

form

`(qt:get-signal ,sender ,normalized-name)))

form))

@@ -124,6 +135,7 @@

(defmethod qt:connect ((qt-signal qt-signal) (function function) &optional type)

(let* ((signal-id (find-signal-id (qsender qt-signal) (name qt-signal)))

(slot (make-instance 'qslot

+ :arg0 (qsender qt-signal)

:slot-function function

:argument-types

(method-arguments-type

@@ -137,17 +149,6 @@

;; object is not accessible to the user,

;; who thus can not connect it to other

;; signals.

- (if (smoke::has-pointer-p (smoke:pointer (qsender qt-signal)))

- (setf (cxx:parent slot) (qsender qt-signal))

- ;; when QT-SIGNAL is not a Smoke instance.

- (progn

- (unless (qt:property-p (qsender qt-signal) 'connected-slots)

- (setf (qt:property (qsender qt-signal) 'connected-slots)

- (qt:make-lisp-variant (list))))

- (setf (qt:property (qsender qt-signal) 'connected-slots)

- (qt:make-lisp-variant

- (cons slot

- (qt:property (qsender qt-signal) 'connected-slots))))))

(if (connect-id (qsender qt-signal) signal-id

slot (id slot)

type (types (arguments slot)))