Thu Jul 2 22:48:38 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* #_ reader macro enum calls & cleanup
hunk ./src/commonqt.lisp 21
- `(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)))
hunk ./src/commonqt.lisp 105
+(defclass signal-slot-mixin ()
+ ())
+
hunk ./src/commonqt.lisp 115
- (incf index)
hunk ./src/commonqt.lisp 117
- (apply #'emit-signal this signal-name args))))
+ (apply #'emit-signal this signal-name args)))
+ (incf index))
hunk ./src/commonqt.lisp 155
- (list (find-qclass (first qt-superclass)))
+ (list (find-qclass (first qt-superclass))
+ (find-class 'signal-slot-mixin))
hunk ./src/commonqt.lisp 160
+(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))))
+
hunk ./src/commonqt.lisp 189
- (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))
hunk ./src/commonqt.lisp 220
- (fdefinition 'int) #'identity)
+ (fdefinition 'int) #'identity
+ (fdefinition 'bool) #'identity
+ (fdefinition 'qstring) #'identity)
hunk ./src/package.lisp 23
- #:int))
+ #:int
+ #:bool
+ #:qstring
+ #:enum=))
hunk ./tests/test.lisp 15
- (#_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"))))