Thu May 14 14:11:11 CEST 2009 Tobias Rautenkranz * Lisp image loading 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:50:25.000000000 +0100 +++ new-qt.gui/src/i18n.lisp 2014-10-30 07:50:25.000000000 +0100 @@ -14,15 +14,19 @@ ,@body) (cxx:remove-translator (qt:app) ,translator))) -(defmacro with-translator (base-name &body body) - "Loads the translations in the BASE-NAME_LANGCODE.qm file. +(defmacro 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))) - (unless (cxx:load ,translator (format nil "~A_~A" - ,base-name - (cxx:name (qt:locale.system)))) + (unless + (find-if #'(lambda (path) + (cxx:load ,translator + (format nil "~A_~A" ,base-name + (cxx:name (qt:locale.system))))) + (list ,@paths)) (cerror "Ignore" "Loading the translations ~A for ~A failed." ,base-name (cxx:name (qt:locale.system)))) (with-installed-translator ,translator @@ -40,3 +44,13 @@ (cerror "Ignore" "Loading the Qt library translations failed.")) (with-installed-translator ,translator ,@body)))) + +(defun 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))) + paths))) + (unless file-path + (error "The file ~S not found in the paths ~S" name paths)) + (merge-pathnames name file-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:50:25.000000000 +0100 +++ new-qt.gui/src/lisp-object.lisp 2014-10-30 07:50:25.000000000 +0100 @@ -30,7 +30,7 @@ (defvar *cxx-lisp-object-metatype*) -(eval-when (:load-toplevel) +(eval-startup () (setf *cxx-lisp-object-metatype* (qt-smoke-setup-lisp-object (callback destruct-cxx-lisp-object))) (assert (>= *cxx-lisp-object-metatype* 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:50:25.000000000 +0100 +++ new-qt.gui/src/object.lisp 2014-10-30 07:50:25.000000000 +0100 @@ -24,7 +24,8 @@ (call-next-method))) (defmethod print-object ((object object) stream) - (if (null-pointer-p (pointer object)) + (if (or (not (slot-boundp object 'pointer)) + (null-pointer-p (pointer object))) (call-next-method) (print-unreadable-object (object stream :type t :identity t) (princ (cxx:object-name object) stream)))) @@ -82,16 +83,20 @@ (slot-value condition 'class-name) (slot-value condition 'pointer))))) -(let ((get-parent (smoke::make-smoke-method (smoke::make-smoke-class +(smoke:eval-startup (:compile-toplevel :execute) +(defparameter *get-parent* + (smoke::make-smoke-method (smoke::make-smoke-class *qt-smoke* "QObject") "parent")) ;; FIXME this leaks memory when QCoreApplication::exec is never called, ;; beause then, deleteLater has no effect. - (delete-later (smoke::make-smoke-method (smoke::make-smoke-class +(defparameter *delete-later* + (smoke::make-smoke-method (smoke::make-smoke-class *qt-smoke* "QObject") "deleteLater"))) + (defmethod smoke::make-finalize ((object object)) "Delete the qt:object OBJECT, by calling cxx:delete-later iff it has no parent." @@ -101,8 +106,8 @@ (if (typep (class-of object) 'smoke::smoke-wrapper-class) #'(lambda () (handler-case - (if (null-pointer-p (smoke::pointer-call get-parent pointer)) - (smoke::pointer-call delete-later pointer) + (if (null-pointer-p (smoke::pointer-call *get-parent* pointer)) + (smoke::pointer-call *delete-later* pointer) (error (make-condition 'wrapper-gc :class-name name :pointer pointer))) (condition (condition) @@ -111,12 +116,12 @@ #'(lambda () (handler-case (progn - (when (null-pointer-p (smoke::pointer-call get-parent pointer)) + (when (null-pointer-p (smoke::pointer-call *get-parent* pointer)) (funcall next))) (condition (condition) (format *debug-io* "error: qfinalize ~A ~A ~A~%" name pointer - condition))))))) + condition)))))) ;(smoke::pointer-call delete-later pointer))))))) ) @@ -169,5 +174,5 @@ (unless ret (error "The event-notify callback table is full.")))) -(eval-when (:load-toplevel) +(smoke:eval-startup () (register-event-notify)) 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:50:25.000000000 +0100 +++ new-qt.gui/src/package.lisp 2014-10-30 07:50:25.000000000 +0100 @@ -33,6 +33,8 @@ #:value #:variant-boundp + #:search-file + #:connect #:get-slot #:get-signal 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:50:25.000000000 +0100 +++ new-qt.gui/src/qstring.lisp 2014-10-30 07:50:25.000000000 +0100 @@ -27,7 +27,7 @@ ;;; (set-language-environment "UTF-8") ;;; (setq slime-net-coding-system 'utf-8-unix) ;;; to .emacs helps. -(eval-when (:compile-toplevel :load-toplevel :execute) +(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 @@ -41,13 +41,14 @@ (with-foreign-string ((data length) string :null-terminated-p nil) (qt-smoke-string-to-qstring data length))) +(smoke:eval-startup (:compile-toplevel :execute) (let ((method (smoke::make-smoke-method (find-class 'byte-array) "data"))) (defmethod cxx:data ((array 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))))) + :count (cxx:size array)))))) (defmethod translate-from-foreign (string (type qstring)) (cxx:data (make-instance 'byte-array 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:50:25.000000000 +0100 +++ new-qt.gui/src/qt.lisp 2014-10-30 07:50:25.000000000 +0100 @@ -27,33 +27,15 @@ (in-package :qt) -(eval-when (:load-toplevel :compile-toplevel :execute) - (define-foreign-library libsmokeqt - (:unix "libsmokeqt.so.2") - (t (:default "libsmokeqt"))) - - (use-foreign-library libsmokeqt) - - (use-foreign-library libqt-smoke-extra) - - (defcvar ("qt_Smoke" :read-only t) :pointer - "The Smoke Qt binding") - - (defcfun (init-qt-smoke "_Z13init_qt_Smokev") :void) - - (defvar *qt-binding* (null-pointer)) - - (init-qt-smoke)) - -(eval-when (:load-toplevel :compile-toplevel) - (when (null-pointer-p *qt-binding*) - (setf *qt-binding* (init *qt-smoke*)))) - -(define-methods *qt-smoke*) +(define-smoke-module libsmokeqt + (*qt-smoke* "qt_Smoke") + (init-qt-smoke "init_qt_Smoke")) +(smoke:eval-startup (:compile-toplevel :execute) + (use-foreign-library libqt-smoke-extra)) (defun new (class-name method-name &rest args) - (apply #'new-object *qt-binding* class-name method-name args)) + (apply #'new-object (smoke::binding *qt-smoke*) class-name method-name args)) (defun static-call (class-name method-name &rest args) (apply #'smoke::static-call *qt-smoke* class-name method-name args)) 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:50:25.000000000 +0100 +++ new-qt.gui/src/variant.lisp 2014-10-30 07:50:25.000000000 +0100 @@ -55,7 +55,10 @@ ;; FIXME include in MAKE-VARIANT? (defun make-lisp-variant (value) - "Returns a new VARIANT that wraps 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*