Thu Jul 23 00:21:01 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* support packages for symbols as property names.
hunk ./TODO 1
-* QApplication and KCmdLineArgs.init call exit() on e.g. "--help"
rmfile ./TODO
hunk ./qt.mbd 50
- ("application" (:needs "qt"))
+ ("application" (:needs "qt" "properties"))
hunk ./src/application.lisp 20
-(let ((argv (null-pointer))
- (argc (null-pointer)))
- (declare (cffi:foreign-pointer argv argc))
- (defun ensure-app (&optional [_$_]
- (application 'qt:application)
- (args #+sbcl sb-ext:*posix-argv*
- #+ccl ccl:*command-line-argument-list*
- #-(or sbcl ccl) (list (lisp-implementation-type))))
- "Constructs the global application object, when there is none,
+(defun ensure-app (&optional [_$_]
+ (application 'qt:application)
+ (args #+sbcl sb-ext:*posix-argv*
+ #+ccl ccl:*command-line-argument-list*
+ #-(or sbcl ccl) (list (lisp-implementation-type))))
+ "Constructs the global application object, when there is none,
hunk ./src/application.lisp 30
- (assert (not (null args))
- (args)
- "No program name supplied.")
- (if (qt:app-p)
- (progn
- (assert (typep (qt:app) (find-class application))
- (application)
- "The existing application object ~A is
+ (assert (not (null args))
+ (args)
+ "No program name supplied.")
+ (if (qt:app-p)
+ (progn
+ (assert (typep (qt:app) (find-class application))
+ (application)
+ "The existing application object ~A is
hunk ./src/application.lisp 39
- (values (qt:app) nil))
- (progn
- (when (not (null-pointer-p (smoke::pointer
- (qt:core-application.instance))))
- (cerror "Delete the active application." "Active application not created by QT:WITH-APP.")
- (smoke::delete-pointer (smoke::pointer (qt:core-application.instance))
- (find-class 'qt:core-application)))
- (foreign-free argv)
- (foreign-free argc)
+ (values (qt:app) nil))
+ (progn
+ (when (not (null-pointer-p (smoke::pointer
+ (qt:core-application.instance))))
+ (cerror "Delete the active application." "Active application not created by QT:WITH-APP.")
+ (smoke::delete-pointer (smoke::pointer (qt:core-application.instance))
+ (find-class 'qt:core-application)))
+ (let* ((argc (smoke:make-auto-pointer
+ (foreign-alloc :int :initial-element (length args))))
+ (argv (smoke:make-auto-pointer
+ (foreign-alloc :string :initial-contents args)))
+ (app (make-instance 'qt:application :args (list argc argv))))
+ ;; argc and argv must remain valid during the lifetime of APP.
+ (setf (qt:property app 'cmdline-args) [_$_]
+ (qt:make-lisp-variant (list argc argv)))
+ (tg:cancel-finalization app)
+ (values app t)))))
hunk ./src/application.lisp 57
- (setf argc (foreign-alloc :int :initial-element (length args)))
- (setf argv (foreign-alloc :string :initial-contents args))
- (let ((app (make-instance 'qt:application :args (list argc argv))))
- (tg:cancel-finalization app)
- (values app t)))))
- (defun kill-app ()
- (when (typep (qt:app) 'qt:application)
- (qt:application.close-all-windows)
- ;; widgets are only valid as long, as an application object exists.
- ;; QApplication::~QApplication() deletes all widgets in
- ;; QApplication::allWidgets().
- ;; [_$_]
- ;; see: qt4/src/gui/kernel/qapplication.cpp
- (loop for widget across (qt:application.all-widgets) do
- (trivial-garbage:cancel-finalization widget)))
- (cxx:quit (qt:app))
- (setf *widgets* nil)
- ;; Call the destructor; -> destructed callback is called,
- ;; (~QApplication() is virtual) which takes care of cleanup
- ;; on the Lisp side.
- (smoke::delete-pointer (smoke::pointer (qt:app)) (class-of (qt:app)))
- (setf (slot-value (qt:app) 'pointer) (null-pointer))
- (makunbound '*app*)))
+(defun kill-app ()
+ (when (typep (qt:app) 'qt:application)
+ (qt:application.close-all-windows)
+ ;; widgets are only valid as long, as an application object
+ ;; exists. QApplication::~QApplication() deletes all widgets in
+ ;; QApplication::allWidgets().
+ ;; [_$_]
+ ;; see: qt4/src/gui/kernel/qapplication.cpp
+ (loop for widget across (qt:application.all-widgets) do
+ (tg:cancel-finalization widget)))
+ (cxx:quit (qt:app))
+ (setf *widgets* nil)
+ ;; Call the destructor; -> destructed callback is called,
+ ;; (~QApplication() is virtual) which takes care of cleanup on the
+ ;; Lisp side.
+ (smoke::delete-pointer (smoke:pointer (qt:app)) (class-of (qt:app)))
+ (setf (slot-value (qt:app) 'pointer) (null-pointer))
+ (makunbound '*app*))
hunk ./src/object.lisp 102
-(defparameter *get-parent*
- (smoke::make-smoke-method-from-name (find-class 'qt:object) "parent"))
- ;; FIXME this leaks memory when QCoreApplication::exec is never called,
- ;; beause then, deleteLater has no effect.
-(defparameter *delete-later*
- (smoke::make-smoke-method-from-name (find-class 'qt:object) "deleteLater")))
+ (defparameter *get-parent*
+ (smoke::make-smoke-method-from-name (find-class 'qt:object) "parent"))
+
+ ;; FIXME this leaks memory when QCoreApplication::exec() is never
+ ;; called, beause then, deleteLater() has no effect.
+ (defparameter *delete-later*
+ (smoke::make-smoke-method-from-name (find-class 'qt:object) "deleteLater")))
hunk ./src/object.lisp 141
-;;; The event-notify callback get called by QCoreApplication,
-;;; on notification of an event.
+;;; The event-notify callback get called by QCoreApplication, on
+;;; notification of an event.
+;;;
+;;; The DATA argument is an array of size three, containing the
+;;; pointers:
hunk ./src/object.lisp 147
-;;; The DATA argument is an array of size three, containing the pointers:
hunk ./src/object.lisp 155
-;;; See: QCoreApplication::notifyInternal(QObject *receiver, QEvent *event)
+;;; See: QCoreApplication::notifyInternal(QObject *receiver, QEvent
+;;; *event)
hunk ./src/object.lisp 179
- ;; it was constructed by Smoke or not. Only take ownership of objects
- ;; that have been constructed by Smoke.
+ ;; it was constructed by Smoke or not. Only take ownership of
+ ;; objects that have been constructed by Smoke.
hunk ./src/operator.lisp 98
+ ;; RESOLUTION:
+ ;; wait for KDE 4.4 -- the new smoke_generator should fix this.
hunk ./src/painter.lisp 8
-still active and not yet garbage collected painters."
- `(let ((,painter (make-instance 'qt:painter :args (list ,paint-device))))
+still active and not yet garbage collected painters in CXX:PAINT-EVENT."
+ `(let ((,painter (make-instance 'qt:painter :arg0 ,paint-device)))
hunk ./src/properties.lisp 5
- (smoke::lisp-to-cxx (symbol-name symbol)))
+ (if (eq (symbol-package symbol)
+ (find-package :keyword))
+ (smoke::lisp-to-cxx (symbol-name symbol))
+ (concatenate 'string
+ (package-name (symbol-package symbol))
+ "::"
+ (symbol-name symbol))))
+
+(defun property-package (name)
+ (let ((package-end (search "::" name)))
+ (if package-end
+ (values [_$_]
+ (find-package (intern (subseq name 0 package-end) :keyword))
+ (+ 2 package-end))
+ (values (find-package :keyword) 0))))
+
+(defun lispify-property-name (name)
+ (multiple-value-bind (package name-start)
+ (property-package name)
+ (if (= 0 name-start)
+ (smoke::lispify name package)
+ (intern (subseq name name-start) package))))
hunk ./src/properties.lisp 36
+ (declare (type qt:object object)
+ (type (or string symbol) name))
+ (assert (qt:property-p object name)
+ (object name)
+ "~A has no property ~A." object name)
hunk ./src/properties.lisp 43
-
hunk ./src/properties.lisp 44
- (cxx:set-property object (property-name name)
- (make-instance 'qt:variant
- :args (list new-value)))
+ (declare (type qt:object object)
+ (type (or string symbol) name))
+ (cxx:set-property object (property-name name)
+ (make-instance 'qt:variant :arg0 new-value))
hunk ./src/properties.lisp 52
+ (declare (type qt:object object)
+ (type (or string symbol) name))
hunk ./src/properties.lisp 58
+ (declare (type qt:object object)
+ (type (or string symbol) name))
hunk ./src/properties.lisp 66
- collect (smoke::lispify (cxx:name (cxx:property meta-object index)))))
+ collect (lispify-property-name (cxx:name (cxx:property meta-object index)))))
+
+(defun sort-symbols (symbols)
+ (sort symbols
+ #'(lambda (a b)
+ (string<= (write-to-string a) (write-to-string b)))))
hunk ./src/properties.lisp 76
- (meta-object-properties (cxx:static-meta-object class)))
+ (sort-symbols
+ (meta-object-properties (cxx:static-meta-object class))))
hunk ./src/properties.lisp 89
- (map 'list (compose #'smoke::lispify #'cxx:data)
+ (map 'list (compose #'lispify-property-name #'cxx:data)
hunk ./src/properties.lisp 94
- (nconc (dynamic-properties object)
- (meta-object-properties (cxx:meta-object object))))
+ (declare (type qt:object object))
+ (sort-symbols
+ (nconc (dynamic-properties object)
+ (meta-object-properties (cxx:meta-object object)))))
hunk ./src/qstring.lisp 25
-;;; e.g.
+;;; e.g.:
hunk ./src/qstring.lisp 30
+;;; Use emacs 23 for better unicode support.
hunk ./src/qstring.lisp 37
-
hunk ./src/signal-slot/connect.lisp 129
- ;; FIXME: unset parent on disconnect
- ;; this no not critical because the slot object
- ;; is hidden from the user, who thus can not
- ;; connect it to other signals.
+ ;;
+ ;; FIXME: unset parent on disconnect.
+ ;; This no not critical because the slot
+ ;; object is not accessible to the user,
+ ;; who thus can not connect it to other
+ ;; signals.
hunk ./src/signal-slot/signal.lisp 51
- (apply #'emit (signal-object object) args))) [_$_]
- )
+ (apply #'emit (signal-object object) args))))
hunk ./src/signal-slot/signal.lisp 55
- ;; For efficiency assume that SLOT is normalized and fallback
- ;; to normalizing when not. (Just like Qt does.)
+ ;; For efficiency assume that SLOT is normalized and fallback to
+ ;; normalizing when not. (Just like Qt does.)
hunk ./src/signal-slot/signal.lisp 71
- (smoke::make-cleanup-pointer (make-cxx-lisp-object object)
- #'qt-smoke-free-lisp-object))
+ (smoke:make-cleanup-pointer (make-cxx-lisp-object object)
+ #'qt-smoke-free-lisp-object))
hunk ./src/signal-slot/signal.lisp 91
-;;; The first element of args would be used for the return value
-;;; by QMetaObject::invokeMethod(), but for signal-slot connection
-;;; it is ignored.
+;;; The first element of args would be used for the return value by
+;;; QMetaObject::invokeMethod(), but for signal-slot connection it is
+;;; ignored.
hunk ./src/signal-slot/slot.lisp 52
- ;; For efficiency assume that SIGNAL is normalized and fallback
- ;; to normalizing when not. (Just like Qt does.)
+ ;; For efficiency assume that SIGNAL is normalized and fallback to
+ ;; normalizing when not. (Just like Qt does.)
hunk ./src/signal-slot/translate.lisp 16
- (push (find-type arguments (1+ pos) last-pos) argument-types)
- (setf last-pos pos))
+ (push (find-type arguments (1+ pos) last-pos) argument-types)
+ (setf last-pos pos))
hunk ./src/signal-slot/translate.lisp 49
- ;; By value means that they are allocated by the C++ signal
- ;; code and have dynamic extend in the slot. The C++ signal code
- ;; frees the object when the slot returns.
+ ;; By-value means that the object at POINTER is allocated by
+ ;; the C++ signal code and has dynamic extend in the
+ ;; slot. The C++ signal code frees the object when the slot
+ ;; returns.
hunk ./src/signal-slot/translate.lisp 79
- (arguments-to-lisp2 (inc-pointer arguments ;; index 0 is for the return value
- (foreign-type-size :pointer))
- types ()))
+ (arguments-to-lisp2
+ (inc-pointer arguments ;; index 0 is for the return value
+ (foreign-type-size :pointer))
+ types ()))
hunk ./src/signal-slot/translate.lisp 90
- (error "FOO");;qmetatype.+voidstar+
+ (error "Not implemented: pointer type.") ;;qmetatype.+voidstar+
hunk ./src/signal-slot/translate.lisp 103
- ;;FIXME free TYPES on error.
+ ;; FIXME free TYPES on error.
hunk ./src/variant.lisp 18
- (make-instance 'qt:variant :args (list value))
+ (make-instance 'qt:variant :arg0 value)
hunk ./src/variant.lisp 25
- (1 (make-instance 'qt:char :args (list (aref octets 0))))
+ (1 (make-instance 'qt:char :arg0 (aref octets 0)))
hunk ./src/variant.lisp 27
- (aref octets 1))))
+ (aref octets 1))))
hunk ./src/variant.lisp 37
- "Returns the lisp character represented by CHAR."
+ "Returns the Lisp character represented by CHAR."
hunk ./src/variant.lisp 57
-;; FIXME include in MAKE-VARIANT?
+;; FIXME include in MAKE-VARIANT? how??
hunk ./src/variant.lisp 61
-The variant contains the actual Lisp object
+The variant contains the actual Lisp object VALUE