fix qml-apply (Lisp calls from QML)

This commit is contained in:
pls.153 2022-01-23 11:29:38 +01:00
parent e09778b76c
commit 82b904fe9c
5 changed files with 41 additions and 58 deletions

View file

@ -13,8 +13,7 @@ QT_BEGIN_NAMESPACE
extern "C" { LIB_EXPORT QObject* ini(); } extern "C" { LIB_EXPORT QObject* ini(); }
class CPP : public QObject class CPP : public QObject {
{
Q_OBJECT Q_OBJECT
public: public:

View file

@ -80,7 +80,7 @@ int main(int argc, char* argv[]) {
bool slime = false; bool slime = false;
if (arguments.contains("-slime") if (arguments.contains("-slime")
|| (arguments.indexOf(QRegularExpression::fromWildcard(QStringView(QString("*start-swank*.lisp")))) != -1)) { || (arguments.indexOf(QRegularExpression::fromWildcard(QString("*start-swank*.lisp"))) != -1)) {
arguments.removeAll("-slime"); arguments.removeAll("-slime");
slime = true; slime = true;
} }

View file

@ -17,18 +17,13 @@ QObject* iniQml() {
return lisp; return lisp;
} }
static QVariant qmlApply(QObject* caller, const QString& function, const QVariantList& arguments) { static QVariant qmlApply(QObject* caller,
QVariant var = const QString& function,
ecl_fun("qml:qml-apply", const QVariantList& arguments) {
QVariant(reinterpret_cast<quintptr>(caller)), return ecl_fun("qml:qml-apply",
QVariant(function), QVariant(reinterpret_cast<quintptr>(caller)),
QVariant(arguments)); QVariant(function),
QString str(var.toString()); QVariant(arguments));
if(str.startsWith("#<>")) { // prepared in Lisp for JS eval
QQmlExpression exp(LQML::quickView->rootContext(), caller, str.mid(3));
return exp.evaluate();
}
return var;
} }
QVariant Lisp::call(const QJSValue& caller_or_function, QVariant Lisp::call(const QJSValue& caller_or_function,

View file

@ -3,7 +3,6 @@
(:export (:export
#:*break-on-errors* #:*break-on-errors*
#:*quick-view* #:*quick-view*
#:*root*
#:*root-item* #:*root-item*
#:*caller* #:*caller*
#:children #:children
@ -47,8 +46,8 @@
#:qsleep #:qsleep
#:qtranslate #:qtranslate
#:qversion #:qversion
#:root-item
#:reload #:reload
#:root-item
#:tr #:tr
#:!)) #:!))

View file

@ -2,7 +2,6 @@
(defvar *quick-view* nil) ; is set in 'lqml.cpp' on startup (defvar *quick-view* nil) ; is set in 'lqml.cpp' on startup
(defvar *caller* nil) (defvar *caller* nil)
(defvar *root* nil)
(defvar *root-item* nil) ; see note in 'find-quick-item' (defvar *root-item* nil) ; see note in 'find-quick-item'
(defun string-to-symbol (name) (defun string-to-symbol (name)
@ -15,51 +14,15 @@
;;; function calls from QML ;;; function calls from QML
(defun print-js-readably (object)
"Prints (nested) lists, vectors, T, NIL, floats in JS notation, which will be
passed to JS 'eval()'."
(if (and (not (stringp object))
(vectorp object))
(print-js-readably (coerce object 'list))
(typecase object
(cons
(write-char #\[)
(do ((list object (rest list)))
((null list) (write-char #\]))
(print-js-readably (first list))
(when (rest list)
(write-char #\,))))
(float
;; JS can't read 'd0' 'l0'
(let ((str (princ-to-string object)))
(x:when-it (position-if (lambda (ch) (find ch "dl")) str)
(setf (char str x:it) #\e))
(princ str)))
(t
(cond ((eql 't object)
(princ "true"))
((eql 'nil object)
(princ "false"))
(t
(prin1 object)))))))
(defun print-to-js-string (object)
(with-output-to-string (*standard-output*)
(princ "#<>") ; mark for passing to JS "eval()"
(print-js-readably object)))
(defun qml-apply (caller function arguments) (defun qml-apply (caller function arguments)
;; Every 'Lisp.call()' or 'Lisp.apply()' function call in QML will call this ;; Every 'Lisp.call()' or 'Lisp.apply()' function call in QML will call this
;: function. The variable *CALLER* will be bound to the calling QQuickItem, ;: function. The variable *CALLER* will be bound to the calling QQuickItem,
;; if passed with 'this' as first argument to 'Lisp.call()' / 'Lisp.apply()'. ;; if passed with 'this' as first argument to 'Lisp.call()' / 'Lisp.apply()'.
(let* ((*caller* (if (zerop caller) ; don't change LET* (let ((*caller* (if (zerop caller)
*caller* *caller*
(make-qobject caller))) (make-qobject caller))))
(value (apply (string-to-symbol function) (apply (string-to-symbol function)
arguments))) arguments)))
(if (stringp value)
value
(print-to-js-string value))))
;;; utils ;;; utils
@ -160,6 +123,33 @@
(x:join (loop repeat (length arguments) collect "~S") #\,)) (x:join (loop repeat (length arguments) collect "~S") #\,))
(mapcar 'js-arg arguments))))) (mapcar 'js-arg arguments)))))
(defun print-js-readably (object)
"Prints (nested) lists, vectors, T, NIL, floats in JS notation."
(if (and (not (stringp object))
(vectorp object))
(print-js-readably (coerce object 'list))
(typecase object
(cons
(write-char #\[)
(do ((list object (rest list)))
((null list) (write-char #\]))
(print-js-readably (first list))
(when (rest list)
(write-char #\,))))
(float
;; JS can't read 'd0' 'l0'
(let ((str (princ-to-string object)))
(x:when-it (position-if (lambda (ch) (find ch "dl")) str)
(setf (char str x:it) #\e))
(princ str)))
(t
(cond ((eql 't object)
(princ "true"))
((eql 'nil object)
(princ "false"))
(t
(prin1 object)))))))
(defun js-arg (object) (defun js-arg (object)
;; for arguments in function JS ;; for arguments in function JS
(if (stringp object) (if (stringp object)