Thu Jun 11 16:59:48 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* :qt and :qt-impl packages to prevent collision with :cl symbols and fix object with non smoke parent.

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

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

@@ -1,12 +1,12 @@

-(in-package :qt)

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

-(defgeneric connect (qsignal slot &optional type)

+(defgeneric qt:connect (qsignal slot &optional type)

(:documentation "Connects a signal to a slot."))

-(defgeneric disconnect (qsignal slot)

+(defgeneric qt:disconnect (qsignal slot)

(:documentation "Disconnects a connection."))

-(defgeneric disconnect-all (qsignal)

+(defgeneric qt:disconnect-all (qsignal)

(:documentation "Disconnects all connections of QSIGNAL."))

(defun check-argument-types (signal-arguments slot-arguments)

@@ -16,7 +16,7 @@

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

;;FIXME check argument-types

-(defmethod connect ((qsignal qsignal) (qslot qslot) &optional type)

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

(assert (or (slot-boundp (signal-object qsignal) 'argument-types)

(slot-boundp qslot 'arguments))

((slot-value (signal-object qsignal) 'argument-types)

@@ -37,7 +37,7 @@

(types (arguments qslot)))

(cerror "Failed to connect ~S to ~S." qsignal qslot)))

-(defmethod connect ((sender qsignal) (function function) &optional type)

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

(let ((slot (make-instance 'qslot

:args (list (signal-object sender))

:slot-function function)))

@@ -62,63 +62,65 @@

:reader receiver))

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

-(defgeneric get-slot (receiver name)

+(defgeneric qt:get-slot (receiver name)

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

(:method (receiver name)

(make-instance 'qt-slot :receiver receiver :name name))

(:method (receiver (function function))

"Returns a slot for RECEIVER that calls function

with RECEIVER as the first argument."

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

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

- args)))))

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

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

+ args)))))

(cxx:set-parent slot receiver)

slot)))

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

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

"Normalize the slot name."

(if (stringp name)

- (let ((normalized-name (cxx:data (meta-object.normalized-signature name))))

+ (let ((normalized-name (cxx:data

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

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

form

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

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

form))

-(defun get-signal (sender name)

+(defun qt:get-signal (sender name)

"Returns the signal NAME of SENDER."

(make-instance 'qt-signal :sender sender :name name))

-(define-compiler-macro get-signal (&whole form sender name)

+(define-compiler-macro qt:get-signal (&whole form sender name)

"Normalize the signal name."

(if (stringp name)

- (let ((normalized-name (cxx:data (meta-object.normalized-signature name))))

+ (let ((normalized-name (cxx:data

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

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

form

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

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

form))

-(defmethod connect ((qt-signal qt-signal) (qt-slot qt-slot) &optional type)

- (unless (object.connect (qsender qt-signal) (qsignal (name qt-signal))

- (receiver qt-slot) (qslot (name qt-slot))

- (or type +auto-connection+))

+(defmethod qt:connect ((qt-signal qt-signal) (qt-slot qt-slot) &optional type)

+ (unless (qt:object.connect (qsender qt-signal) (qt:qsignal (name qt-signal))

+ (receiver qt-slot) (qt:qslot (name qt-slot))

+ (or type qt:+auto-connection+))

(cerror "Failed to connect ~A ~A to ~A ~A."

(qsender qt-signal) (name qt-signal)

(receiver qt-slot) (name qt-slot))))

-(defmethod disconnect ((qt-signal qt-signal) (qt-slot qt-slot))

- (unless (object.disconnect (qsender qt-signal) (qsignal (name qt-signal))

- (receiver qt-slot) (qslot (name qt-slot)))

+(defmethod qt:disconnect ((qt-signal qt-signal) (qt-slot qt-slot))

+ (unless (qt:object.disconnect (qsender qt-signal) (qt:qsignal (name qt-signal))

+ (receiver qt-slot) (qt:qslot (name qt-slot)))

(cerror "Failed to disconnect ~A ~A from ~A ~A."

(receiver qt-slot) (name qt-slot)

(qsender qt-signal) (name qt-signal))))

-(defmethod disconnect-all ((sender object))

- (unless (object.disconnect sender 0 0 0)

+(defmethod qt:disconnect-all ((sender qt:object))

+ (unless (qt:object.disconnect sender 0 0 0)

(cerror "Failed to disconnect everything connected to ~A."

sender)))

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

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

;; Set the sender as the slots parent,

@@ -141,7 +143,7 @@

(cerror "Ignore" "Failed to connect the signal ~S of ~S to the function ~S."

(name qt-signal) (qsender qt-signal) function))))

-(defmethod connect ((qt-signal qt-signal) (slot qslot) &optional type)

+(defmethod qt:connect ((qt-signal qt-signal) (slot qslot) &optional type)

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

(if (slot-boundp slot 'arguments)

(check-argument-types (method-arguments-type (cxx:meta-object

@@ -159,7 +161,7 @@

(cerror "Ignore" "Failed to connect the signal ~S of ~S to the slot ~S."

(name qt-signal) (qsender qt-signal) slot))))

-(defmethod connect ((qsignal qsignal) (slot qt-slot) &optional type)

+(defmethod qt:connect ((qsignal qsignal) (slot qt-slot) &optional type)

(let ((slot-id (find-slot-id (receiver slot) (name slot))))

(if (slot-boundp (signal-object qsignal) 'argument-types)

(check-argument-types (argument-types (signal-object slot))

@@ -177,12 +179,12 @@

(defun connect-id (sender signal-id receiver slot-id type types)

- (meta-object.connect sender signal-id

+ (qt:meta-object.connect sender signal-id

receiver slot-id

(if (null type)

- (value +auto-connection+)

+ (value qt:+auto-connection+)

(value type))

types))

(defun disconnect-id (sender signal-id receiver slot-id)

- (meta-object.disconnect sender signal-id receiver slot-id))

+ (qt:meta-object.disconnect sender signal-id receiver slot-id))