Thu Jun 4 12:58:29 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Normalize signal and slot names at compile time.
diff -rN -u old-qt.gui/src/signal-slot/connect.lisp new-qt.gui/src/signal-slot/connect.lisp
--- old-qt.gui/src/signal-slot/connect.lisp 2014-10-30 07:01:03.000000000 +0100
+++ new-qt.gui/src/signal-slot/connect.lisp 2014-10-30 07:01:03.000000000 +0100
@@ -50,7 +50,7 @@
(defclass qt-signal-slot-name ()
((name :initarg :name
- :reader name)))
+ :reader name)))
(defclass qt-signal (qt-signal-slot-name)
((sender :initarg :sender
@@ -66,10 +66,28 @@
"Returns the slot of RECEIVER with NAME."
(make-instance 'qt-slot :receiver receiver :name name))
+(define-compiler-macro get-slot (&whole form receiver name)
+ "Normalize the slot name."
+ (if (stringp name)
+ (let ((normalized-name (cxx:data (meta-object.normalized-signature name))))
+ (if (string= name normalized-name) ;; Avoid loop
+ form
+ `(get-slot ,receiver ,normalized-name)))
+ form))
+
(defun 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)
+ "Normalize the signal name."
+ (if (stringp name)
+ (let ((normalized-name (cxx:data (meta-object.normalized-signature name))))
+ (if (string= name normalized-name) ;; Avoid loop
+ form
+ `(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))
diff -rN -u old-qt.gui/src/signal-slot/signal.lisp new-qt.gui/src/signal-slot/signal.lisp
--- old-qt.gui/src/signal-slot/signal.lisp 2014-10-30 07:01:03.000000000 +0100
+++ new-qt.gui/src/signal-slot/signal.lisp 2014-10-30 07:01:03.000000000 +0100
@@ -54,8 +54,13 @@
(defun find-slot-id (receiver slot)
"Returns the ID of RECEIVER from SLOT."
+ ;; For efficency assume that SLOT is normalized and fallback
+ ;; to normalzing when not. (Just like Qt does.)
(let ((id (cxx:index-of-slot (cxx:meta-object receiver)
- (cxx:data (meta-object.normalized-signature slot)))))
+ slot)))
+ (when (< id 0)
+ (setf id (cxx:index-of-slot (cxx:meta-object receiver)
+ (cxx:data (meta-object.normalized-signature slot)))))
(when (< id 0)
(error "No slot ~S for class ~S.
The valid slots are: ~{~<~%~T~0,75:;~A ~>~}"
diff -rN -u old-qt.gui/src/signal-slot/slot.lisp new-qt.gui/src/signal-slot/slot.lisp
--- old-qt.gui/src/signal-slot/slot.lisp 2014-10-30 07:01:03.000000000 +0100
+++ new-qt.gui/src/signal-slot/slot.lisp 2014-10-30 07:01:03.000000000 +0100
@@ -47,8 +47,13 @@
(defun find-signal-id (sender signal)
"Returns the ID of SIGNAL from SENDER."
+ ;; For efficency assume that SIGNAL is normalized and fallback
+ ;; to normalzing when not. (Just like Qt does.)
(let ((id (cxx:index-of-signal (cxx:meta-object sender)
- (cxx:data (meta-object.normalized-signature signal)))))
+ signal)))
+ (when (< id 0)
+ (setf id (cxx:index-of-signal (cxx:meta-object sender)
+ (cxx:data (meta-object.normalized-signature signal)))))
(when (< id 0)
(error "No signal ~S for class ~S."
signal (class-of sender)))