mirror of
https://gitlab.com/eql/lqml.git
synced 2025-12-06 02:30:38 -08:00
fix qml-apply (Lisp calls from QML)
This commit is contained in:
parent
e09778b76c
commit
82b904fe9c
5 changed files with 41 additions and 58 deletions
|
|
@ -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:
|
||||||
|
|
|
||||||
|
|
@ -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;
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -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,
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
#:!))
|
#:!))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -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)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue