diff --git a/src/cpp/ecl_ext.cpp b/src/cpp/ecl_ext.cpp index d2f9539..b6cc819 100644 --- a/src/cpp/ecl_ext.cpp +++ b/src/cpp/ecl_ext.cpp @@ -44,6 +44,7 @@ void iniCLFunctions() { DEFUN ("%qsingle-shot", qsingle_shot2, 2) DEFUN ("qtranslate", qtranslate, 3) DEFUN ("qversion", qversion, 0) + DEFUN ("qt-object-info", qt_object_info, 1) DEFUN ("%reload", reload2, 0) DEFUN ("root-item", root_item, 0) DEFUN ("%set-shutdown-p", set_shutdown_p, 1) @@ -472,7 +473,7 @@ cl_object qml_set2(cl_object l_item, cl_object l_name, cl_object l_value) { cl_object qobject_name(cl_object l_obj) { /// args: (qobject) - /// Returns the QObject::objectName() of passed QOBJECT (FFI pointer). + /// Returns the QObject::objectName() of passed QT-OBJECT. ecl_process_env()->nvalues = 1; QObject* qobject = toQObjectPointer(l_obj); if (qobject != nullptr) { @@ -483,6 +484,27 @@ cl_object qobject_name(cl_object l_obj) { return ECL_NIL; } +cl_object qt_object_info(cl_object l_obj) { + // for internal use + QString className("?"); + QString objectName(""); + quintptr address = 0; + QObject* qobject = toQObjectPointer(l_obj); + if (qobject != nullptr) { + className = qobject->metaObject()->className(); + int i = -1; + if ((i = className.indexOf('_')) != -1) { + className.truncate(i); + } + objectName = qobject->objectName(); + address = reinterpret_cast(qobject); + } + cl_object l_class = from_qstring(className); + cl_object l_name = from_qstring(objectName); + cl_object l_addr = ecl_make_unsigned_integer(address); + ecl_return3(ecl_process_env(), l_class, l_name, l_addr); +} + cl_object root_item() { /// args: () /// Returns the root item of the QQuickView. diff --git a/src/cpp/ecl_ext.h b/src/cpp/ecl_ext.h index a30a2e6..472f59b 100644 --- a/src/cpp/ecl_ext.h +++ b/src/cpp/ecl_ext.h @@ -73,6 +73,7 @@ cl_object qset2 (cl_object, cl_object); cl_object qsingle_shot2 (cl_object, cl_object); cl_object qtranslate (cl_object, cl_object, cl_object); cl_object qversion (); +cl_object qt_object_info (cl_object); cl_object reload2 (); cl_object root_item (); cl_object set_shutdown_p (cl_object); diff --git a/src/cpp/lqml.cpp b/src/cpp/lqml.cpp index cfe0825..c8fbf64 100644 --- a/src/cpp/lqml.cpp +++ b/src/cpp/lqml.cpp @@ -48,7 +48,7 @@ LQML::LQML(int argc, char* argv[], QQuickView* view) : QObject() { iniCLFunctions(); ecl_init_module(NULL, ini_LQML); eval("(in-package :qml-user)"); - eval(QString("(setf *quick-view* (make-qobject %1))") + eval(QString("(setf *quick-view* (qt-object %1))") .arg(reinterpret_cast(view))); } diff --git a/src/cpp/marshal.cpp b/src/cpp/marshal.cpp index 321ddb9..5c4734b 100644 --- a/src/cpp/marshal.cpp +++ b/src/cpp/marshal.cpp @@ -178,10 +178,10 @@ QVariantList toQVariantList(cl_object l_list) { } QObject* toQObjectPointer(cl_object l_obj) { - STATIC_SYMBOL_PKG (s_qobject_p, "QOBJECT-P", "QML") // see 'ini.lisp' - STATIC_SYMBOL_PKG (s_pointer_address, "POINTER-ADDRESS", "FFI") - if (cl_funcall(2, s_qobject_p, l_obj) != ECL_NIL) { - return reinterpret_cast(toUInt(cl_funcall(2, s_pointer_address, l_obj))); + STATIC_SYMBOL_PKG (s_qt_object_p, "QT-OBJECT-P", "QML") // see 'ini.lisp' + STATIC_SYMBOL_PKG (s_qt_object_address, "QT-OBJECT-ADDRESS", "QML") + if (cl_funcall(2, s_qt_object_p, l_obj) != ECL_NIL) { + return reinterpret_cast(toUInt(cl_funcall(2, s_qt_object_address, l_obj))); } return nullptr; } @@ -249,9 +249,9 @@ cl_object from_qvariant(const QVariant& var) { } cl_object from_qobject_pointer(QObject* qobject) { - STATIC_SYMBOL_PKG (s_make_qobject, "MAKE-QOBJECT", "QML") // see 'ini.lisp' + STATIC_SYMBOL_PKG (s_qt_object, "QT-OBJECT", "QML") // see 'ini.lisp' return cl_funcall(2, - s_make_qobject, + s_qt_object, ecl_make_unsigned_integer(reinterpret_cast(qobject))); } diff --git a/src/cpp/qml.cpp b/src/cpp/qml.cpp index 285cc05..4ead334 100644 --- a/src/cpp/qml.cpp +++ b/src/cpp/qml.cpp @@ -10,7 +10,7 @@ static Lisp* lisp = 0; static QObject* lisp_provider(QQmlEngine*, QJSEngine*) { return lisp; } QObject* iniQml() { - if(!lisp) { + if (!lisp) { lisp = new Lisp; qmlRegisterSingletonType("Lisp", 1, 0, "Lisp", lisp_provider); } @@ -47,47 +47,47 @@ QVariant Lisp::call(const QJSValue& caller_or_function, QObject* caller = 0; QString function; QVariantList arguments; - if(caller_or_function.isQObject()) { + if (caller_or_function.isQObject()) { caller = caller_or_function.toQObject(); function = function_or_arg0.toString(); } - else if(caller_or_function.isString()) { + else if (caller_or_function.isString()) { function = caller_or_function.toString(); - if(!function_or_arg0.isUndefined()) { + if (!function_or_arg0.isUndefined()) { arguments << function_or_arg0.toVariant(); } } - if(!arg1.isUndefined()) { + if (!arg1.isUndefined()) { arguments << arg1.toVariant(); - if(!arg2.isUndefined()) { + if (!arg2.isUndefined()) { arguments << arg2.toVariant(); - if(!arg3.isUndefined()) { + if (!arg3.isUndefined()) { arguments << arg3.toVariant(); - if(!arg4.isUndefined()) { + if (!arg4.isUndefined()) { arguments << arg4.toVariant(); - if(!arg5.isUndefined()) { + if (!arg5.isUndefined()) { arguments << arg5.toVariant(); - if(!arg6.isUndefined()) { + if (!arg6.isUndefined()) { arguments << arg6.toVariant(); - if(!arg7.isUndefined()) { + if (!arg7.isUndefined()) { arguments << arg7.toVariant(); - if(!arg8.isUndefined()) { + if (!arg8.isUndefined()) { arguments << arg8.toVariant(); - if(!arg9.isUndefined()) { + if (!arg9.isUndefined()) { arguments << arg9.toVariant(); - if(!arg10.isUndefined()) { + if (!arg10.isUndefined()) { arguments << arg10.toVariant(); - if(!arg11.isUndefined()) { + if (!arg11.isUndefined()) { arguments << arg11.toVariant(); - if(!arg12.isUndefined()) { + if (!arg12.isUndefined()) { arguments << arg12.toVariant(); - if(!arg13.isUndefined()) { + if (!arg13.isUndefined()) { arguments << arg13.toVariant(); - if(!arg14.isUndefined()) { + if (!arg14.isUndefined()) { arguments << arg14.toVariant(); - if(!arg15.isUndefined()) { + if (!arg15.isUndefined()) { arguments << arg15.toVariant(); - if(!arg16.isUndefined()) { + if (!arg16.isUndefined()) { arguments << arg16.toVariant(); } } @@ -114,12 +114,12 @@ QVariant Lisp::apply(const QJSValue& caller_or_function, QObject* caller = 0; QString function; QVariantList arguments; - if(caller_or_function.isQObject()) { + if (caller_or_function.isQObject()) { caller = caller_or_function.toQObject(); function = function_or_arguments.toString(); arguments = arguments_or_undefined.toVariant().value(); } - else if(caller_or_function.isString()) { + else if (caller_or_function.isString()) { function = caller_or_function.toString(); arguments = function_or_arguments.toVariant().value(); } diff --git a/src/lisp/ini.lisp b/src/lisp/ini.lisp index 42d25cd..194141e 100644 --- a/src/lisp/ini.lisp +++ b/src/lisp/ini.lisp @@ -8,17 +8,19 @@ (defvar *break-on-errors* t "If T, call (BREAK) on errors inside of LQML functions defined in C++.") -(defun make-qobject (address) - ;; for internal use - (ffi:make-pointer address :pointer-void)) +(defstruct (qt-object (:constructor qt-object (address))) + (address 0 :type integer)) -(defun qobject-p (x) - "args: (x) - Tests if argument is of type QObject." - (eql 'si:foreign-data (type-of x))) - -(defmacro alias (s1 s2) - `(setf (symbol-function ',s1) (function ,s2))) +(defmethod print-object ((object qt-object) s) + (print-unreadable-object (object s :type nil :identity nil) + (multiple-value-bind (class name address) + (qt-object-info object) + (format s "~A ~S ~A" + class + name + (if (zerop address) + "NULL" + (format nil "0x~X" address)))))) (defmacro ! (fun qobject &rest args) ;; legacy, should not be needed, use DEFINE-QT-WRAPPERS instead @@ -139,7 +141,7 @@ (define-qt-wrappers *c++*) ; generate wrappers (define-qt-wrappers *c++* :methods) ; Qt methods only (no slots/signals) (my-qt-function *c++* x y) ; call from Lisp" - (assert (qobject-p qt-library)) + (assert (qt-object-p qt-library)) (let ((all-functions (qapropos* nil qt-library)) (lispify (not (find :do-not-lispify what)))) (setf what (remove-if (lambda (x) (find x '(:do-not-lispify t))) @@ -166,7 +168,7 @@ ;; there seems to be no simple way to avoid EVAL here ;; (excluding non-portable hacks) (eval `(defgeneric ,lisp-name (object &rest arguments))) - (eval `(defmethod ,lisp-name ((object si:foreign-data) &rest arguments) + (eval `(defmethod ,lisp-name ((object qt-object) &rest arguments) (%qinvoke-method object ,qt-name arguments))))))))) (defun qinvoke-method (object function-name &rest arguments) @@ -198,10 +200,6 @@ (assert (typep exit-status 'fixnum)) (%qquit exit-status)) -(alias qfun qinvoke-method) -(alias qrun qrun-on-ui-thread) -(alias qq qquit) - ;;; for android logging (defun qlog (arg1 &rest args) @@ -215,3 +213,11 @@ (apply 'format nil arg1 args) (x:join (mapcar 'princ-to-string (cons arg1 args)))))) +;;; alias + +(defmacro alias (s1 s2) + `(setf (symbol-function ',s1) (function ,s2))) + +(alias qfun qinvoke-method) +(alias qrun qrun-on-ui-thread) +(alias qq qquit) diff --git a/src/lisp/package.lisp b/src/lisp/package.lisp index bb94bb8..1af3fb3 100644 --- a/src/lisp/package.lisp +++ b/src/lisp/package.lisp @@ -9,7 +9,6 @@ #:define-qt-wrappers #:find-quick-item #:js - #:make-qobject #:pixel-ratio #:qapropos #:qapropos* @@ -34,7 +33,6 @@ #:qlater #:qload-c++ #:qlog - #:qobject-p #:qprocess-events #:qq #:qquit @@ -46,6 +44,8 @@ #:qsleep #:qtranslate #:qversion + #:qt-object + #:qt-object-p #:reload #:root-item #:tr diff --git a/src/lisp/qml.lisp b/src/lisp/qml.lisp index 4b43e91..a56ccc5 100644 --- a/src/lisp/qml.lisp +++ b/src/lisp/qml.lisp @@ -20,7 +20,7 @@ ;; if passed with 'this' as first argument to 'Lisp.call()' / 'Lisp.apply()'. (let ((*caller* (if (zerop caller) *caller* - (make-qobject caller)))) + (qt-qobject caller)))) (apply (string-to-symbol function) arguments))) @@ -52,7 +52,7 @@ ;; (QRUN* is used internally here) ;; (let ((parent (or *root-item* (root-item)))) - (when (and parent (/= 0 (ffi:pointer-address parent))) + (when (and parent (/= 0 (qt-object-address parent))) (if (string= (qobject-name parent) object-name) parent (qfind-child parent object-name))))) @@ -61,7 +61,7 @@ ;; for internal use (cond ((stringp item/name) (find-quick-item item/name)) - ((qobject-p item/name) + ((qt-object-p item/name) item/name) ((not item/name) (root-item)))) @@ -180,8 +180,8 @@ ;;; apropos -(defun %to-qobject (x) - (if (qobject-p x) +(defun %to-qt-object (x) + (if (qt-object-p x) x (quick-item x))) @@ -192,7 +192,7 @@ by their 'objectName'. (qapropos nil *canvas*) (qapropos \"color\")" - (dolist (sub1 (%qapropos (%string-or-nil name) (%to-qobject qobject/name) offset)) + (dolist (sub1 (%qapropos (%string-or-nil name) (%to-qt-object qobject/name) offset)) (format t "~%~%~A~%" (first sub1)) (dolist (sub2 (rest sub1)) (format t "~% ~A~%~%" (first sub2)) @@ -208,5 +208,5 @@ (defun qapropos* (name &optional qobject/name offset) "args: (name &optional qobject/name) Similar to QAPROPOS, returning the results as nested list." - (%qapropos (%string-or-nil name) (%to-qobject qobject/name) offset)) + (%qapropos (%string-or-nil name) (%to-qt-object qobject/name) offset))