Thu Aug 27 10:37:36 CEST 2009 Tobias Rautenkranz * Update to the new smokegenerator. diff -rN -u old-qt.gui/qt.mbd new-qt.gui/qt.mbd --- old-qt.gui/qt.mbd 2014-10-30 07:43:36.000000000 +0100 +++ new-qt.gui/qt.mbd 2014-10-30 07:43:36.000000000 +0100 @@ -51,7 +51,7 @@ ("application" (:needs "qt" "properties")) ("qstring" (:needs "qt")) ("list" (:needs "qt")) - ("msg-handler" (:needs "lib")) + ("msg-handler" (:needs "lib" "qt")) ("painter" (:needs "qt")) ("timer" (:needs "qt")) ("i18n" (:needs "qt")) diff -rN -u old-qt.gui/src/msg-handler.lisp new-qt.gui/src/msg-handler.lisp --- old-qt.gui/src/msg-handler.lisp 2014-10-30 07:43:36.000000000 +0100 +++ new-qt.gui/src/msg-handler.lisp 2014-10-30 07:43:36.000000000 +0100 @@ -8,6 +8,9 @@ ;; QtMsgHandler is a typedef for a pointer. (define-pointer-typedef "QtMsgHandler" foreign-pointer) +;; Smokegenerator +(define-pointer-typedef "void(*)(QtMsgType,const char*)" foreign-pointer) +(define-pointer-typedef "unsigned char*" foreign-pointer) (defcallback qt-msg-handler :void ((type qt-msg-type) diff -rN -u old-qt.gui/src/object.lisp new-qt.gui/src/object.lisp --- old-qt.gui/src/object.lisp 2014-10-30 07:43:36.000000000 +0100 +++ new-qt.gui/src/object.lisp 2014-10-30 07:43:36.000000000 +0100 @@ -11,12 +11,6 @@ (make-instance 'qt:meta-object :pointer (qt-smoke-meta-object (pointer object)))) -(eval-startup (:load-toplevel :compile-toplevel :execute) - (let ((object (make-instance 'qt:object))) - (defmethod cxx:static-meta-object ((class (eql (find-class 'qt:object)))) - "No OBJECT.STATIC-META-OBJECT (r558420)." - (cxx:meta-object object)))) - (defmethod cxx:static-meta-object ((class cxx:class)) (cxx:static-meta-object (smoke::find-smoke-class class))) @@ -40,8 +34,12 @@ (null-pointer-p (pointer object))) (call-next-method) (if (string= "" (cxx:object-name object)) - (print-unreadable-object (object stream :type t :identity t)) (print-unreadable-object (object stream :type t :identity t) + (when (smoke::const-p object) + (princ "CONST " stream))) + (print-unreadable-object (object stream :type t :identity t) + (when (smoke::const-p object) + (princ "CONST " stream)) (princ (cxx:object-name object) stream))))) (defmethod print-object ((object qt:meta-object) stream) @@ -85,13 +83,15 @@ ;; FIXME this might not be that smart. -(eval-startup () +(eval-startup (:compile-toplevel :execute) (defparameter *destroyed-slot* (qt:make-slot #'(lambda (object) (foreign-funcall-pointer (get-callback 'smoke::destructed) () :pointer (smoke:pointer object)))))) +(defvar *toplevel-objects* nil) + (defun ensure-smoke-parent (object) (declare (optimize (speed 3))) (let ((parent (cxx:parent object))) @@ -116,7 +116,9 @@ (qt:connect (qt:get-signal parent "destroyed(QObject*)") *destroyed-slot* qt:+direct-connection+) (tg:cancel-finalization parent) - (smoke::transfer-ownership-to parent (ensure-smoke-parent parent))) + (if (null-pointer-p (smoke:pointer (cxx:parent parent))) + (push parent *toplevel-objects*) + (smoke::transfer-ownership-to parent (ensure-smoke-parent parent)))) parent)) (defmethod initialize-instance :after ((object qt:object) diff -rN -u old-qt.gui/src/operator.lisp new-qt.gui/src/operator.lisp --- old-qt.gui/src/operator.lisp 2014-10-30 07:43:36.000000000 +0100 +++ new-qt.gui/src/operator.lisp 2014-10-30 07:43:36.000000000 +0100 @@ -1,4 +1,5 @@ (in-package :cl-smoke.qt-impl) +(declaim (optimize (debug 3))) (defun cxx:= (object &rest more-objects) (if (null more-objects) @@ -6,9 +7,11 @@ (every #'(lambda (o) ;; Consider Class::operator== and operator== ;; FIXME integrate this in the overload resolution - (handler-case (qt:operator== object o) - (smoke::no-applicable-cxx-method () - (cxx:operator== object o)))) + (if (typep object 'smoke::smoke-standard-object) + (handler-case (qt:operator== object o) + (smoke::no-applicable-cxx-method () + (cxx:operator== object o))) + (qt:operator== object o))) more-objects))) (defun cxx:/= (object &rest more-objects) @@ -88,15 +91,6 @@ (index) "Index ~A for ~A requested, but the length is ~A" index object (cxx:size object)) - ;; FIXME smoke generates no destructor for QByteRef - ;; kaylptusCxxToSmoke.pm 954: - ;; # Also, if the class has no explicit destructor, generate a default one. - ;; if ( !$hasDestructor && !$hasPrivatePureVirtual && !$isGlobalSpace && $classNode->{NodeType} ne 'namespace' ) { - ;; > $hasPublicDestructor = 1; - ;; > $hasPublicProtectedConstructor = 1; - ;; - ;; RESOLUTION: - ;; wait for KDE 4.4 -- the new smoke_generator should fix this. (cxx:operator= (cxx:operator[] object index) new-value) new-value) diff -rN -u old-qt.gui/src/qstring.lisp new-qt.gui/src/qstring.lisp --- old-qt.gui/src/qstring.lisp 2014-10-30 07:43:36.000000000 +0100 +++ new-qt.gui/src/qstring.lisp 2014-10-30 07:43:36.000000000 +0100 @@ -25,16 +25,16 @@ (smoke:eval-startup (:compile-toplevel :execute) (let ((method (smoke::make-smoke-method-from-name (find-class 'qt:byte-array) - "data"))) - (defmethod cxx:data ((array qt:byte-array)) + "constData"))) + (defmethod cxx:const-data ((array qt:byte-array)) (values ;; Discharge second return value (length of string) (foreign-string-to-lisp (smoke::pointer-call method (smoke::pointer array)) :count (cxx:size array)))))) (defun from-qstring (qstring) - (cxx:data (make-instance 'qt:byte-array - :pointer (qt-smoke-qstring-to-byte-array qstring)))) + (cxx:const-data (make-instance 'qt:byte-array + :pointer (qt-smoke-qstring-to-byte-array qstring)))) (define-to-lisp-translation ("QString" "const QString&") from-qstring qt-smoke-free-qstring) @@ -52,4 +52,6 @@ (if (null-pointer-p (pointer object)) (call-next-method) (print-unreadable-object (object stream :type t :identity t) - (prin1 (cxx:data object) stream)))) + (when (smoke::const-p object) + (princ "CONST " stream)) + (prin1 (cxx:const-data object) stream)))) 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:43:36.000000000 +0100 +++ new-qt.gui/src/signal-slot/connect.lisp 2014-10-30 07:43:36.000000000 +0100 @@ -114,7 +114,7 @@ (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+)) + (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)))) @@ -196,8 +196,8 @@ (qt:meta-object.connect sender signal-id receiver slot-id (if (null type) - (value qt:+auto-connection+) - (value type)) + qt:+auto-connection+ + type) types)) (defun disconnect-id (sender signal-id receiver slot-id)