Thu Aug 27 10:37:36 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Update to the new smokegenerator.

--- old-qt.gui/qt.mbd 2014-10-30 07:00:36.000000000 +0100

+++ new-qt.gui/qt.mbd 2014-10-30 07:00: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"))

--- old-qt.gui/src/msg-handler.lisp 2014-10-30 07:00:36.000000000 +0100

+++ new-qt.gui/src/msg-handler.lisp 2014-10-30 07:00: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)

--- old-qt.gui/src/object.lisp 2014-10-30 07:00:36.000000000 +0100

+++ new-qt.gui/src/object.lisp 2014-10-30 07:00: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)

--- old-qt.gui/src/operator.lisp 2014-10-30 07:00:36.000000000 +0100

+++ new-qt.gui/src/operator.lisp 2014-10-30 07:00: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)

--- old-qt.gui/src/qstring.lisp 2014-10-30 07:00:36.000000000 +0100

+++ new-qt.gui/src/qstring.lisp 2014-10-30 07:00: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))))

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

+++ new-qt.gui/src/signal-slot/connect.lisp 2014-10-30 07:00: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)