Thu Jun 11 16:59:48 CEST 2009 Tobias Rautenkranz * :qt and :qt-impl packages to prevent collision with :cl symbols and fix object with non smoke parent. diff -rN -u old-qt.gui/qt.mbd new-qt.gui/qt.mbd --- old-qt.gui/qt.mbd 2014-10-30 07:46:45.000000000 +0100 +++ new-qt.gui/qt.mbd 2014-10-30 07:46:45.000000000 +0100 @@ -11,7 +11,7 @@ (:default-initargs :type "txt")) (defclass sysdef.cmake:cmake-library (component) - ()) + ((package :initarg :package))) ;;; end SYSDEF.CMAKE (in-package :sysdef-user) @@ -34,7 +34,7 @@ ("lib" module (:needs "package") (:components - ("libqt-smoke-extra" sysdef.cmake:cmake-library) + ("libqt-smoke-extra" sysdef.cmake:cmake-library (:package :cl-smoke.qt-impl)) ("CMakeLists.txt" static-file) ("qt-smoke.cpp" static-file) diff -rN -u old-qt.gui/src/application.lisp new-qt.gui/src/application.lisp --- old-qt.gui/src/application.lisp 2014-10-30 07:46:45.000000000 +0100 +++ new-qt.gui/src/application.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,4 +1,4 @@ -(in-package :qt) +(in-package :cl-smoke.qt-impl) (declaim (optimize (debug 3))) @@ -7,15 +7,15 @@ (defvar *exec-p* t "Run exec if true and not otherwise.") -(defun app () +(defun qt:app () "Returns the APPLICATION (or CORE-APPLICATION) object, within a WITH-APP." - (assert (app-p) + (assert (qt:app-p) (*app*) "No application.") *app*) -(defun app-p () +(defun qt:app-p () "Returns t when the APPLICATION object exists and nil otherwise." (boundp '*app*)) @@ -24,7 +24,7 @@ (argc (null-pointer))) (declare (cffi:foreign-pointer argv argc)) (defun ensure-app (&optional - (application 'application) + (application 'qt:application) (args #+sbcl sb-ext:*posix-argv* #+ccl ccl:*command-line-argument-list* #-(or sbcl ccl) (list (lisp-implementation-type)))) @@ -36,17 +36,19 @@ (assert (not (null args)) (args) "No program name supplied.") - (if (app-p) + (if (qt:app-p) (progn - (assert (typep (app) (find-class application)) + (assert (typep (qt:app) (find-class application)) (application) "The existing application object ~A is -not of type ~A." (app) (find-class application)) - (values (app) nil)) +not of type ~A." (qt:app) (find-class application)) + (values (qt:app) nil)) (progn - (assert (null-pointer-p (smoke::pointer (core-application.instance))) - () - "Active QCoreApplication not created by QT:WITH-APP.") + (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) @@ -56,22 +58,22 @@ (tg:cancel-finalization app) (values app t))))) (defun kill-app () - (when (typep (app) 'application) - (application.close-all-windows) + (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 (application.all-widgets) do + (loop for widget across (qt:application.all-widgets) do (trivial-garbage:cancel-finalization widget))) - (cxx:quit (app)) + (cxx:quit (qt:app)) (setf *widgets* nil) ;; Call the destructer; -> destructed callback is called, ;; (~QApplication() is virtual) which takes care of cleanup ;; on the Lisp side. - (smoke::delete-pointer (smoke::pointer (app)) (class-of (app))) - (setf (slot-value (app) 'pointer) (null-pointer)) + (smoke::delete-pointer (smoke::pointer (qt:app)) (class-of (qt:app))) + (setf (slot-value (qt:app) 'pointer) (null-pointer)) (makunbound '*app*))) (defmacro with-application ((ensure-app remove-app) &body body) @@ -82,7 +84,7 @@ (when ,cleanup-p ,remove-app))))) -(defmacro with-app (&body body) +(defmacro qt:with-app (&body body) "Ensures that a APPLICATION instance exists, evaluates BODY and executes the APPLICATION instance after BODY. The instance can be accessed with: @@ -92,20 +94,20 @@ When a APPLICATION was created, it will be deleted when returning from BODY." - `(with-application ((ensure-app 'application) (kill-app)) + `(with-application ((cl-smoke.qt-impl::ensure-app 'qt:application) (kill-app)) ,@body)) -(defmacro with-core-app (&body body) - `(with-application ((ensure-app 'core-application) (kill-app)) +(defmacro qt:with-core-app (&body body) + `(with-application ((cl-smoke.qt-impl::ensure-app 'qt:core-application) (kill-app)) ,@body)) -(defun exec (&rest widgets) +(defun qt:exec (&rest widgets) "Executes APP." (setf *widgets* (append widgets *widgets*)) (when *exec-p* - (restart-bind ((abort-app #'(lambda () - (cxx:quit (app)) + (restart-bind ((qt::abort-app #'(lambda () + (cxx:quit (qt:app)) (invoke-restart (find-restart 'continue))) :report-function #'(lambda (stream) @@ -113,6 +115,6 @@ :test-function #'(lambda (condition) (declare (ignore condition)) - (and (app-p) + (and (qt:app-p) (find-restart 'continue))))) - (cxx:exec (app))))) + (cxx:exec (qt:app))))) diff -rN -u old-qt.gui/src/i18n.lisp new-qt.gui/src/i18n.lisp --- old-qt.gui/src/i18n.lisp 2014-10-30 07:46:45.000000000 +0100 +++ new-qt.gui/src/i18n.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,6 +1,6 @@ -(in-package :qt) +(in-package :cl-smoke.qt-impl) -(defun tr (message &optional context) +(defun qt:tr (message &optional context) "Returns the translated MESSAGE for CONTEXT or a string STRING-EQUAL to MESSAGE when no translation was found. @@ -14,13 +14,13 @@ ,@body) (cxx:remove-translator (qt:app) ,translator))) -(defmacro with-translator ((base-name &rest paths) &body body) +(defmacro qt:with-translator ((base-name &rest paths) &body body) "Loads the translations in the BASE-NAME_LANGCODE.qm file; searching PATHS. Must be in a WITH-APP." (let ((translator (gensym))) - `(let ((,translator (make-instance 'translator))) + `(let ((,translator (make-instance 'qt:translator))) (unless (find-if #'(lambda (path) (cxx:load ,translator @@ -33,12 +33,12 @@ (with-installed-translator ,translator ,@body)))) -(defmacro with-libqt-translator (&body body) +(defmacro qt:with-libqt-translator (&body body) "Loads the translations for the Qt library. Must be in a WITH-APP." (let ((translator (gensym))) - `(let ((,translator (make-instance 'translator))) + `(let ((,translator (make-instance 'qt:translator))) (unless (cxx:load ,translator (format nil "qt_~A" (cxx:name (qt:locale.system))) (qt:library-info.location qt:library-info.+translations-path+)) @@ -46,7 +46,7 @@ (with-installed-translator ,translator ,@body)))) -(defun search-file (name &rest paths) +(defun qt:search-file (name &rest paths) "Searches the file NAME in PATHS and returns its path." (let ((file-path (find-if #'(lambda (path) (probe-file (merge-pathnames name path))) diff -rN -u old-qt.gui/src/lisp-object.lisp new-qt.gui/src/lisp-object.lisp --- old-qt.gui/src/lisp-object.lisp 2014-10-30 07:46:45.000000000 +0100 +++ new-qt.gui/src/lisp-object.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,4 +1,4 @@ -(in-package :qt) +(in-package :cl-smoke.qt-impl) (defvar *cxx-lisp-objects* (smoke::make-synchronized-hash-table) "Objects that are currently passed in a C++ class.") @@ -33,7 +33,7 @@ (setf *cxx-lisp-object-metatype* (qt-smoke-setup-lisp-object (callback destruct-cxx-lisp-object))) (assert (>= *cxx-lisp-object-metatype* - (smoke::value meta-type.+user+)) + (smoke::value qt:meta-type.+user+)) (*cxx-lisp-object-metatype*) "setup of lisp-object failed")) diff -rN -u old-qt.gui/src/list.lisp new-qt.gui/src/list.lisp --- old-qt.gui/src/list.lisp 2014-10-30 07:46:45.000000000 +0100 +++ new-qt.gui/src/list.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,4 +1,4 @@ -(in-package :qt) +(in-package :cl-smoke.qt-impl) (defmacro define-qlist-wrapper (type-name &optional c-name) (let* ((c-name (or c-name type-name)) 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:46:45.000000000 +0100 +++ new-qt.gui/src/msg-handler.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,4 +1,4 @@ -(in-package :qt) +(in-package :cl-smoke.qt-impl) (cffi:defcenum qt-msg-type (:debug-message) 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:46:45.000000000 +0100 +++ new-qt.gui/src/object.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,15 +1,15 @@ -(in-package :qt) +(in-package :cl-smoke.qt-impl) -(let ((object (make-instance 'object))) - (defmethod cxx:static-meta-object ((class (eql (find-class 'object)))) +(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)))) -(defmethod documentation :around ((class cxx:class) - (doc-type t)) - (if (and (subtypep class (find-class 'object)) +(defmethod documentation :around ((class smoke::smoke-standard-class) + (doc-type (eql 't))) + (if (and (subtypep class (find-class 'qt:object)) (not (subtypep class (find-class 'cxx:class)))) (format nil "~@[~A~%~]Properties:~%~T~{~<~%~T~0,75:; ~(~A~)~>~} @@ -17,12 +17,12 @@ ~{~T~A~%~} Slots: ~{~T~A~%~}" - (call-next-method) (sort (class-properties class) #'string<=) + (call-next-method) (sort (qt:class-direct-properties class) #'string<=) (sort (class-signals class) #'string<=) (sort (class-slots class) #'string<=)) (call-next-method))) -(defmethod print-object ((object object) stream) +(defmethod print-object ((object qt:object) stream) (if (or (not (slot-boundp object 'pointer)) (null-pointer-p (pointer object))) (call-next-method) @@ -35,27 +35,43 @@ collect (cxx:method meta-object index))) -(defun meta-object-signals (meta-object) +(defun meta-object-signals (meta-object &key all) (mapcar #'cxx:signature (remove-if-not #'(lambda (m) (enum= qt:meta-method.+signal+ (cxx:method-type m))) - (meta-object-methods meta-object)))) + (meta-object-methods meta-object (not all))))) -(defun class-signals (class) - (meta-object-signals (cxx:static-meta-object class))) +(defun class-signals (class &key all) + (meta-object-signals (cxx:static-meta-object class) :all all)) -(defun meta-object-slots (meta-object) +(defun meta-object-slots (meta-object &key all) (mapcar #'cxx:signature (remove-if-not #'(lambda (m) (enum= qt:meta-method.+slot+ (cxx:method-type m))) - (meta-object-methods meta-object)))) + (meta-object-methods meta-object (not all))))) -(defun class-slots (class) - (meta-object-slots (cxx:static-meta-object class))) +(defun class-slots (class &key all) + (meta-object-slots (cxx:static-meta-object class) :all all)) +(defun parent-p (object) + (not (null-pointer-p (smoke::pointer-call (smoke::make-smoke-method (find-class 'qt:object) + "parent") + (smoke::pointer object))))) + +(defun find-smoke-parent (object) + "Returns the first parent of OBJECT or OBJECT that is a Smoke class. +(the destructed callback is called when the object is freed.)" + ;; FIXME allow usage of non smoke objects by connecting to the + ;; destroyed() signal. + (let ((parent (cxx:parent object))) + (if (not (null-pointer-p (smoke::pointer parent))) + (if (smoke::has-pointer-p (smoke::pointer parent)) + parent + (find-smoke-parent parent)) + (error "No smoke parent found.")))) -(defmethod initialize-instance :after ((object object) +(defmethod initialize-instance :after ((object qt:object) &key pointer &allow-other-keys) "Registers the object to the parent when a parent was set in the constructor and the objects metaclass is SMOKE-WRAPPER-CLASS." @@ -64,9 +80,9 @@ (error "Object ~A has not been constructed" object)) (when (and (null pointer) (not (null-pointer-p (smoke::pointer object))) -; (typep (class-of object) 'cxx:class) - (not (null-pointer-p (smoke::pointer (cxx:parent object))))) - (smoke::transfer-ownership-to object (cxx:parent object)))) + (parent-p object)) + (smoke::transfer-ownership-to object + (find-smoke-parent object)))) (define-condition wrapper-gc (storage-condition) ((class-name :initarg :class-name @@ -95,7 +111,7 @@ (with-output-to-string (stream) (print-object object stream))) -(defmethod smoke::make-finalize ((object object)) +(defmethod smoke::make-finalize ((object qt:object)) "Delete the qt:object OBJECT, by calling cxx:delete-later iff it has no parent." (let ((pointer (pointer object)) @@ -121,6 +137,7 @@ (smoke::report-finalize-error condition "qt:object" (name class) pointer))))))) + ;;; ;;; The event-notify callback get called by QCoreApplication, ;;; on notification of an event. @@ -140,19 +157,22 @@ ((data :pointer)) (declare (optimize (speed 3))) (let ((receiver (smoke::get-object (cffi:mem-aref data :pointer 0))) - (event (make-instance 'event :pointer (cffi:mem-aref data :pointer 1)))) + (event (make-instance 'qt:event + :pointer (cffi:mem-aref data :pointer 1)))) (enum-case (cxx:type event) - (event.+child-added+ - (let ((child-event (make-instance 'child-event + (qt:event.+child-added+ + (let ((child-event (make-instance 'qt:child-event :pointer - (smoke::upcast event (find-class 'child-event))))) + (smoke::upcast event (find-class 'qt:child-event))))) + (tg:cancel-finalization (cxx:child child-event)) (when (smoke::has-pointer-p (smoke::pointer (cxx:child child-event))) - (assert receiver) + (unless receiver + (setf receiver (find-smoke-parent (cxx:child child-event)))) (smoke::transfer-ownership-to (cxx:child child-event) receiver)))) - (event.+child-removed+ - (let* ((child-event (make-instance 'child-event + (qt:event.+child-removed+ + (let* ((child-event (make-instance 'qt:child-event :pointer (smoke::upcast event - (find-class 'child-event))))) + (find-class 'qt:child-event))))) ;; We receive child removed events for any QObject, wherter ;; it was construted by Smoke or not. Only take ownership of objects ;; that have been constructed by Smoke. 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:46:45.000000000 +0100 +++ new-qt.gui/src/operator.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,4 +1,4 @@ -(in-package :qt) +(in-package :cl-smoke.qt-impl) (defun cxx:= (object &rest more-objects) (if (null more-objects) diff -rN -u old-qt.gui/src/ownership.lisp new-qt.gui/src/ownership.lisp --- old-qt.gui/src/ownership.lisp 2014-10-30 07:46:45.000000000 +0100 +++ new-qt.gui/src/ownership.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,7 +1,7 @@ -(in-package :qt) +(in-package :cl-smoke.qt-impl) ;; undo-stack -(define-takes-ownership cxx:push ((undo-stack undo-stack) undo-command) +(define-takes-ownership cxx:push ((undo-stack qt:undo-stack) undo-command) undo-command) @@ -23,46 +23,46 @@ ;; AbstractFileEngine::beginEntryList return value ;; grid-layout -(define-takes-ownership cxx:add-item ((layout grid-layout) (item layout-item) +(define-takes-ownership cxx:add-item ((layout qt:grid-layout) (item qt:layout-item) row column) item) -(define-takes-ownership cxx:add-item ((layout grid-layout) (item layout-item) +(define-takes-ownership cxx:add-item ((layout qt:grid-layout) (item qt:layout-item) row column row-span) item) -(define-takes-ownership cxx:add-item ((layout grid-layout) (item layout-item) +(define-takes-ownership cxx:add-item ((layout qt:grid-layout) (item qt:layout-item) row column row-span colum-span) item) -(define-takes-ownership cxx:add-item ((layout grid-layout) (item layout-item) +(define-takes-ownership cxx:add-item ((layout qt:grid-layout) (item qt:layout-item) row column row-span colum-span aligment) item) -(define-takes-ownership cxx:add-item ((layout layout) (item layout-item)) +(define-takes-ownership cxx:add-item ((layout qt:layout) (item qt:layout-item)) item) ;; QIcon::QIcon(QIconEngine* engine) -(define-takes-ownership cxx:register-editor ((factory item-editor-factory) +(define-takes-ownership cxx:register-editor ((factory qt:item-editor-factory) type creator) creator) -(define-takes-ownership cxx:set-child ((this standard-item) row colum item) +(define-takes-ownership cxx:set-child ((this qt:standard-item) row colum item) item) -(define-takes-ownership cxx:set-child ((this standard-item) row item) +(define-takes-ownership cxx:set-child ((this qt:standard-item) row item) item) -(define-takes-ownership cxx:set-horizontal-header-item ((this standard-item-model) +(define-takes-ownership cxx:set-horizontal-header-item ((this qt:standard-item-model) column item) item) -(define-takes-ownership cxx:set-vertical-header-item ((this standard-item-model) +(define-takes-ownership cxx:set-vertical-header-item ((this qt:standard-item-model) row item) item) -(define-takes-ownership cxx:set-item ((this standard-item-model) +(define-takes-ownership cxx:set-item ((this qt:standard-item-model) row column item) item) -(define-takes-ownership cxx:set-item ((this standard-item-model) +(define-takes-ownership cxx:set-item ((this qt:standard-item-model) row item) item) -(define-takes-ownership cxx:set-item-prototype ((this standard-item-model) +(define-takes-ownership cxx:set-item-prototype ((this qt:standard-item-model) item) item) diff -rN -u old-qt.gui/src/package.lisp new-qt.gui/src/package.lisp --- old-qt.gui/src/package.lisp 2014-10-30 07:46:45.000000000 +0100 +++ new-qt.gui/src/package.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,5 +1,9 @@ -(defpackage :qt - (:use :cl :smoke :cffi :bordeaux-threads :cxx-support :alexandria) +(defpackage :cl-smoke.qt-impl + (:use :cl :smoke :cffi :bordeaux-threads :cxx-support :alexandria)) + +(defpackage :cl-smoke.qt + (:use) ;; do not use :cl to prevent collition with TIME and CHAR + (:nicknames :qt) (:export #:app #:app-p #:exec @@ -26,6 +30,9 @@ #:class-properties #:class-direct-properties + #:make-char + #:from-char + #:from-variant #:make-variant #:make-lisp-variant @@ -35,6 +42,8 @@ #:search-file #:connect + #:disconnect + #:disconnect-all #:get-slot #:get-signal #:make-slot diff -rN -u old-qt.gui/src/painter.lisp new-qt.gui/src/painter.lisp --- old-qt.gui/src/painter.lisp 2014-10-30 07:46:45.000000000 +0100 +++ new-qt.gui/src/painter.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,12 +1,12 @@ -(in-package :qt) +(in-package :cl-smoke.qt-impl) -(defmacro with-painter ((painter paint-device) &body body) +(defmacro qt:with-painter ((painter paint-device) &body body) "Binds a PAINTER instance for PAINT-DEVICE to PAINTER during the evaulation of BODY. Makes sure the painter ends after BODY; thus prevening problems with still active and not yet garbage collected painters." - `(let ((,painter (make-instance 'painter :args (list ,paint-device)))) + `(let ((,painter (make-instance 'qt:painter :args (list ,paint-device)))) (assert (cxx:is-active ,painter) (,painter) "Painter ~A for ~A is not active" diff -rN -u old-qt.gui/src/properties.lisp new-qt.gui/src/properties.lisp --- old-qt.gui/src/properties.lisp 2014-10-30 07:46:45.000000000 +0100 +++ new-qt.gui/src/properties.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,4 +1,4 @@ -(in-package :qt) +(in-package :cl-smoke.qt-impl) (defun reverse-lispify (symbol) "Converts the name of symbol to C++ style." @@ -10,24 +10,24 @@ (string name) (symbol (reverse-lispify name)))) -(defun property (object name) +(defun qt:property (object name) "Returns the property NAME of OBJECT." - (from-variant (cxx:property object (property-name name)))) + (qt:from-variant (cxx:property object (property-name name)))) -(defun (setf property) (new-value object name) +(defun (setf qt:property) (new-value object name) (cxx:set-property object (property-name name) (make-instance 'qt:variant :args (list new-value))) new-value) -(defun remove-property (object name) +(defun qt:remove-property (object name) "Removes the property NAME from OBJECT." - (setf (property object name) (qt:make-variant))) + (setf (qt:property object name) (qt:make-variant))) -(defun property-p (object name) +(defun qt:property-p (object name) "Returns T when NAME is a property of OBJECT and NIL otherwise." - (variant-boundp (cxx:property object (property-name name)))) + (qt:variant-boundp (cxx:property object (property-name name)))) (defun meta-object-properties (meta-object &optional (all t)) "Returns a list of the properties of META-OBJECT." @@ -35,25 +35,25 @@ below (cxx:property-count meta-object) collect (smoke::lispify (cxx:name (cxx:property meta-object index))))) -(defgeneric class-properties (class) +(defgeneric qt:class-properties (class) (:documentation "Returns a list of the properties of CLASS.") (:method ((class class)) (meta-object-properties (cxx:static-meta-object class))) (:method ((symbol symbol)) - (class-properties (find-class symbol)))) + (qt:class-properties (find-class symbol)))) -(defgeneric class-direct-properties (class) +(defgeneric qt:class-direct-properties (class) (:documentation "Returns a list of the properties of CLASS.") (:method ((class class)) (meta-object-properties (cxx:static-meta-object class) nil)) (:method ((symbol symbol)) - (class-direct-properties (find-class symbol)))) + (qt:class-direct-properties (find-class symbol)))) (defun dynamic-properties (object) (map 'list (compose #'smoke::lispify #'cxx:data) (cxx:dynamic-property-names object))) -(defun properties (object) +(defun qt:properties (object) "Returns a list of the properties of OBJECT." (nconc (dynamic-properties object) (meta-object-properties (cxx:meta-object object)))) 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:46:45.000000000 +0100 +++ new-qt.gui/src/qstring.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,4 +1,4 @@ -(in-package :qt) +(in-package :cl-smoke.qt-impl) (defcfun qt-smoke-string-to-qstring :pointer (data :string) @@ -28,26 +28,26 @@ ;;; (setq slime-net-coding-system 'utf-8-unix) ;;; to .emacs helps. (smoke:eval-startup (:compile-toplevel :execute) - (text-codec.set-codec-for-cstrings - (text-codec.codec-for-name (string *default-foreign-encoding*))) - (text-codec.set-codec-for-locale - (text-codec.codec-for-name (string *default-foreign-encoding*)))) + (qt:text-codec.set-codec-for-cstrings + (qt:text-codec.codec-for-name (string *default-foreign-encoding*))) + (qt:text-codec.set-codec-for-locale + (qt:text-codec.codec-for-name (string *default-foreign-encoding*)))) (define-parse-method qstring () (make-instance 'qstring)) (smoke:eval-startup (:compile-toplevel :execute) -(let ((method (smoke::make-smoke-method (find-class 'byte-array) +(let ((method (smoke::make-smoke-method (find-class 'qt:byte-array) "data"))) - (defmethod cxx:data ((array byte-array)) + (defmethod cxx:data ((array qt:byte-array)) (values ;; Discarge second return value (length of string) (foreign-string-to-lisp (smoke::pointer-call method (smoke::pointer array)) :count (cxx:size array)))))) (defmethod translate-from-foreign (string (type qstring)) - (cxx:data (make-instance 'byte-array + (cxx:data (make-instance 'qt:byte-array :pointer (qt-smoke-qstring-to-byte-array string)))) (defmethod free-translated-object (pointer (type qstring) param) @@ -59,7 +59,7 @@ (with-foreign-string ((data length) string :null-terminated-p nil) (qt-smoke-string-to-qstring data length)) #'(lambda (pointer) - (free-translated-object pointer (make-instance 'qt::qstring) + (free-translated-object pointer (make-instance 'qstring) nil)))) (define-from-lisp-translation ("const QString&" "QString") string diff -rN -u old-qt.gui/src/qt.lisp new-qt.gui/src/qt.lisp --- old-qt.gui/src/qt.lisp 2014-10-30 07:46:45.000000000 +0100 +++ new-qt.gui/src/qt.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -25,9 +25,9 @@ ;;; do so. If you do not wish to do so, delete this exception statement ;;; from your version. -(in-package :qt) +(in-package :cl-smoke.qt-impl) -(define-smoke-module libsmokeqt +(define-smoke-module :cl-smoke.qt libsmokeqt (*qt-smoke* "qt_Smoke") (init-qt-smoke "init_qt_Smoke")) 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:46:45.000000000 +0100 +++ new-qt.gui/src/signal-slot/connect.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,12 +1,12 @@ -(in-package :qt) +(in-package :cl-smoke.qt-impl) -(defgeneric connect (qsignal slot &optional type) +(defgeneric qt:connect (qsignal slot &optional type) (:documentation "Connects a signal to a slot.")) -(defgeneric disconnect (qsignal slot) +(defgeneric qt:disconnect (qsignal slot) (:documentation "Disconnects a connection.")) -(defgeneric disconnect-all (qsignal) +(defgeneric qt:disconnect-all (qsignal) (:documentation "Disconnects all connections of QSIGNAL.")) (defun check-argument-types (signal-arguments slot-arguments) @@ -16,7 +16,7 @@ (assert (subtypep signal-arg slot-arg)))) ;;FIXME check argument-types -(defmethod connect ((qsignal qsignal) (qslot qslot) &optional type) +(defmethod qt:connect ((qsignal qsignal) (qslot qslot) &optional type) (assert (or (slot-boundp (signal-object qsignal) 'argument-types) (slot-boundp qslot 'arguments)) ((slot-value (signal-object qsignal) 'argument-types) @@ -37,7 +37,7 @@ (types (arguments qslot))) (cerror "Failed to connect ~S to ~S." qsignal qslot))) -(defmethod connect ((sender qsignal) (function function) &optional type) +(defmethod qt:connect ((sender qsignal) (function function) &optional type) (let ((slot (make-instance 'qslot :args (list (signal-object sender)) :slot-function function))) @@ -62,63 +62,65 @@ :reader receiver)) (:documentation "Qt C++ slot.")) -(defgeneric get-slot (receiver name) +(defgeneric qt:get-slot (receiver name) (:documentation "Returns the slot of RECEIVER with NAME.") (:method (receiver name) (make-instance 'qt-slot :receiver receiver :name name)) (:method (receiver (function function)) "Returns a slot for RECEIVER that calls function with RECEIVER as the first argument." - (let ((slot (make-slot #'(lambda (&rest args) - (apply function (cxx:parent *this*) - args))))) + (let ((slot (qt:make-slot #'(lambda (&rest args) + (apply function (cxx:parent *this*) + args))))) (cxx:set-parent slot receiver) slot))) -(define-compiler-macro get-slot (&whole form receiver name) +(define-compiler-macro qt:get-slot (&whole form receiver name) "Normalize the slot name." (if (stringp name) - (let ((normalized-name (cxx:data (meta-object.normalized-signature name)))) + (let ((normalized-name (cxx:data + (qt:meta-object.normalized-signature name)))) (if (string= name normalized-name) ;; Avoid loop form - `(get-slot ,receiver ,normalized-name))) + `(qt:get-slot ,receiver ,normalized-name))) form)) -(defun get-signal (sender name) +(defun qt:get-signal (sender name) "Returns the signal NAME of SENDER." (make-instance 'qt-signal :sender sender :name name)) -(define-compiler-macro get-signal (&whole form sender name) +(define-compiler-macro qt:get-signal (&whole form sender name) "Normalize the signal name." (if (stringp name) - (let ((normalized-name (cxx:data (meta-object.normalized-signature name)))) + (let ((normalized-name (cxx:data + (qt:meta-object.normalized-signature name)))) (if (string= name normalized-name) ;; Avoid loop form - `(get-signal ,sender ,normalized-name))) + `(qt:get-signal ,sender ,normalized-name))) form)) -(defmethod connect ((qt-signal qt-signal) (qt-slot qt-slot) &optional type) - (unless (object.connect (qsender qt-signal) (qsignal (name qt-signal)) - (receiver qt-slot) (qslot (name qt-slot)) - (or type +auto-connection+)) +(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+)) (cerror "Failed to connect ~A ~A to ~A ~A." (qsender qt-signal) (name qt-signal) (receiver qt-slot) (name qt-slot)))) -(defmethod disconnect ((qt-signal qt-signal) (qt-slot qt-slot)) - (unless (object.disconnect (qsender qt-signal) (qsignal (name qt-signal)) - (receiver qt-slot) (qslot (name qt-slot))) +(defmethod qt:disconnect ((qt-signal qt-signal) (qt-slot qt-slot)) + (unless (qt:object.disconnect (qsender qt-signal) (qt:qsignal (name qt-signal)) + (receiver qt-slot) (qt:qslot (name qt-slot))) (cerror "Failed to disconnect ~A ~A from ~A ~A." (receiver qt-slot) (name qt-slot) (qsender qt-signal) (name qt-signal)))) -(defmethod disconnect-all ((sender object)) - (unless (object.disconnect sender 0 0 0) +(defmethod qt:disconnect-all ((sender qt:object)) + (unless (qt:object.disconnect sender 0 0 0) (cerror "Failed to disconnect everything connected to ~A." sender))) -(defmethod connect ((qt-signal qt-signal) (function function) &optional type) +(defmethod qt:connect ((qt-signal qt-signal) (function function) &optional type) (let* ((signal-id (find-signal-id (qsender qt-signal) (name qt-signal))) (slot (make-instance 'qslot ;; Set the sender as the slots parent, @@ -141,7 +143,7 @@ (cerror "Ignore" "Failed to connect the signal ~S of ~S to the function ~S." (name qt-signal) (qsender qt-signal) function)))) -(defmethod connect ((qt-signal qt-signal) (slot qslot) &optional type) +(defmethod qt:connect ((qt-signal qt-signal) (slot qslot) &optional type) (let ((signal-id (find-signal-id (qsender qt-signal) (name qt-signal)))) (if (slot-boundp slot 'arguments) (check-argument-types (method-arguments-type (cxx:meta-object @@ -159,7 +161,7 @@ (cerror "Ignore" "Failed to connect the signal ~S of ~S to the slot ~S." (name qt-signal) (qsender qt-signal) slot)))) -(defmethod connect ((qsignal qsignal) (slot qt-slot) &optional type) +(defmethod qt:connect ((qsignal qsignal) (slot qt-slot) &optional type) (let ((slot-id (find-slot-id (receiver slot) (name slot)))) (if (slot-boundp (signal-object qsignal) 'argument-types) (check-argument-types (argument-types (signal-object slot)) @@ -177,12 +179,12 @@ (defun connect-id (sender signal-id receiver slot-id type types) - (meta-object.connect sender signal-id + (qt:meta-object.connect sender signal-id receiver slot-id (if (null type) - (value +auto-connection+) + (value qt:+auto-connection+) (value type)) types)) (defun disconnect-id (sender signal-id receiver slot-id) - (meta-object.disconnect sender signal-id receiver slot-id)) + (qt:meta-object.disconnect sender signal-id receiver slot-id)) diff -rN -u old-qt.gui/src/signal-slot/signal-slot.lisp new-qt.gui/src/signal-slot/signal-slot.lisp --- old-qt.gui/src/signal-slot/signal-slot.lisp 2014-10-30 07:46:45.000000000 +0100 +++ new-qt.gui/src/signal-slot/signal-slot.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,4 +1,4 @@ -(in-package :qt) +(in-package :cl-smoke.qt-impl) (defclass funcallable-smoke-class (closer-mop:funcallable-standard-class @@ -18,17 +18,17 @@ ((#\0 #\1 #\2) t) (t nil)))) -(defun qmethod (name) +(defun qt:qmethod (name) "Equivalent of the METHOD(a) CPP macro." (assert (not (munged-name-p name))) (format nil "0~A" name)) -(defun qslot (name) +(defun qt:qslot (name) "Equivalent of the SLOT(a) CPP macro." (assert (not (munged-name-p name))) (format nil "1~A" name)) -(defun qsignal (name) +(defun qt:qsignal (name) "Equivalent of the SIGNAL(a) CPP macro." (assert (not (munged-name-p name))) (format nil "2~A" name)) diff -rN -u old-qt.gui/src/signal-slot/signal.lisp new-qt.gui/src/signal-slot/signal.lisp --- old-qt.gui/src/signal-slot/signal.lisp 2014-10-30 07:46:45.000000000 +0100 +++ new-qt.gui/src/signal-slot/signal.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,4 +1,4 @@ -(in-package :qt) +(in-package :cl-smoke.qt-impl) (declaim (optimize (debug 3))) (defclass qsignal-mixin () @@ -12,7 +12,7 @@ See: http://www.sbcl.org/manual/Metaobject-Protocol.html#index-validate_002dsuperclass-164")) -(defclass signal-object (object) +(defclass signal-object (qt:object) ((argument-types :accessor argument-types :initarg :argument-types :documentation "List of the argument types")) @@ -30,7 +30,7 @@ The argument types can be supplied by the :METHOD-TYPES initarg. Calling an instance emits the signal.")) -(defun make-signal (&rest argument-types) +(defun qt:make-signal (&rest argument-types) "Returns a funcallable signal. When ARGUMENT-TYPES are not specified, they are determined when the first connection is made." (if argument-types @@ -60,7 +60,7 @@ slot))) (when (< id 0) (setf id (cxx:index-of-slot (cxx:meta-object receiver) - (cxx:data (meta-object.normalized-signature slot))))) + (cxx:data (qt:meta-object.normalized-signature slot))))) (when (< id 0) (error "No slot ~S for class ~S. The valid slots are: ~{~<~%~T~0,75:;~A ~>~}" @@ -113,11 +113,11 @@ 'smoke::smoke-stack-item 'smoke::voidp)))) (setf (mem-aref args :pointer 0) (null-pointer)) - (meta-object.activate qsignal (cxx:meta-object qsignal) + (qt:meta-object.activate qsignal (cxx:meta-object qsignal) (id qsignal) args))))) -(defmethod disconnect-all ((qsignal qsignal)) +(defmethod qt:disconnect-all ((qsignal qsignal)) (unless (disconnect-id (signal-object qsignal) (id (signal-object qsignal)) 0 diff -rN -u old-qt.gui/src/signal-slot/slot.lisp new-qt.gui/src/signal-slot/slot.lisp --- old-qt.gui/src/signal-slot/slot.lisp 2014-10-30 07:46:45.000000000 +0100 +++ new-qt.gui/src/signal-slot/slot.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,7 +1,6 @@ -(in-package :qt) -(declaim (optimize (debug 3))) +(in-package :cl-smoke.qt-impl) -(defclass qslot (object) +(defclass qslot (qt:object) ((arguments :reader arguments :initarg :argument-types :documentation "List of the argument types for the slot.") (function :reader slot-function :initarg :slot-function @@ -10,7 +9,7 @@ (:metaclass cxx:class) (:documentation "A Qt slot that calls its associated function")) -(defun make-slot (function &optional (arguments nil arguments-p)) +(defun qt:make-slot (function &optional (arguments nil arguments-p)) "Returns a slot that calls FUNCTION when it receives a signal." (if arguments-p (make-instance 'qslot @@ -24,7 +23,7 @@ (defparameter *sender* nil "The sender of the signal.") (defparameter *this* nil "The slot that is invoked.") -(defmacro sender () +(defmacro qt:sender () "Returns the sender that invoked the slot." `*sender*) @@ -34,7 +33,7 @@ (let ((id (call-next-method))) (if (< id 0) id - (if (enum= call meta-object.+invoke-meta-method+) + (if (enum= call qt:meta-object.+invoke-meta-method+) (progn (ccase id (0 (let ((*sender* (cxx:sender slot)) @@ -55,7 +54,7 @@ signal))) (when (< id 0) (setf id (cxx:index-of-signal (cxx:meta-object sender) - (cxx:data (meta-object.normalized-signature signal))))) + (cxx:data (qt:meta-object.normalized-signature signal))))) (when (< id 0) (error "No signal ~S for class ~S." signal (class-of sender))) diff -rN -u old-qt.gui/src/signal-slot/translate.lisp new-qt.gui/src/signal-slot/translate.lisp --- old-qt.gui/src/signal-slot/translate.lisp 2014-10-30 07:46:45.000000000 +0100 +++ new-qt.gui/src/signal-slot/translate.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,4 +1,4 @@ -(in-package :qt) +(in-package :cl-smoke.qt-impl) (defun find-type (name &optional start end) (smoke::make-smoke-type *qt-smoke* (subseq name start end))) diff -rN -u old-qt.gui/src/string-list.lisp new-qt.gui/src/string-list.lisp --- old-qt.gui/src/string-list.lisp 2014-10-30 07:46:45.000000000 +0100 +++ new-qt.gui/src/string-list.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,4 +1,4 @@ -(in-package :qt) +(in-package :cl-smoke.qt-impl) (defcfun qt-smoke-string-list-size :int (string-list :pointer)) @@ -52,9 +52,9 @@ (defun coerce-string-list (list) (make-cleanup-pointer - (translate-to-foreign list (make-instance 'qt::string-list)) + (translate-to-foreign list (make-instance 'string-list)) #'(lambda (pointer) - (free-translated-object pointer (make-instance 'qt::string-list) + (free-translated-object pointer (make-instance 'string-list) nil)))) (define-from-lisp-translation "const QStringList&" diff -rN -u old-qt.gui/src/timer.lisp new-qt.gui/src/timer.lisp --- old-qt.gui/src/timer.lisp 2014-10-30 07:46:45.000000000 +0100 +++ new-qt.gui/src/timer.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,4 +1,4 @@ -(in-package :qt) +(in-package :cl-smoke.qt-impl) (defclass single-shot-timer (qt:object) ((function :initarg :function @@ -18,7 +18,7 @@ (cxx:start-timer timer (floor timeout 100))) (push timer *single-shot-timers*))) -(defmacro do-delayed-initialize (&body body) +(defmacro qt:do-delayed-initialize (&body body) "Run body when the event loop starts. http://techbase.kde.org/Development/Tutorials/Common_Programming_Mistakes#Delayed_Initialization" diff -rN -u old-qt.gui/src/variant.lisp new-qt.gui/src/variant.lisp --- old-qt.gui/src/variant.lisp 2014-10-30 07:46:45.000000000 +0100 +++ new-qt.gui/src/variant.lisp 2014-10-30 07:46:45.000000000 +0100 @@ -1,6 +1,6 @@ -(in-package :qt) +(in-package :cl-smoke.qt-impl) -(defmethod print-object ((variant variant) stream) +(defmethod print-object ((variant qt:variant) stream) "Print the type and value of the variant." (if (or (not (slot-boundp variant 'pointer)) (null-pointer-p (pointer variant))) @@ -8,22 +8,22 @@ (print-unreadable-object (variant stream :type t :identity t) (format stream "~A~@[ ~S~]" (cxx:type-name variant) - (handler-case (from-variant variant) + (handler-case (qt:from-variant variant) (error () nil)))))) -(defun make-variant (&optional (value nil value-p)) +(defun qt:make-variant (&optional (value nil value-p)) "Returns a new VARIANT containing a C++ version of VALUE or an empty variant when VALUE is not specified." (if value-p - (make-instance 'variant :args (list value)) - (make-instance 'variant))) + (make-instance 'qt:variant :args (list value)) + (make-instance 'qt:variant))) -(defun make-char (character) +(defun qt:make-char (character) "Returns a char for a lisp CHARACTER." (let ((octets (babel:string-to-octets (string character)))) (case (length octets) - (1 (make-instance 'char :args (list (aref octets 0)))) - (2 (make-instance 'char :args (list (aref octets 0) + (1 (make-instance 'qt:char :args (list (aref octets 0)))) + (2 (make-instance 'qt:char :args (list (aref octets 0) (aref octets 1)))) (t (error "qt:char requires the character ~A to be encoded in one or two octets, but it is using ~A." @@ -33,7 +33,7 @@ (or (cxx:is-high-surrogate char) (cxx:is-low-surrogate char))) -(defun from-char (char) +(defun qt:from-char (char) "Returns the lisp character represented by CHAR." (assert (not (surrogate-p char)) (char) @@ -46,30 +46,30 @@ (char-code (cxx:row char))))) 0)) -(defmethod print-object ((char char) stream) +(defmethod print-object ((char qt:char) stream) (if (or (null-pointer-p (pointer char)) (surrogate-p char)) (call-next-method) (print-unreadable-object (char stream :type t) - (princ (from-char char) stream)))) + (princ (qt:from-char char) stream)))) ;; FIXME include in MAKE-VARIANT? -(defun make-lisp-variant (value) +(defun qt:make-lisp-variant (value) "Returns a new VARIANT that wraps VALUE. The variant contains the actual Lisp object and not its C++ value like in MAKE-VARIANT." (let ((object (make-cxx-lisp-object value))) (unwind-protect - (make-instance 'variant :args (list *cxx-lisp-object-metatype* - object)) + (make-instance 'qt:variant :args (list *cxx-lisp-object-metatype* + object)) (free-cxx-lisp-object object)))) (defcfun qt-smoke-lisp-object-value :pointer (variant :pointer)) -(defun variant-boundp (variant) +(defun qt:variant-boundp (variant) "Returns true when VARIANT is valid (has a value) and false otherwise." (cxx:is-valid variant)) @@ -78,14 +78,16 @@ ,@(loop for type in types collect (if (symbolp type) - `(,(value (symbol-value (alexandria:symbolicate 'variant.+ type '+))) + `(,(value (symbol-value + (let ((*package* (find-package :cl-smoke.qt))) + (alexandria:symbolicate 'variant.+ type '+)))) (,(intern (format nil "TO-~A" type) :cxx) ,variant)) type)))) -(defun from-variant (variant) +(defun qt:from-variant (variant) "Returns the value of VARIANT." (variant-conversions (variant) - (#.(value variant.+invalid+) + (#.(value qt:variant.+invalid+) (cerror "Return (VALUES)" "Type of variant ~A is invalid." variant) (values)) bit-array bool byte-array @@ -107,10 +109,10 @@ (free-cxx-lisp-object lisp-object) value)))) -(defmethod value ((variant variant)) +(defmethod qt:value ((variant qt:variant)) "Returns the value of VARIANT." - (from-variant variant)) + (qt:from-variant variant)) -(defmethod (setf value) (new-value (variant variant)) - (cxx:operator= variant (make-variant new-value)) +(defmethod (setf qt:value) (new-value (variant qt:variant)) + (cxx:operator= variant (qt:make-variant new-value)) new-value)