Thu Jul  2 22:48:38 CEST 2009  Tobias Rautenkranz <tobias@rautenkranz.ch>
  * #_ reader macro enum calls & cleanup
diff -rN -u old-commonqt/src/commonqt.lisp new-commonqt/src/commonqt.lisp
--- old-commonqt/src/commonqt.lisp	2014-10-30 07:09:24.000000000 +0100
+++ new-commonqt/src/commonqt.lisp	2014-10-30 07:09:24.000000000 +0100
@@ -18,10 +18,21 @@
             :args args))
         (let ((object (read stream)))
           (if (stringp object)
-              `(lambda (&rest args)
-                 (apply (symbol-function ',(smoke::lispify (symbol-name method) :cxx))
-                        (find-class ',(smoke::lispify object :cl-smoke.qt))
-                        args))
+              (if (upper-case-p (char (symbol-name method) 0))
+                  `(lambda ()
+                     ,(smoke::lispify 
+                       (concatenate 'string
+                                    (if (string= "Qt" object)
+                                        "+"
+                                        (concatenate 'string
+                                                     object
+                                                     ".+"))
+                                    (symbol-name method) "+")
+                       :cl-smoke.qt))
+                  `(lambda (&rest args)
+                     (apply (symbol-function ',(smoke::lispify (symbol-name method) :cxx))
+                            (find-class ',(smoke::lispify object :cl-smoke.qt))
+                            args)))
               `(lambda (&rest args)
                  (apply (symbol-function ',(smoke::lispify (symbol-name method) :cxx))
                         ,object
@@ -91,6 +102,9 @@
    (method-functions :documentation "The signals and slots.")
    (meta-object)))
 
+(defclass signal-slot-mixin ()
+  ())
+
 (defun setup-meta-object (class qt-superclass)
   (let ((methods (make-array (+ (length (slot-value class 'signals))
                                 (length (slot-value class 'qt-slots)))
@@ -98,10 +112,10 @@
                              :initial-element #'identity))
         (index 0))
     (dolist (signal-name (slot-value class 'signals))
-      (incf index)
       (setf (aref methods index)
             #'(lambda (this &rest args)
-                (apply #'emit-signal this signal-name args))))
+                (apply #'emit-signal this signal-name args)))
+      (incf index))
     (dolist (slot (slot-value class 'qt-slots))
       (setf (aref methods index)
             (if (symbolp (second slot))
@@ -138,42 +152,41 @@
          (cons `(:pointer (null-pointer) ,#'null-pointer)
                direct-default-initargs)
          :direct-superclasses
-         (list (find-qclass (first qt-superclass)))
+         (list (find-qclass (first qt-superclass))
+               (find-class 'signal-slot-mixin))
          args)
   (setup-meta-object qt-class (find-qclass (first qt-superclass))))
 
+(defmethod cxx:meta-object ((this signal-slot-mixin))
+  (slot-value (class-of this) 'meta-object))
+
+(defmethod cxx:qt-metacall ((this signal-slot-mixin) call id arguments)
+  (let ((m-id (call-next-method)))
+    (if (< m-id 0)
+        m-id
+        (if (enum= call cl-smoke.qt:meta-object.+invoke-meta-method+)
+            (progn
+              (when (< m-id (length (slot-value (class-of this)
+                                                'method-functions)))
+                (with-simple-restart
+                    (continue "Skip the method ~A of ~A."
+                              (cxx:signature
+                               (cxx:method (cxx:meta-object this) id))
+                              this)
+                  (apply (aref (slot-value (class-of this) 'method-functions)
+                               m-id)
+                         this
+                         (cl-smoke.qt-impl::arguments-to-lisp
+                          arguments
+                          (cl-smoke.qt-impl::method-arguments-type
+                           (cxx:meta-object this) id)))))
+              (- m-id
+                 (length (slot-value (class-of this) 'method-functions))))
+            m-id))))
+
 (defmethod initialize-instance :around ((class qt-class)
                                         &rest args)
-  (apply #'setup-qt-class class #'call-next-method args)
-  (closer-mop:ensure-method #'cxx:meta-object
-                            '(lambda (this)
-                              (slot-value (class-of this) 'meta-object))
-                            :specializers (list class))
-  (closer-mop:ensure-method
-   #'cxx:qt-metacall
-   '(lambda (this call id arguments)
-     (let ((m-id (call-next-method)))
-       (if (< m-id 0)
-           m-id
-           (if (enum= call cl-smoke.qt:meta-object.+invoke-meta-method+)
-               (progn
-                 (when (< m-id (length (slot-value (class-of this)
-                                                   'method-functions)))
-                   (with-simple-restart
-                       (continue "Skip the method ~A of ~A."
-                                 id
-                                 this)
-                     (apply (aref (slot-value (class-of this) 'method-functions)
-                                  m-id)
-                            this
-                            (cl-smoke.qt-impl::arguments-to-lisp
-                             arguments
-                             (cl-smoke.qt-impl::method-arguments-type
-                              (cxx:meta-object this) id)))))
-                 (- m-id
-                    (length (slot-value (class-of this) 'method-functions))))
-               m-id))))
-   :specializers (list class (find-class t) (find-class t) (find-class t))))
+  (apply #'setup-qt-class class #'call-next-method args))
 
 (defmethod reinitialize-instance :around ((qt-class qt-class) &rest args)
   (apply #'setup-qt-class qt-class #'call-next-method args))
@@ -204,7 +217,9 @@
 ;;;
 ;; No-op since we have overload resolution.
 (setf (fdefinition 'uint) #'identity
-      (fdefinition 'int) #'identity)
+      (fdefinition 'int) #'identity
+      (fdefinition 'bool) #'identity
+      (fdefinition 'qstring) #'identity)
 
 (defun find-qclass (class-name)
   "Returns the CLOS class for the C++ CLASS-NAME string."
diff -rN -u old-commonqt/src/package.lisp new-commonqt/src/package.lisp
--- old-commonqt/src/package.lisp	2014-10-30 07:09:24.000000000 +0100
+++ new-commonqt/src/package.lisp	2014-10-30 07:09:24.000000000 +0100
@@ -20,7 +20,10 @@
            #:primitive-value
            
            #:uint
-           #:int))
+           #:int
+           #:bool
+           #:qstring
+           #:enum=))
            
 ;; No named-readtables support; fake it.
 ;;
diff -rN -u old-commonqt/tests/test.lisp new-commonqt/tests/test.lisp
--- old-commonqt/tests/test.lisp	2014-10-30 07:09:24.000000000 +0100
+++ new-commonqt/tests/test.lisp	2014-10-30 07:09:24.000000000 +0100
@@ -12,7 +12,11 @@
 
 (5am:test enum
   (5am:is (enum= cl-smoke.qt:+blue+
-                 (#_blue "Qt"))))
+                 (#_blue "Qt")))
+  (5am:is (enum= cl-smoke.qt:font.+bold+
+                 (#_Bold "Font")))
+  (5am:is (enum= cl-smoke.qt:+key-enter+
+                 (#_Key_Enter "Qt"))))
 
 (5am:test new
   (5am:is (cxx:= (make-instance 'cl-smoke.qt:byte-array :args '("foobar"))