Thu May 14 14:11:11 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Lisp image loading

--- old-qt.gui/src/i18n.lisp 2014-10-07 07:48:46.000000000 +0200

+++ new-qt.gui/src/i18n.lisp 2014-10-07 07:48:46.000000000 +0200

@@ -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)))

+

--- old-qt.gui/src/lisp-object.lisp 2014-10-07 07:48:46.000000000 +0200

+++ new-qt.gui/src/lisp-object.lisp 2014-10-07 07:48:46.000000000 +0200

@@ -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*

--- old-qt.gui/src/object.lisp 2014-10-07 07:48:46.000000000 +0200

+++ new-qt.gui/src/object.lisp 2014-10-07 07:48:46.000000000 +0200

@@ -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))

--- old-qt.gui/src/package.lisp 2014-10-07 07:48:46.000000000 +0200

+++ new-qt.gui/src/package.lisp 2014-10-07 07:48:46.000000000 +0200

@@ -33,6 +33,8 @@

#:value

#:variant-boundp

+ #:search-file

+

#:connect

#:get-slot

#:get-signal

--- old-qt.gui/src/qstring.lisp 2014-10-07 07:48:46.000000000 +0200

+++ new-qt.gui/src/qstring.lisp 2014-10-07 07:48:46.000000000 +0200

@@ -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

--- old-qt.gui/src/qt.lisp 2014-10-07 07:48:46.000000000 +0200

+++ new-qt.gui/src/qt.lisp 2014-10-07 07:48:46.000000000 +0200

@@ -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))

--- old-qt.gui/src/variant.lisp 2014-10-07 07:48:46.000000000 +0200

+++ new-qt.gui/src/variant.lisp 2014-10-07 07:48:46.000000000 +0200

@@ -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*