From 799cc1de366945878ce40ba382fedd30be7ec57f Mon Sep 17 00:00:00 2001 From: polos Date: Sat, 13 Mar 2021 16:03:09 +0100 Subject: [PATCH] replace deprecated ECL C names; revisions; integrate QML into the library ('qml-lisp.lisp' is obsolete now); --- examples/M-modules/quick/9999/run.lisp | 1 - .../M-modules/quick/Tic-Tac-Toe/qml-lisp.lisp | 215 ------- .../quick/Tic-Tac-Toe/tic-tac-toe.lisp | 1 - .../quick/item-model/abstract-model.lisp | 1 - .../quick/item-model/list-model.lisp | 1 - .../M-modules/quick/item-model/qml-lisp.lisp | 215 ------- .../quick/painted-item/painted-item.lisp | 1 - .../quick/painted-item/qml-lisp.lisp | 215 ------- .../quick/palindrome-2/palindrome.lisp | 1 - .../quick/palindrome-2/qml-lisp.lisp | 215 ------- .../M-modules/quick/qml-lisp/example.lisp | 1 - .../M-modules/quick/qml-lisp/qml-lisp.lisp | 215 ------- .../M-modules/quick/qml-lisp/qml/example.qml | 3 +- .../quick/sokoban/lisp/qml-lisp.lisp | 215 ------- examples/M-modules/quick/sokoban/sokoban.lisp | 7 +- .../M-modules/quick/table-view/qml-lisp.lisp | 215 ------- .../quick/table-view/table-view.lisp | 1 - src/ecl_fun.cpp | 547 +++++++++--------- src/ecl_fun.h | 46 +- src/eql.cpp | 12 +- src/eql_lib.pro | 2 +- src/lisp/ini.lisp | 2 + src/lisp/package.lisp | 28 + .../lisp/qml-lisp.lisp => src/lisp/qml.lisp | 48 +- src/make.lisp | 4 + 25 files changed, 358 insertions(+), 1854 deletions(-) delete mode 100644 examples/M-modules/quick/Tic-Tac-Toe/qml-lisp.lisp delete mode 100644 examples/M-modules/quick/item-model/qml-lisp.lisp delete mode 100644 examples/M-modules/quick/painted-item/qml-lisp.lisp delete mode 100644 examples/M-modules/quick/palindrome-2/qml-lisp.lisp delete mode 100644 examples/M-modules/quick/qml-lisp/qml-lisp.lisp delete mode 100644 examples/M-modules/quick/sokoban/lisp/qml-lisp.lisp delete mode 100644 examples/M-modules/quick/table-view/qml-lisp.lisp rename examples/M-modules/quick/9999/lisp/qml-lisp.lisp => src/lisp/qml.lisp (83%) diff --git a/examples/M-modules/quick/9999/run.lisp b/examples/M-modules/quick/9999/run.lisp index 52a39a2..17d95ad 100644 --- a/examples/M-modules/quick/9999/run.lisp +++ b/examples/M-modules/quick/9999/run.lisp @@ -4,7 +4,6 @@ (qrequire :quick) -(load "lisp/qml-lisp") (load "lisp/main") (use-package :qml) diff --git a/examples/M-modules/quick/Tic-Tac-Toe/qml-lisp.lisp b/examples/M-modules/quick/Tic-Tac-Toe/qml-lisp.lisp deleted file mode 100644 index 0d1385b..0000000 --- a/examples/M-modules/quick/Tic-Tac-Toe/qml-lisp.lisp +++ /dev/null @@ -1,215 +0,0 @@ -;;; -;;; * enables QML to call Lisp functions -;;; * allows to get/set any QML property from Lisp (needs 'objectName' to be set) -;;; * allows to call QML methods from Lisp (needs 'objectName' to be set) -;;; * allows to evaluate JS code from Lisp (needs 'objectName' to be set) -;;; - -(defpackage :qml-lisp - (:use :common-lisp :eql) - (:nicknames :qml) - (:export - #:*quick-view* - #:*caller* - #:children - #:find-quick-item - #:js - #:js-arg - #:qml-call - #:qml-get - #:qml-set - #:qml-set-all - #:q! - #:q< - #:q> - #:q>* - #:qjs - #:paint - #:scale - #:reload - #:root-context - #:root-item)) - -(provide :qml-lisp) - -(in-package :qml-lisp) - -(defvar *quick-view* nil) -(defvar *caller* nil) - -(defun string-to-symbol (name) - (let ((upper (string-upcase name)) - (p (position #\: name))) - (if p - (find-symbol (subseq upper (1+ (position #\: name :from-end t))) - (subseq upper 0 p)) - (find-symbol upper)))) - -;;; 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) - "Every 'Lisp.call()' or 'Lisp.apply()' function call in QML will call this function. The variable *CALLER* will be bound to the calling QQuickItem, if passed with 'this' as first argument to 'Lisp.call()' / 'Lisp.apply()'." - (let* ((*caller* (if (qnull caller) *caller* (qt-object-? caller))) - (object (apply (string-to-symbol function) - arguments))) - (if (stringp object) - object - (print-to-js-string object)))) - -;;; utils - -(defun root-item () - (when *quick-view* - (if (= (qt-object-id *quick-view*) #.(qid "QQmlApplicationEngine")) - (let ((object (first (|rootObjects| *quick-view*)))) - (setf (qt-object-id object) #.(qid "QObject")) ; unknown to EQL, so resort to QObject - object) - (qt-object-? (|rootObject| *quick-view*))))) - -(defun root-context () - (when *quick-view* - (|rootContext| *quick-view*))) - -(defun find-quick-item (object-name) - "Finds the first QQuickItem matching OBJECT-NAME." - (let ((root (root-item))) - (unless (qnull root) - (if (string= (|objectName| root) object-name) - (root-item) - (qt-object-? (qfind-child root object-name)))))) - -(defun quick-item (item/name) - (cond ((stringp item/name) - (find-quick-item item/name)) - ((qt-object-p item/name) - item/name) - ((not item/name) - (root-item)))) - -(defun children (item/name) - "Like QML function 'children'." - (mapcar 'qt-object-? (|childItems| (quick-item item/name)))) - -(defun scale () - "Returns the scale factor used on high dpi scaled devices (e.g. phones)." - (|effectiveDevicePixelRatio| *quick-view*)) - -(defun reload () - "Force reloading of QML file after changes made to it." - (|clearComponentCache| (|engine| *quick-view*)) - (|setSource| *quick-view* (|source| *quick-view*))) - -;;; call QML methods - -(defun qml-call (item/name method-name &rest arguments) - ;; QFUN+ comes in handy here - (apply 'qfun+ (quick-item item/name) method-name arguments)) - -;;; get/set QQmlProperty - -(defun qml-get (item/name property-name) - "Gets QQmlProperty of either ITEM or first object matching NAME." - (qlet ((property "QQmlProperty(QObject*,QString)" - (quick-item item/name) - property-name)) - (if (|isValid| property) - (qlet ((variant (|read| property))) - (values (qvariant-value variant) - t)) - (eql::%error-msg "QML-GET" (list item/name property-name))))) - -(defun qml-set (item/name property-name value &optional update) - "Sets QQmlProperty of either ITEM, or first object matching NAME. Returns T on success. If UPDATE is not NIL and ITEM is a QQuickPaintedItem, |update| will be called on it." - (let ((item (quick-item item/name))) - (qlet ((property "QQmlProperty(QObject*,QString)" item property-name)) - (if (|isValid| property) - (let ((type-name (|propertyTypeName| property))) - (qlet ((variant (qvariant-from-value value (if (find #\: type-name) "int" type-name)))) - (prog1 - (|write| property variant) - (when (and update (= (qt-object-id item) (qid "QQuickPaintedItem"))) - (|update| item))))) - (eql::%error-msg "QML-SET" (list item/name property-name value)))))) - -(defun qml-set-all (name property-name value &optional update) - "Sets QQmlProperty of all objects matching NAME." - (assert (stringp name)) - (dolist (item (qfind-children (root-item) name)) - (qml-set item property-name value update))) - -(defmacro q! (method-name item/name &rest arguments) - "Convenience macro for QML-CALL. Use symbol instead of string name." - `(qml-call ,item/name ,(symbol-name method-name) ,@arguments)) - -(defmacro q> (property-name item/name value &optional update) - "Convenience macro for QML-SET. Use symbol instead of string name." - `(qml-set ,item/name ,(symbol-name property-name) ,value ,update)) - -(defmacro q< (property-name item/name) - "Convenience macro for QML-GET. Use symbol instead of string name." - `(qml-get ,item/name ,(symbol-name property-name))) - -(defmacro q>* (property-name item/name value &optional update) - "Convenience macro for QML-SET-ALL. Use symbol instead of string name." - `(qml-set-all ,item/name ,(symbol-name property-name) ,value ,update)) - -;;; JS - -(defun js (item/name js-format-string &rest arguments) - "Evaluates a JS string, with 'this' bound to either ITEM, or first object matching NAME. Arguments are passed through FORMAT. Use this function instead of the (faster) QJS if you need to evaluate generic JS code." - (qlet ((qml-exp "QQmlExpression(QQmlContext*,QObject*,QString)" - (root-context) - (quick-item item/name) - (apply 'format nil js-format-string arguments)) - (variant (|evaluate| qml-exp))) - (qvariant-value variant))) - -(defun js-arg (object) - "To be used for arguments in function JS." - (with-output-to-string (*standard-output*) - (print-js-readably object))) - -(defun %qjs (item/name function-name &rest arguments) - ;; QJS-CALL is defined in EQL5, function 'ecl_fun.cpp' - (eql::qjs-call (quick-item item/name) function-name arguments)) - -(defmacro qjs (function-name item/name &rest arguments) - "Fast and direct JS calls; max 10 arguments of type: T, NIL, INTEGER, FLOAT, STRING, (nested) LIST of mentioned types. - Examples: - (qjs |drawLine| *canvas* 0 0 100.0 100.0) - (qjs |drawPath| *canvas* (list (list 0 0) (list 0 10.0) (list 10.0 10.0)))" - `(%qjs ,item/name ,(symbol-name function-name) ,@arguments)) - - diff --git a/examples/M-modules/quick/Tic-Tac-Toe/tic-tac-toe.lisp b/examples/M-modules/quick/Tic-Tac-Toe/tic-tac-toe.lisp index fa243a3..1ded636 100644 --- a/examples/M-modules/quick/Tic-Tac-Toe/tic-tac-toe.lisp +++ b/examples/M-modules/quick/Tic-Tac-Toe/tic-tac-toe.lisp @@ -7,7 +7,6 @@ (qrequire :quick) -(require :qml-lisp "qml-lisp") (require :game-logic "game-logic") (require :properties "properties") diff --git a/examples/M-modules/quick/item-model/abstract-model.lisp b/examples/M-modules/quick/item-model/abstract-model.lisp index 681709a..5f46792 100644 --- a/examples/M-modules/quick/item-model/abstract-model.lisp +++ b/examples/M-modules/quick/item-model/abstract-model.lisp @@ -2,7 +2,6 @@ (qrequire :quick) -(require :qml-lisp "qml-lisp") (require :properties "properties") (use-package :qml) diff --git a/examples/M-modules/quick/item-model/list-model.lisp b/examples/M-modules/quick/item-model/list-model.lisp index 6186893..60f5115 100644 --- a/examples/M-modules/quick/item-model/list-model.lisp +++ b/examples/M-modules/quick/item-model/list-model.lisp @@ -2,7 +2,6 @@ (qrequire :quick) -(require :qml-lisp "qml-lisp") (require :properties "properties") (use-package :qml) diff --git a/examples/M-modules/quick/item-model/qml-lisp.lisp b/examples/M-modules/quick/item-model/qml-lisp.lisp deleted file mode 100644 index 0d1385b..0000000 --- a/examples/M-modules/quick/item-model/qml-lisp.lisp +++ /dev/null @@ -1,215 +0,0 @@ -;;; -;;; * enables QML to call Lisp functions -;;; * allows to get/set any QML property from Lisp (needs 'objectName' to be set) -;;; * allows to call QML methods from Lisp (needs 'objectName' to be set) -;;; * allows to evaluate JS code from Lisp (needs 'objectName' to be set) -;;; - -(defpackage :qml-lisp - (:use :common-lisp :eql) - (:nicknames :qml) - (:export - #:*quick-view* - #:*caller* - #:children - #:find-quick-item - #:js - #:js-arg - #:qml-call - #:qml-get - #:qml-set - #:qml-set-all - #:q! - #:q< - #:q> - #:q>* - #:qjs - #:paint - #:scale - #:reload - #:root-context - #:root-item)) - -(provide :qml-lisp) - -(in-package :qml-lisp) - -(defvar *quick-view* nil) -(defvar *caller* nil) - -(defun string-to-symbol (name) - (let ((upper (string-upcase name)) - (p (position #\: name))) - (if p - (find-symbol (subseq upper (1+ (position #\: name :from-end t))) - (subseq upper 0 p)) - (find-symbol upper)))) - -;;; 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) - "Every 'Lisp.call()' or 'Lisp.apply()' function call in QML will call this function. The variable *CALLER* will be bound to the calling QQuickItem, if passed with 'this' as first argument to 'Lisp.call()' / 'Lisp.apply()'." - (let* ((*caller* (if (qnull caller) *caller* (qt-object-? caller))) - (object (apply (string-to-symbol function) - arguments))) - (if (stringp object) - object - (print-to-js-string object)))) - -;;; utils - -(defun root-item () - (when *quick-view* - (if (= (qt-object-id *quick-view*) #.(qid "QQmlApplicationEngine")) - (let ((object (first (|rootObjects| *quick-view*)))) - (setf (qt-object-id object) #.(qid "QObject")) ; unknown to EQL, so resort to QObject - object) - (qt-object-? (|rootObject| *quick-view*))))) - -(defun root-context () - (when *quick-view* - (|rootContext| *quick-view*))) - -(defun find-quick-item (object-name) - "Finds the first QQuickItem matching OBJECT-NAME." - (let ((root (root-item))) - (unless (qnull root) - (if (string= (|objectName| root) object-name) - (root-item) - (qt-object-? (qfind-child root object-name)))))) - -(defun quick-item (item/name) - (cond ((stringp item/name) - (find-quick-item item/name)) - ((qt-object-p item/name) - item/name) - ((not item/name) - (root-item)))) - -(defun children (item/name) - "Like QML function 'children'." - (mapcar 'qt-object-? (|childItems| (quick-item item/name)))) - -(defun scale () - "Returns the scale factor used on high dpi scaled devices (e.g. phones)." - (|effectiveDevicePixelRatio| *quick-view*)) - -(defun reload () - "Force reloading of QML file after changes made to it." - (|clearComponentCache| (|engine| *quick-view*)) - (|setSource| *quick-view* (|source| *quick-view*))) - -;;; call QML methods - -(defun qml-call (item/name method-name &rest arguments) - ;; QFUN+ comes in handy here - (apply 'qfun+ (quick-item item/name) method-name arguments)) - -;;; get/set QQmlProperty - -(defun qml-get (item/name property-name) - "Gets QQmlProperty of either ITEM or first object matching NAME." - (qlet ((property "QQmlProperty(QObject*,QString)" - (quick-item item/name) - property-name)) - (if (|isValid| property) - (qlet ((variant (|read| property))) - (values (qvariant-value variant) - t)) - (eql::%error-msg "QML-GET" (list item/name property-name))))) - -(defun qml-set (item/name property-name value &optional update) - "Sets QQmlProperty of either ITEM, or first object matching NAME. Returns T on success. If UPDATE is not NIL and ITEM is a QQuickPaintedItem, |update| will be called on it." - (let ((item (quick-item item/name))) - (qlet ((property "QQmlProperty(QObject*,QString)" item property-name)) - (if (|isValid| property) - (let ((type-name (|propertyTypeName| property))) - (qlet ((variant (qvariant-from-value value (if (find #\: type-name) "int" type-name)))) - (prog1 - (|write| property variant) - (when (and update (= (qt-object-id item) (qid "QQuickPaintedItem"))) - (|update| item))))) - (eql::%error-msg "QML-SET" (list item/name property-name value)))))) - -(defun qml-set-all (name property-name value &optional update) - "Sets QQmlProperty of all objects matching NAME." - (assert (stringp name)) - (dolist (item (qfind-children (root-item) name)) - (qml-set item property-name value update))) - -(defmacro q! (method-name item/name &rest arguments) - "Convenience macro for QML-CALL. Use symbol instead of string name." - `(qml-call ,item/name ,(symbol-name method-name) ,@arguments)) - -(defmacro q> (property-name item/name value &optional update) - "Convenience macro for QML-SET. Use symbol instead of string name." - `(qml-set ,item/name ,(symbol-name property-name) ,value ,update)) - -(defmacro q< (property-name item/name) - "Convenience macro for QML-GET. Use symbol instead of string name." - `(qml-get ,item/name ,(symbol-name property-name))) - -(defmacro q>* (property-name item/name value &optional update) - "Convenience macro for QML-SET-ALL. Use symbol instead of string name." - `(qml-set-all ,item/name ,(symbol-name property-name) ,value ,update)) - -;;; JS - -(defun js (item/name js-format-string &rest arguments) - "Evaluates a JS string, with 'this' bound to either ITEM, or first object matching NAME. Arguments are passed through FORMAT. Use this function instead of the (faster) QJS if you need to evaluate generic JS code." - (qlet ((qml-exp "QQmlExpression(QQmlContext*,QObject*,QString)" - (root-context) - (quick-item item/name) - (apply 'format nil js-format-string arguments)) - (variant (|evaluate| qml-exp))) - (qvariant-value variant))) - -(defun js-arg (object) - "To be used for arguments in function JS." - (with-output-to-string (*standard-output*) - (print-js-readably object))) - -(defun %qjs (item/name function-name &rest arguments) - ;; QJS-CALL is defined in EQL5, function 'ecl_fun.cpp' - (eql::qjs-call (quick-item item/name) function-name arguments)) - -(defmacro qjs (function-name item/name &rest arguments) - "Fast and direct JS calls; max 10 arguments of type: T, NIL, INTEGER, FLOAT, STRING, (nested) LIST of mentioned types. - Examples: - (qjs |drawLine| *canvas* 0 0 100.0 100.0) - (qjs |drawPath| *canvas* (list (list 0 0) (list 0 10.0) (list 10.0 10.0)))" - `(%qjs ,item/name ,(symbol-name function-name) ,@arguments)) - - diff --git a/examples/M-modules/quick/painted-item/painted-item.lisp b/examples/M-modules/quick/painted-item/painted-item.lisp index f29b1b5..22b552e 100644 --- a/examples/M-modules/quick/painted-item/painted-item.lisp +++ b/examples/M-modules/quick/painted-item/painted-item.lisp @@ -5,7 +5,6 @@ (qrequire :quick) -(require :qml-lisp "qml-lisp") (require :clock "clock") (require :properties "properties") diff --git a/examples/M-modules/quick/painted-item/qml-lisp.lisp b/examples/M-modules/quick/painted-item/qml-lisp.lisp deleted file mode 100644 index 0d1385b..0000000 --- a/examples/M-modules/quick/painted-item/qml-lisp.lisp +++ /dev/null @@ -1,215 +0,0 @@ -;;; -;;; * enables QML to call Lisp functions -;;; * allows to get/set any QML property from Lisp (needs 'objectName' to be set) -;;; * allows to call QML methods from Lisp (needs 'objectName' to be set) -;;; * allows to evaluate JS code from Lisp (needs 'objectName' to be set) -;;; - -(defpackage :qml-lisp - (:use :common-lisp :eql) - (:nicknames :qml) - (:export - #:*quick-view* - #:*caller* - #:children - #:find-quick-item - #:js - #:js-arg - #:qml-call - #:qml-get - #:qml-set - #:qml-set-all - #:q! - #:q< - #:q> - #:q>* - #:qjs - #:paint - #:scale - #:reload - #:root-context - #:root-item)) - -(provide :qml-lisp) - -(in-package :qml-lisp) - -(defvar *quick-view* nil) -(defvar *caller* nil) - -(defun string-to-symbol (name) - (let ((upper (string-upcase name)) - (p (position #\: name))) - (if p - (find-symbol (subseq upper (1+ (position #\: name :from-end t))) - (subseq upper 0 p)) - (find-symbol upper)))) - -;;; 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) - "Every 'Lisp.call()' or 'Lisp.apply()' function call in QML will call this function. The variable *CALLER* will be bound to the calling QQuickItem, if passed with 'this' as first argument to 'Lisp.call()' / 'Lisp.apply()'." - (let* ((*caller* (if (qnull caller) *caller* (qt-object-? caller))) - (object (apply (string-to-symbol function) - arguments))) - (if (stringp object) - object - (print-to-js-string object)))) - -;;; utils - -(defun root-item () - (when *quick-view* - (if (= (qt-object-id *quick-view*) #.(qid "QQmlApplicationEngine")) - (let ((object (first (|rootObjects| *quick-view*)))) - (setf (qt-object-id object) #.(qid "QObject")) ; unknown to EQL, so resort to QObject - object) - (qt-object-? (|rootObject| *quick-view*))))) - -(defun root-context () - (when *quick-view* - (|rootContext| *quick-view*))) - -(defun find-quick-item (object-name) - "Finds the first QQuickItem matching OBJECT-NAME." - (let ((root (root-item))) - (unless (qnull root) - (if (string= (|objectName| root) object-name) - (root-item) - (qt-object-? (qfind-child root object-name)))))) - -(defun quick-item (item/name) - (cond ((stringp item/name) - (find-quick-item item/name)) - ((qt-object-p item/name) - item/name) - ((not item/name) - (root-item)))) - -(defun children (item/name) - "Like QML function 'children'." - (mapcar 'qt-object-? (|childItems| (quick-item item/name)))) - -(defun scale () - "Returns the scale factor used on high dpi scaled devices (e.g. phones)." - (|effectiveDevicePixelRatio| *quick-view*)) - -(defun reload () - "Force reloading of QML file after changes made to it." - (|clearComponentCache| (|engine| *quick-view*)) - (|setSource| *quick-view* (|source| *quick-view*))) - -;;; call QML methods - -(defun qml-call (item/name method-name &rest arguments) - ;; QFUN+ comes in handy here - (apply 'qfun+ (quick-item item/name) method-name arguments)) - -;;; get/set QQmlProperty - -(defun qml-get (item/name property-name) - "Gets QQmlProperty of either ITEM or first object matching NAME." - (qlet ((property "QQmlProperty(QObject*,QString)" - (quick-item item/name) - property-name)) - (if (|isValid| property) - (qlet ((variant (|read| property))) - (values (qvariant-value variant) - t)) - (eql::%error-msg "QML-GET" (list item/name property-name))))) - -(defun qml-set (item/name property-name value &optional update) - "Sets QQmlProperty of either ITEM, or first object matching NAME. Returns T on success. If UPDATE is not NIL and ITEM is a QQuickPaintedItem, |update| will be called on it." - (let ((item (quick-item item/name))) - (qlet ((property "QQmlProperty(QObject*,QString)" item property-name)) - (if (|isValid| property) - (let ((type-name (|propertyTypeName| property))) - (qlet ((variant (qvariant-from-value value (if (find #\: type-name) "int" type-name)))) - (prog1 - (|write| property variant) - (when (and update (= (qt-object-id item) (qid "QQuickPaintedItem"))) - (|update| item))))) - (eql::%error-msg "QML-SET" (list item/name property-name value)))))) - -(defun qml-set-all (name property-name value &optional update) - "Sets QQmlProperty of all objects matching NAME." - (assert (stringp name)) - (dolist (item (qfind-children (root-item) name)) - (qml-set item property-name value update))) - -(defmacro q! (method-name item/name &rest arguments) - "Convenience macro for QML-CALL. Use symbol instead of string name." - `(qml-call ,item/name ,(symbol-name method-name) ,@arguments)) - -(defmacro q> (property-name item/name value &optional update) - "Convenience macro for QML-SET. Use symbol instead of string name." - `(qml-set ,item/name ,(symbol-name property-name) ,value ,update)) - -(defmacro q< (property-name item/name) - "Convenience macro for QML-GET. Use symbol instead of string name." - `(qml-get ,item/name ,(symbol-name property-name))) - -(defmacro q>* (property-name item/name value &optional update) - "Convenience macro for QML-SET-ALL. Use symbol instead of string name." - `(qml-set-all ,item/name ,(symbol-name property-name) ,value ,update)) - -;;; JS - -(defun js (item/name js-format-string &rest arguments) - "Evaluates a JS string, with 'this' bound to either ITEM, or first object matching NAME. Arguments are passed through FORMAT. Use this function instead of the (faster) QJS if you need to evaluate generic JS code." - (qlet ((qml-exp "QQmlExpression(QQmlContext*,QObject*,QString)" - (root-context) - (quick-item item/name) - (apply 'format nil js-format-string arguments)) - (variant (|evaluate| qml-exp))) - (qvariant-value variant))) - -(defun js-arg (object) - "To be used for arguments in function JS." - (with-output-to-string (*standard-output*) - (print-js-readably object))) - -(defun %qjs (item/name function-name &rest arguments) - ;; QJS-CALL is defined in EQL5, function 'ecl_fun.cpp' - (eql::qjs-call (quick-item item/name) function-name arguments)) - -(defmacro qjs (function-name item/name &rest arguments) - "Fast and direct JS calls; max 10 arguments of type: T, NIL, INTEGER, FLOAT, STRING, (nested) LIST of mentioned types. - Examples: - (qjs |drawLine| *canvas* 0 0 100.0 100.0) - (qjs |drawPath| *canvas* (list (list 0 0) (list 0 10.0) (list 10.0 10.0)))" - `(%qjs ,item/name ,(symbol-name function-name) ,@arguments)) - - diff --git a/examples/M-modules/quick/palindrome-2/palindrome.lisp b/examples/M-modules/quick/palindrome-2/palindrome.lisp index 838f611..c94969a 100644 --- a/examples/M-modules/quick/palindrome-2/palindrome.lisp +++ b/examples/M-modules/quick/palindrome-2/palindrome.lisp @@ -2,7 +2,6 @@ (qrequire :quick) -(require :qml-lisp "qml-lisp") (require :properties "properties") (require :utils "utils") diff --git a/examples/M-modules/quick/palindrome-2/qml-lisp.lisp b/examples/M-modules/quick/palindrome-2/qml-lisp.lisp deleted file mode 100644 index 0d1385b..0000000 --- a/examples/M-modules/quick/palindrome-2/qml-lisp.lisp +++ /dev/null @@ -1,215 +0,0 @@ -;;; -;;; * enables QML to call Lisp functions -;;; * allows to get/set any QML property from Lisp (needs 'objectName' to be set) -;;; * allows to call QML methods from Lisp (needs 'objectName' to be set) -;;; * allows to evaluate JS code from Lisp (needs 'objectName' to be set) -;;; - -(defpackage :qml-lisp - (:use :common-lisp :eql) - (:nicknames :qml) - (:export - #:*quick-view* - #:*caller* - #:children - #:find-quick-item - #:js - #:js-arg - #:qml-call - #:qml-get - #:qml-set - #:qml-set-all - #:q! - #:q< - #:q> - #:q>* - #:qjs - #:paint - #:scale - #:reload - #:root-context - #:root-item)) - -(provide :qml-lisp) - -(in-package :qml-lisp) - -(defvar *quick-view* nil) -(defvar *caller* nil) - -(defun string-to-symbol (name) - (let ((upper (string-upcase name)) - (p (position #\: name))) - (if p - (find-symbol (subseq upper (1+ (position #\: name :from-end t))) - (subseq upper 0 p)) - (find-symbol upper)))) - -;;; 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) - "Every 'Lisp.call()' or 'Lisp.apply()' function call in QML will call this function. The variable *CALLER* will be bound to the calling QQuickItem, if passed with 'this' as first argument to 'Lisp.call()' / 'Lisp.apply()'." - (let* ((*caller* (if (qnull caller) *caller* (qt-object-? caller))) - (object (apply (string-to-symbol function) - arguments))) - (if (stringp object) - object - (print-to-js-string object)))) - -;;; utils - -(defun root-item () - (when *quick-view* - (if (= (qt-object-id *quick-view*) #.(qid "QQmlApplicationEngine")) - (let ((object (first (|rootObjects| *quick-view*)))) - (setf (qt-object-id object) #.(qid "QObject")) ; unknown to EQL, so resort to QObject - object) - (qt-object-? (|rootObject| *quick-view*))))) - -(defun root-context () - (when *quick-view* - (|rootContext| *quick-view*))) - -(defun find-quick-item (object-name) - "Finds the first QQuickItem matching OBJECT-NAME." - (let ((root (root-item))) - (unless (qnull root) - (if (string= (|objectName| root) object-name) - (root-item) - (qt-object-? (qfind-child root object-name)))))) - -(defun quick-item (item/name) - (cond ((stringp item/name) - (find-quick-item item/name)) - ((qt-object-p item/name) - item/name) - ((not item/name) - (root-item)))) - -(defun children (item/name) - "Like QML function 'children'." - (mapcar 'qt-object-? (|childItems| (quick-item item/name)))) - -(defun scale () - "Returns the scale factor used on high dpi scaled devices (e.g. phones)." - (|effectiveDevicePixelRatio| *quick-view*)) - -(defun reload () - "Force reloading of QML file after changes made to it." - (|clearComponentCache| (|engine| *quick-view*)) - (|setSource| *quick-view* (|source| *quick-view*))) - -;;; call QML methods - -(defun qml-call (item/name method-name &rest arguments) - ;; QFUN+ comes in handy here - (apply 'qfun+ (quick-item item/name) method-name arguments)) - -;;; get/set QQmlProperty - -(defun qml-get (item/name property-name) - "Gets QQmlProperty of either ITEM or first object matching NAME." - (qlet ((property "QQmlProperty(QObject*,QString)" - (quick-item item/name) - property-name)) - (if (|isValid| property) - (qlet ((variant (|read| property))) - (values (qvariant-value variant) - t)) - (eql::%error-msg "QML-GET" (list item/name property-name))))) - -(defun qml-set (item/name property-name value &optional update) - "Sets QQmlProperty of either ITEM, or first object matching NAME. Returns T on success. If UPDATE is not NIL and ITEM is a QQuickPaintedItem, |update| will be called on it." - (let ((item (quick-item item/name))) - (qlet ((property "QQmlProperty(QObject*,QString)" item property-name)) - (if (|isValid| property) - (let ((type-name (|propertyTypeName| property))) - (qlet ((variant (qvariant-from-value value (if (find #\: type-name) "int" type-name)))) - (prog1 - (|write| property variant) - (when (and update (= (qt-object-id item) (qid "QQuickPaintedItem"))) - (|update| item))))) - (eql::%error-msg "QML-SET" (list item/name property-name value)))))) - -(defun qml-set-all (name property-name value &optional update) - "Sets QQmlProperty of all objects matching NAME." - (assert (stringp name)) - (dolist (item (qfind-children (root-item) name)) - (qml-set item property-name value update))) - -(defmacro q! (method-name item/name &rest arguments) - "Convenience macro for QML-CALL. Use symbol instead of string name." - `(qml-call ,item/name ,(symbol-name method-name) ,@arguments)) - -(defmacro q> (property-name item/name value &optional update) - "Convenience macro for QML-SET. Use symbol instead of string name." - `(qml-set ,item/name ,(symbol-name property-name) ,value ,update)) - -(defmacro q< (property-name item/name) - "Convenience macro for QML-GET. Use symbol instead of string name." - `(qml-get ,item/name ,(symbol-name property-name))) - -(defmacro q>* (property-name item/name value &optional update) - "Convenience macro for QML-SET-ALL. Use symbol instead of string name." - `(qml-set-all ,item/name ,(symbol-name property-name) ,value ,update)) - -;;; JS - -(defun js (item/name js-format-string &rest arguments) - "Evaluates a JS string, with 'this' bound to either ITEM, or first object matching NAME. Arguments are passed through FORMAT. Use this function instead of the (faster) QJS if you need to evaluate generic JS code." - (qlet ((qml-exp "QQmlExpression(QQmlContext*,QObject*,QString)" - (root-context) - (quick-item item/name) - (apply 'format nil js-format-string arguments)) - (variant (|evaluate| qml-exp))) - (qvariant-value variant))) - -(defun js-arg (object) - "To be used for arguments in function JS." - (with-output-to-string (*standard-output*) - (print-js-readably object))) - -(defun %qjs (item/name function-name &rest arguments) - ;; QJS-CALL is defined in EQL5, function 'ecl_fun.cpp' - (eql::qjs-call (quick-item item/name) function-name arguments)) - -(defmacro qjs (function-name item/name &rest arguments) - "Fast and direct JS calls; max 10 arguments of type: T, NIL, INTEGER, FLOAT, STRING, (nested) LIST of mentioned types. - Examples: - (qjs |drawLine| *canvas* 0 0 100.0 100.0) - (qjs |drawPath| *canvas* (list (list 0 0) (list 0 10.0) (list 10.0 10.0)))" - `(%qjs ,item/name ,(symbol-name function-name) ,@arguments)) - - diff --git a/examples/M-modules/quick/qml-lisp/example.lisp b/examples/M-modules/quick/qml-lisp/example.lisp index 8675302..64bc413 100644 --- a/examples/M-modules/quick/qml-lisp/example.lisp +++ b/examples/M-modules/quick/qml-lisp/example.lisp @@ -4,7 +4,6 @@ (qrequire :quick) -(require :qml-lisp "qml-lisp") (require :properties "properties") (use-package :qml) diff --git a/examples/M-modules/quick/qml-lisp/qml-lisp.lisp b/examples/M-modules/quick/qml-lisp/qml-lisp.lisp deleted file mode 100644 index 0d1385b..0000000 --- a/examples/M-modules/quick/qml-lisp/qml-lisp.lisp +++ /dev/null @@ -1,215 +0,0 @@ -;;; -;;; * enables QML to call Lisp functions -;;; * allows to get/set any QML property from Lisp (needs 'objectName' to be set) -;;; * allows to call QML methods from Lisp (needs 'objectName' to be set) -;;; * allows to evaluate JS code from Lisp (needs 'objectName' to be set) -;;; - -(defpackage :qml-lisp - (:use :common-lisp :eql) - (:nicknames :qml) - (:export - #:*quick-view* - #:*caller* - #:children - #:find-quick-item - #:js - #:js-arg - #:qml-call - #:qml-get - #:qml-set - #:qml-set-all - #:q! - #:q< - #:q> - #:q>* - #:qjs - #:paint - #:scale - #:reload - #:root-context - #:root-item)) - -(provide :qml-lisp) - -(in-package :qml-lisp) - -(defvar *quick-view* nil) -(defvar *caller* nil) - -(defun string-to-symbol (name) - (let ((upper (string-upcase name)) - (p (position #\: name))) - (if p - (find-symbol (subseq upper (1+ (position #\: name :from-end t))) - (subseq upper 0 p)) - (find-symbol upper)))) - -;;; 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) - "Every 'Lisp.call()' or 'Lisp.apply()' function call in QML will call this function. The variable *CALLER* will be bound to the calling QQuickItem, if passed with 'this' as first argument to 'Lisp.call()' / 'Lisp.apply()'." - (let* ((*caller* (if (qnull caller) *caller* (qt-object-? caller))) - (object (apply (string-to-symbol function) - arguments))) - (if (stringp object) - object - (print-to-js-string object)))) - -;;; utils - -(defun root-item () - (when *quick-view* - (if (= (qt-object-id *quick-view*) #.(qid "QQmlApplicationEngine")) - (let ((object (first (|rootObjects| *quick-view*)))) - (setf (qt-object-id object) #.(qid "QObject")) ; unknown to EQL, so resort to QObject - object) - (qt-object-? (|rootObject| *quick-view*))))) - -(defun root-context () - (when *quick-view* - (|rootContext| *quick-view*))) - -(defun find-quick-item (object-name) - "Finds the first QQuickItem matching OBJECT-NAME." - (let ((root (root-item))) - (unless (qnull root) - (if (string= (|objectName| root) object-name) - (root-item) - (qt-object-? (qfind-child root object-name)))))) - -(defun quick-item (item/name) - (cond ((stringp item/name) - (find-quick-item item/name)) - ((qt-object-p item/name) - item/name) - ((not item/name) - (root-item)))) - -(defun children (item/name) - "Like QML function 'children'." - (mapcar 'qt-object-? (|childItems| (quick-item item/name)))) - -(defun scale () - "Returns the scale factor used on high dpi scaled devices (e.g. phones)." - (|effectiveDevicePixelRatio| *quick-view*)) - -(defun reload () - "Force reloading of QML file after changes made to it." - (|clearComponentCache| (|engine| *quick-view*)) - (|setSource| *quick-view* (|source| *quick-view*))) - -;;; call QML methods - -(defun qml-call (item/name method-name &rest arguments) - ;; QFUN+ comes in handy here - (apply 'qfun+ (quick-item item/name) method-name arguments)) - -;;; get/set QQmlProperty - -(defun qml-get (item/name property-name) - "Gets QQmlProperty of either ITEM or first object matching NAME." - (qlet ((property "QQmlProperty(QObject*,QString)" - (quick-item item/name) - property-name)) - (if (|isValid| property) - (qlet ((variant (|read| property))) - (values (qvariant-value variant) - t)) - (eql::%error-msg "QML-GET" (list item/name property-name))))) - -(defun qml-set (item/name property-name value &optional update) - "Sets QQmlProperty of either ITEM, or first object matching NAME. Returns T on success. If UPDATE is not NIL and ITEM is a QQuickPaintedItem, |update| will be called on it." - (let ((item (quick-item item/name))) - (qlet ((property "QQmlProperty(QObject*,QString)" item property-name)) - (if (|isValid| property) - (let ((type-name (|propertyTypeName| property))) - (qlet ((variant (qvariant-from-value value (if (find #\: type-name) "int" type-name)))) - (prog1 - (|write| property variant) - (when (and update (= (qt-object-id item) (qid "QQuickPaintedItem"))) - (|update| item))))) - (eql::%error-msg "QML-SET" (list item/name property-name value)))))) - -(defun qml-set-all (name property-name value &optional update) - "Sets QQmlProperty of all objects matching NAME." - (assert (stringp name)) - (dolist (item (qfind-children (root-item) name)) - (qml-set item property-name value update))) - -(defmacro q! (method-name item/name &rest arguments) - "Convenience macro for QML-CALL. Use symbol instead of string name." - `(qml-call ,item/name ,(symbol-name method-name) ,@arguments)) - -(defmacro q> (property-name item/name value &optional update) - "Convenience macro for QML-SET. Use symbol instead of string name." - `(qml-set ,item/name ,(symbol-name property-name) ,value ,update)) - -(defmacro q< (property-name item/name) - "Convenience macro for QML-GET. Use symbol instead of string name." - `(qml-get ,item/name ,(symbol-name property-name))) - -(defmacro q>* (property-name item/name value &optional update) - "Convenience macro for QML-SET-ALL. Use symbol instead of string name." - `(qml-set-all ,item/name ,(symbol-name property-name) ,value ,update)) - -;;; JS - -(defun js (item/name js-format-string &rest arguments) - "Evaluates a JS string, with 'this' bound to either ITEM, or first object matching NAME. Arguments are passed through FORMAT. Use this function instead of the (faster) QJS if you need to evaluate generic JS code." - (qlet ((qml-exp "QQmlExpression(QQmlContext*,QObject*,QString)" - (root-context) - (quick-item item/name) - (apply 'format nil js-format-string arguments)) - (variant (|evaluate| qml-exp))) - (qvariant-value variant))) - -(defun js-arg (object) - "To be used for arguments in function JS." - (with-output-to-string (*standard-output*) - (print-js-readably object))) - -(defun %qjs (item/name function-name &rest arguments) - ;; QJS-CALL is defined in EQL5, function 'ecl_fun.cpp' - (eql::qjs-call (quick-item item/name) function-name arguments)) - -(defmacro qjs (function-name item/name &rest arguments) - "Fast and direct JS calls; max 10 arguments of type: T, NIL, INTEGER, FLOAT, STRING, (nested) LIST of mentioned types. - Examples: - (qjs |drawLine| *canvas* 0 0 100.0 100.0) - (qjs |drawPath| *canvas* (list (list 0 0) (list 0 10.0) (list 10.0 10.0)))" - `(%qjs ,item/name ,(symbol-name function-name) ,@arguments)) - - diff --git a/examples/M-modules/quick/qml-lisp/qml/example.qml b/examples/M-modules/quick/qml-lisp/qml/example.qml index 2878cc2..0837608 100644 --- a/examples/M-modules/quick/qml-lisp/qml/example.qml +++ b/examples/M-modules/quick/qml-lisp/qml/example.qml @@ -32,7 +32,8 @@ Item { console.log(Lisp.call("x:join", ["11", "55"], ":")) // (4) nested list arguments - // N.B: don't get fooled by the printed representation of the return value: + // N.B: don't get fooled by the printed representation of the return value + // (affects older Qt versions only): // it's a nested JS array internally (".length" will give 3) console.log(Lisp.call("list", [[1, 2, 3], ["a", "b", "c"], 4, 5], 6, [[7, 8], 9])) diff --git a/examples/M-modules/quick/sokoban/lisp/qml-lisp.lisp b/examples/M-modules/quick/sokoban/lisp/qml-lisp.lisp deleted file mode 100644 index 0d1385b..0000000 --- a/examples/M-modules/quick/sokoban/lisp/qml-lisp.lisp +++ /dev/null @@ -1,215 +0,0 @@ -;;; -;;; * enables QML to call Lisp functions -;;; * allows to get/set any QML property from Lisp (needs 'objectName' to be set) -;;; * allows to call QML methods from Lisp (needs 'objectName' to be set) -;;; * allows to evaluate JS code from Lisp (needs 'objectName' to be set) -;;; - -(defpackage :qml-lisp - (:use :common-lisp :eql) - (:nicknames :qml) - (:export - #:*quick-view* - #:*caller* - #:children - #:find-quick-item - #:js - #:js-arg - #:qml-call - #:qml-get - #:qml-set - #:qml-set-all - #:q! - #:q< - #:q> - #:q>* - #:qjs - #:paint - #:scale - #:reload - #:root-context - #:root-item)) - -(provide :qml-lisp) - -(in-package :qml-lisp) - -(defvar *quick-view* nil) -(defvar *caller* nil) - -(defun string-to-symbol (name) - (let ((upper (string-upcase name)) - (p (position #\: name))) - (if p - (find-symbol (subseq upper (1+ (position #\: name :from-end t))) - (subseq upper 0 p)) - (find-symbol upper)))) - -;;; 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) - "Every 'Lisp.call()' or 'Lisp.apply()' function call in QML will call this function. The variable *CALLER* will be bound to the calling QQuickItem, if passed with 'this' as first argument to 'Lisp.call()' / 'Lisp.apply()'." - (let* ((*caller* (if (qnull caller) *caller* (qt-object-? caller))) - (object (apply (string-to-symbol function) - arguments))) - (if (stringp object) - object - (print-to-js-string object)))) - -;;; utils - -(defun root-item () - (when *quick-view* - (if (= (qt-object-id *quick-view*) #.(qid "QQmlApplicationEngine")) - (let ((object (first (|rootObjects| *quick-view*)))) - (setf (qt-object-id object) #.(qid "QObject")) ; unknown to EQL, so resort to QObject - object) - (qt-object-? (|rootObject| *quick-view*))))) - -(defun root-context () - (when *quick-view* - (|rootContext| *quick-view*))) - -(defun find-quick-item (object-name) - "Finds the first QQuickItem matching OBJECT-NAME." - (let ((root (root-item))) - (unless (qnull root) - (if (string= (|objectName| root) object-name) - (root-item) - (qt-object-? (qfind-child root object-name)))))) - -(defun quick-item (item/name) - (cond ((stringp item/name) - (find-quick-item item/name)) - ((qt-object-p item/name) - item/name) - ((not item/name) - (root-item)))) - -(defun children (item/name) - "Like QML function 'children'." - (mapcar 'qt-object-? (|childItems| (quick-item item/name)))) - -(defun scale () - "Returns the scale factor used on high dpi scaled devices (e.g. phones)." - (|effectiveDevicePixelRatio| *quick-view*)) - -(defun reload () - "Force reloading of QML file after changes made to it." - (|clearComponentCache| (|engine| *quick-view*)) - (|setSource| *quick-view* (|source| *quick-view*))) - -;;; call QML methods - -(defun qml-call (item/name method-name &rest arguments) - ;; QFUN+ comes in handy here - (apply 'qfun+ (quick-item item/name) method-name arguments)) - -;;; get/set QQmlProperty - -(defun qml-get (item/name property-name) - "Gets QQmlProperty of either ITEM or first object matching NAME." - (qlet ((property "QQmlProperty(QObject*,QString)" - (quick-item item/name) - property-name)) - (if (|isValid| property) - (qlet ((variant (|read| property))) - (values (qvariant-value variant) - t)) - (eql::%error-msg "QML-GET" (list item/name property-name))))) - -(defun qml-set (item/name property-name value &optional update) - "Sets QQmlProperty of either ITEM, or first object matching NAME. Returns T on success. If UPDATE is not NIL and ITEM is a QQuickPaintedItem, |update| will be called on it." - (let ((item (quick-item item/name))) - (qlet ((property "QQmlProperty(QObject*,QString)" item property-name)) - (if (|isValid| property) - (let ((type-name (|propertyTypeName| property))) - (qlet ((variant (qvariant-from-value value (if (find #\: type-name) "int" type-name)))) - (prog1 - (|write| property variant) - (when (and update (= (qt-object-id item) (qid "QQuickPaintedItem"))) - (|update| item))))) - (eql::%error-msg "QML-SET" (list item/name property-name value)))))) - -(defun qml-set-all (name property-name value &optional update) - "Sets QQmlProperty of all objects matching NAME." - (assert (stringp name)) - (dolist (item (qfind-children (root-item) name)) - (qml-set item property-name value update))) - -(defmacro q! (method-name item/name &rest arguments) - "Convenience macro for QML-CALL. Use symbol instead of string name." - `(qml-call ,item/name ,(symbol-name method-name) ,@arguments)) - -(defmacro q> (property-name item/name value &optional update) - "Convenience macro for QML-SET. Use symbol instead of string name." - `(qml-set ,item/name ,(symbol-name property-name) ,value ,update)) - -(defmacro q< (property-name item/name) - "Convenience macro for QML-GET. Use symbol instead of string name." - `(qml-get ,item/name ,(symbol-name property-name))) - -(defmacro q>* (property-name item/name value &optional update) - "Convenience macro for QML-SET-ALL. Use symbol instead of string name." - `(qml-set-all ,item/name ,(symbol-name property-name) ,value ,update)) - -;;; JS - -(defun js (item/name js-format-string &rest arguments) - "Evaluates a JS string, with 'this' bound to either ITEM, or first object matching NAME. Arguments are passed through FORMAT. Use this function instead of the (faster) QJS if you need to evaluate generic JS code." - (qlet ((qml-exp "QQmlExpression(QQmlContext*,QObject*,QString)" - (root-context) - (quick-item item/name) - (apply 'format nil js-format-string arguments)) - (variant (|evaluate| qml-exp))) - (qvariant-value variant))) - -(defun js-arg (object) - "To be used for arguments in function JS." - (with-output-to-string (*standard-output*) - (print-js-readably object))) - -(defun %qjs (item/name function-name &rest arguments) - ;; QJS-CALL is defined in EQL5, function 'ecl_fun.cpp' - (eql::qjs-call (quick-item item/name) function-name arguments)) - -(defmacro qjs (function-name item/name &rest arguments) - "Fast and direct JS calls; max 10 arguments of type: T, NIL, INTEGER, FLOAT, STRING, (nested) LIST of mentioned types. - Examples: - (qjs |drawLine| *canvas* 0 0 100.0 100.0) - (qjs |drawPath| *canvas* (list (list 0 0) (list 0 10.0) (list 10.0 10.0)))" - `(%qjs ,item/name ,(symbol-name function-name) ,@arguments)) - - diff --git a/examples/M-modules/quick/sokoban/sokoban.lisp b/examples/M-modules/quick/sokoban/sokoban.lisp index aeff7b4..7d92e19 100644 --- a/examples/M-modules/quick/sokoban/sokoban.lisp +++ b/examples/M-modules/quick/sokoban/sokoban.lisp @@ -6,10 +6,9 @@ (qrequire :quick) -(require :sokoban "lisp/3rd-party/sokoban") -(require :levels "lisp/3rd-party/my-levels") -(require :qml-lisp "lisp/qml-lisp") -(require :ui-vars "lisp/ui-vars.lisp") +(require :sokoban "lisp/3rd-party/sokoban") +(require :levels "lisp/3rd-party/my-levels") +(require :ui-vars "lisp/ui-vars.lisp") (defpackage :qsoko (:use :common-lisp :eql :qml) diff --git a/examples/M-modules/quick/table-view/qml-lisp.lisp b/examples/M-modules/quick/table-view/qml-lisp.lisp deleted file mode 100644 index 0d1385b..0000000 --- a/examples/M-modules/quick/table-view/qml-lisp.lisp +++ /dev/null @@ -1,215 +0,0 @@ -;;; -;;; * enables QML to call Lisp functions -;;; * allows to get/set any QML property from Lisp (needs 'objectName' to be set) -;;; * allows to call QML methods from Lisp (needs 'objectName' to be set) -;;; * allows to evaluate JS code from Lisp (needs 'objectName' to be set) -;;; - -(defpackage :qml-lisp - (:use :common-lisp :eql) - (:nicknames :qml) - (:export - #:*quick-view* - #:*caller* - #:children - #:find-quick-item - #:js - #:js-arg - #:qml-call - #:qml-get - #:qml-set - #:qml-set-all - #:q! - #:q< - #:q> - #:q>* - #:qjs - #:paint - #:scale - #:reload - #:root-context - #:root-item)) - -(provide :qml-lisp) - -(in-package :qml-lisp) - -(defvar *quick-view* nil) -(defvar *caller* nil) - -(defun string-to-symbol (name) - (let ((upper (string-upcase name)) - (p (position #\: name))) - (if p - (find-symbol (subseq upper (1+ (position #\: name :from-end t))) - (subseq upper 0 p)) - (find-symbol upper)))) - -;;; 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) - "Every 'Lisp.call()' or 'Lisp.apply()' function call in QML will call this function. The variable *CALLER* will be bound to the calling QQuickItem, if passed with 'this' as first argument to 'Lisp.call()' / 'Lisp.apply()'." - (let* ((*caller* (if (qnull caller) *caller* (qt-object-? caller))) - (object (apply (string-to-symbol function) - arguments))) - (if (stringp object) - object - (print-to-js-string object)))) - -;;; utils - -(defun root-item () - (when *quick-view* - (if (= (qt-object-id *quick-view*) #.(qid "QQmlApplicationEngine")) - (let ((object (first (|rootObjects| *quick-view*)))) - (setf (qt-object-id object) #.(qid "QObject")) ; unknown to EQL, so resort to QObject - object) - (qt-object-? (|rootObject| *quick-view*))))) - -(defun root-context () - (when *quick-view* - (|rootContext| *quick-view*))) - -(defun find-quick-item (object-name) - "Finds the first QQuickItem matching OBJECT-NAME." - (let ((root (root-item))) - (unless (qnull root) - (if (string= (|objectName| root) object-name) - (root-item) - (qt-object-? (qfind-child root object-name)))))) - -(defun quick-item (item/name) - (cond ((stringp item/name) - (find-quick-item item/name)) - ((qt-object-p item/name) - item/name) - ((not item/name) - (root-item)))) - -(defun children (item/name) - "Like QML function 'children'." - (mapcar 'qt-object-? (|childItems| (quick-item item/name)))) - -(defun scale () - "Returns the scale factor used on high dpi scaled devices (e.g. phones)." - (|effectiveDevicePixelRatio| *quick-view*)) - -(defun reload () - "Force reloading of QML file after changes made to it." - (|clearComponentCache| (|engine| *quick-view*)) - (|setSource| *quick-view* (|source| *quick-view*))) - -;;; call QML methods - -(defun qml-call (item/name method-name &rest arguments) - ;; QFUN+ comes in handy here - (apply 'qfun+ (quick-item item/name) method-name arguments)) - -;;; get/set QQmlProperty - -(defun qml-get (item/name property-name) - "Gets QQmlProperty of either ITEM or first object matching NAME." - (qlet ((property "QQmlProperty(QObject*,QString)" - (quick-item item/name) - property-name)) - (if (|isValid| property) - (qlet ((variant (|read| property))) - (values (qvariant-value variant) - t)) - (eql::%error-msg "QML-GET" (list item/name property-name))))) - -(defun qml-set (item/name property-name value &optional update) - "Sets QQmlProperty of either ITEM, or first object matching NAME. Returns T on success. If UPDATE is not NIL and ITEM is a QQuickPaintedItem, |update| will be called on it." - (let ((item (quick-item item/name))) - (qlet ((property "QQmlProperty(QObject*,QString)" item property-name)) - (if (|isValid| property) - (let ((type-name (|propertyTypeName| property))) - (qlet ((variant (qvariant-from-value value (if (find #\: type-name) "int" type-name)))) - (prog1 - (|write| property variant) - (when (and update (= (qt-object-id item) (qid "QQuickPaintedItem"))) - (|update| item))))) - (eql::%error-msg "QML-SET" (list item/name property-name value)))))) - -(defun qml-set-all (name property-name value &optional update) - "Sets QQmlProperty of all objects matching NAME." - (assert (stringp name)) - (dolist (item (qfind-children (root-item) name)) - (qml-set item property-name value update))) - -(defmacro q! (method-name item/name &rest arguments) - "Convenience macro for QML-CALL. Use symbol instead of string name." - `(qml-call ,item/name ,(symbol-name method-name) ,@arguments)) - -(defmacro q> (property-name item/name value &optional update) - "Convenience macro for QML-SET. Use symbol instead of string name." - `(qml-set ,item/name ,(symbol-name property-name) ,value ,update)) - -(defmacro q< (property-name item/name) - "Convenience macro for QML-GET. Use symbol instead of string name." - `(qml-get ,item/name ,(symbol-name property-name))) - -(defmacro q>* (property-name item/name value &optional update) - "Convenience macro for QML-SET-ALL. Use symbol instead of string name." - `(qml-set-all ,item/name ,(symbol-name property-name) ,value ,update)) - -;;; JS - -(defun js (item/name js-format-string &rest arguments) - "Evaluates a JS string, with 'this' bound to either ITEM, or first object matching NAME. Arguments are passed through FORMAT. Use this function instead of the (faster) QJS if you need to evaluate generic JS code." - (qlet ((qml-exp "QQmlExpression(QQmlContext*,QObject*,QString)" - (root-context) - (quick-item item/name) - (apply 'format nil js-format-string arguments)) - (variant (|evaluate| qml-exp))) - (qvariant-value variant))) - -(defun js-arg (object) - "To be used for arguments in function JS." - (with-output-to-string (*standard-output*) - (print-js-readably object))) - -(defun %qjs (item/name function-name &rest arguments) - ;; QJS-CALL is defined in EQL5, function 'ecl_fun.cpp' - (eql::qjs-call (quick-item item/name) function-name arguments)) - -(defmacro qjs (function-name item/name &rest arguments) - "Fast and direct JS calls; max 10 arguments of type: T, NIL, INTEGER, FLOAT, STRING, (nested) LIST of mentioned types. - Examples: - (qjs |drawLine| *canvas* 0 0 100.0 100.0) - (qjs |drawPath| *canvas* (list (list 0 0) (list 0 10.0) (list 10.0 10.0)))" - `(%qjs ,item/name ,(symbol-name function-name) ,@arguments)) - - diff --git a/examples/M-modules/quick/table-view/table-view.lisp b/examples/M-modules/quick/table-view/table-view.lisp index 4102f84..fa74bd3 100644 --- a/examples/M-modules/quick/table-view/table-view.lisp +++ b/examples/M-modules/quick/table-view/table-view.lisp @@ -5,7 +5,6 @@ (qrequire :quick) -(require :qml-lisp "qml-lisp") (require :properties "properties") (defpackage :table-view diff --git a/src/ecl_fun.cpp b/src/ecl_fun.cpp index 2e8c40b..b897396 100644 --- a/src/ecl_fun.cpp +++ b/src/ecl_fun.cpp @@ -8,6 +8,7 @@ #include "single_shot.h" #include "module_interface.h" #include +#include #ifdef STATIC_MODULES #include "gen/help/_ini.h" @@ -121,7 +122,7 @@ META_TYPE (T_WId, WId) void iniCLFunctions() { cl_object eql(STRING("EQL")); - if(cl_find_package(eql) == Cnil) { + if(cl_find_package(eql) == ECL_NIL) { cl_make_package(1, eql); } si_select_package(eql); DEFUN ("%error-msg", error_msg2, 2) @@ -150,6 +151,8 @@ void iniCLFunctions() { DEFUN ("qload-ui", qload_ui, 1) DEFUN ("qlocal8bit", qlocal8bit, 1) DEFUN ("%qlog", qlog2, 1) + DEFUN ("%qml-get", qml_get2, 2) + DEFUN ("%qml-set", qml_set2, 3) DEFUN ("%qnew-instance", qnew_instance2, 2) DEFUN ("%qobject-names", qobject_names2, 1) DEFUN ("qok", qok, 0) @@ -216,7 +219,7 @@ static void type_msg(const QByteArray& wanted, const QByteArray& got) { void error_msg(const char* fun, cl_object l_args) { STATIC_SYMBOL_PKG (s_break_on_errors, "*BREAK-ON-ERRORS*", "EQL") - if(cl_symbol_value(s_break_on_errors) != Cnil) { + if(cl_symbol_value(s_break_on_errors) != ECL_NIL) { STATIC_SYMBOL_PKG (s_break, "%BREAK", "EQL") // see "lisp/ini.lisp" cl_funcall(4, s_break, @@ -232,9 +235,8 @@ void error_msg(const char* fun, cl_object l_args) { l_args); }} cl_object error_msg2(cl_object l_fun, cl_object l_args) { // to be called from Lisp (see "lisp/ini.lisp") - ecl_process_env()->nvalues = 1; error_msg(toCString(l_fun), l_args); - return Cnil; } + ecl_return1(ecl_process_env(), ECL_NIL); } static const QMetaObject* staticMetaObject(const QtObject& qt) { return LObjects::staticMetaObject(QByteArray(), qt.id); } @@ -369,7 +371,7 @@ static cl_object make_vector() { template static T toInt(cl_object l_num) { T i = 0; - if(cl_integerp(l_num) == Ct) { + if(cl_integerp(l_num) == ECL_T) { i = fixint(l_num); } return i; } @@ -379,7 +381,7 @@ static int toInt(cl_object l_num) { template static T toUInt(cl_object l_num) { T i = 0; - if(cl_integerp(l_num) == Ct) { + if(cl_integerp(l_num) == ECL_T) { i = fixnnint(l_num); } return i; } @@ -397,7 +399,7 @@ static T toFloat(cl_object l_num) { else if(ECL_LONG_FLOAT_P(l_num)) { f = ecl_long_float(l_num); } #endif - else if(cl_integerp(l_num) == Ct) { + else if(cl_integerp(l_num) == ECL_T) { f = fixint(l_num); } else { cl_object l_f = cl_float(1, l_num); @@ -420,13 +422,13 @@ static qreal toReal(cl_object l_num) { static char toChar(cl_object l_ch) { char ch = 0; - if(CHARACTERP(l_ch)) { + if(ECL_CHARACTERP(l_ch)) { ch = toInt(cl_char_code(l_ch)); } return ch; } static QChar toQChar(cl_object l_ch) { QChar ch; - if(CHARACTERP(l_ch)) { + if(ECL_CHARACTERP(l_ch)) { ch = QChar(toInt(cl_char_code(l_ch))); } return ch; } @@ -639,30 +641,30 @@ static QByteArray qtObjectName(cl_object l_obj, const QByteArray& type = QByteAr STATIC_SYMBOL_PKG (s_qt_object_id, "QT-OBJECT-ID", "EQL") // 'primitives' first QByteArray name; - if(cl_integerp(l_obj) == Ct) { + if(cl_integerp(l_obj) == ECL_T) { name = "int"; } - else if(cl_characterp(l_obj) == Ct) { + else if(cl_characterp(l_obj) == ECL_T) { name = "QChar"; } - else if(cl_stringp(l_obj) == Ct) { + else if(cl_stringp(l_obj) == ECL_T) { name = "QString QColor"; } - else if(cl_listp(l_obj) == Ct) { + else if(cl_listp(l_obj) == ECL_T) { int l = LEN(l_obj); switch(l) { case 0: break; case 2: name = "QPointF QSizeF QList"; break; case 4: name = "QRectF QLineF QList"; break; default: name = "QPolygonF QList"; }} - else if(cl_vectorp(l_obj) == Ct) { + else if(cl_vectorp(l_obj) == ECL_T) { name = "QVector"; } else { // qt-object // (this is carefully optimized, in a probably non-obvious way, because THE-QT-OBJECT is really slow) if(type.isNull() || LObjects::q_names.contains(type) || LObjects::n_names.contains(type)) { - l_obj = cl_funcall(3, s_ensure_qt_object, l_obj, Ct); } - if(cl_funcall(2, s_qt_object_p, l_obj) == Ct) { + l_obj = cl_funcall(3, s_ensure_qt_object, l_obj, ECL_T); } + if(cl_funcall(2, s_qt_object_p, l_obj) == ECL_T) { name = QtObject::idToClassName(toInt(cl_funcall(2, s_qt_object_id, l_obj))); } // special case - else if((cl_functionp(l_obj) == Ct) || (cl_symbolp(l_obj) == Ct)) { + else if((cl_functionp(l_obj) == ECL_T) || (cl_symbolp(l_obj) == ECL_T)) { name = "FunctorOrLambda"; }} return name; } @@ -676,14 +678,14 @@ QtObject toQtObject(cl_object l_obj, cl_object l_cast, bool* qobject_align, bool o.id = classId(l_obj); } else { if(quiet) { - l_obj = cl_funcall(3, s_ensure_qt_object, l_obj, Ct); } + l_obj = cl_funcall(3, s_ensure_qt_object, l_obj, ECL_T); } else { l_obj = cl_funcall(2, s_ensure_qt_object, l_obj); } - if(l_obj != Cnil) { + if(l_obj != ECL_NIL) { o.pointer = (void*)fixnnint(cl_funcall(2, s_qt_object_pointer, l_obj)); o.unique = fixnnint(cl_funcall(2, s_qt_object_unique, l_obj)); o.id = toInt(cl_funcall(2, s_qt_object_id, l_obj)); - if(l_cast != Cnil) { + if(l_cast != ECL_NIL) { int id_orig = o.id; o.id = classId(l_cast); if((id_orig > 0) && (o.id < 0)) { @@ -696,8 +698,8 @@ static cl_object new_qt_object(void* pointer, uint unique, int id, bool finalize s_new_qt_object, ecl_make_unsigned_integer((quintptr)pointer), ecl_make_unsigned_integer(unique), - MAKE_FIXNUM(id), - finalize ? Ct : Cnil); + ecl_make_fixnum(id), + finalize ? ECL_T : ECL_NIL); return l_qt_object; } cl_object qt_object_from_name(const QByteArray& name, void* pointer, uint unique, bool finalize) { @@ -716,7 +718,7 @@ cl_object qt_object_from_name(const QByteArray& name, void* pointer, uint unique static QString symbolName(cl_object l_symbol) { QString name; - if((cl_symbolp(l_symbol) == Ct)) { + if((cl_symbolp(l_symbol) == ECL_T)) { name = toQString(cl_symbol_name(l_symbol)).toLower(); } else if(ECL_STRINGP(l_symbol)) { name = toQString(l_symbol); } @@ -724,27 +726,27 @@ static QString symbolName(cl_object l_symbol) { static QStringList toQStringList(cl_object l_list) { QStringList l; - if(LISTP(l_list)) { + if(ECL_LISTP(l_list)) { cl_object l_el = l_list; - while(l_el != Cnil) { + while(l_el != ECL_NIL) { l << toQString(cl_car(l_el)); l_el = cl_cdr(l_el); }} return l; } static QPolygon toQPolygon(cl_object l_list) { QPolygon p; - if(LISTP(l_list)) { + if(ECL_LISTP(l_list)) { cl_object l_el = l_list; - while(l_el != Cnil) { + while(l_el != ECL_NIL) { p << QPoint(toInt(cl_first(l_el)), toInt(cl_second(l_el))); l_el = cl_cddr(l_el); }} return p; } static QPolygonF toQPolygonF(cl_object l_list) { QPolygonF p; - if(LISTP(l_list)) { + if(ECL_LISTP(l_list)) { cl_object l_el = l_list; - while(l_el != Cnil) { + while(l_el != ECL_NIL) { p << QPointF(toReal(cl_first(l_el)), toReal(cl_second(l_el))); l_el = cl_cddr(l_el); }} return p; } @@ -773,9 +775,9 @@ static QGradientStop toQGradientStop(cl_object l_gs) { static QList toQTextEditExtraSelectionList(cl_object l_list) { QList l; - if(LISTP(l_list)) { + if(ECL_LISTP(l_list)) { cl_object l_el = l_list; - while(l_el != Cnil) { + while(l_el != ECL_NIL) { cl_object l_curr = cl_first(l_el); QtObject q_cursor = toQtObject(cl_first(l_curr)); QtObject q_format = toQtObject(cl_second(l_curr)); @@ -790,9 +792,9 @@ static QList toQTextEditExtraSelectionList(cl_object static QHashIntQByteArray toQHashIntQByteArray(cl_object l_alist) { QHash hash; - if(LISTP(l_alist)) { + if(ECL_LISTP(l_alist)) { cl_object l_el = l_alist; - while(l_el != Cnil) { + while(l_el != ECL_NIL) { cl_object l_curr = cl_first(l_el); int i = toInt(cl_car(l_curr)); QByteArray ba(toCString(cl_cdr(l_curr))); @@ -904,7 +906,7 @@ QVariant toQVariant(cl_object l_obj, const char* s_type, int type, bool* ok) { *ok = false; return var; } switch(type) { - case QVariant::Bool: var = (l_obj != Cnil); break; + case QVariant::Bool: var = (l_obj != ECL_NIL); break; case QVariant::Brush: var = toQBrush(l_obj); break; case QVariant::ByteArray: var = toQByteArray(l_obj); break; case QVariant::Char: var = toQChar(l_obj); break; @@ -954,51 +956,27 @@ QVariant toQVariant(cl_object l_obj, const char* s_type, int type, bool* ok) { static QVariantList toQVariantList(cl_object l_list) { QVariantList l; - if(LISTP(l_list)) { + if(ECL_LISTP(l_list)) { cl_object l_el = l_list; - while(l_el != Cnil) { + while(l_el != ECL_NIL) { QtObject q_var = toQtObject(cl_car(l_el)); if("QVariant" == q_var.className()) { l << *(QVariant*)q_var.pointer; } l_el = cl_cdr(l_el); }} return l; } -static QVariantList lispToQVariantList(cl_object l_list) { - // converts (nested) Lisp lists to (nested) QVariant lists - QVariantList l; - if(LISTP(l_list)) { - cl_object l_do_list = l_list; - while(l_do_list != Cnil) { - cl_object l_el = cl_car(l_do_list); - if(cl_integerp(l_el) == ECL_T) { // int - l << QVariant(toInt(l_el)); } - else if(cl_floatp(l_el) == ECL_T) { // double - l << QVariant(toFloat(l_el)); } - else if(cl_stringp(l_el) == ECL_T) { // string - l << QVariant(toQString(l_el)); } - else if(l_el == ECL_T) { // true - l << QVariant(true); } - else if(l_el == ECL_NIL) { // false - l << QVariant(false); } - else if(LISTP(l_el)) { // list - l << QVariant::fromValue(lispToQVariantList(l_el)); } - else { // default: undefined - l << QVariant(); } - l_do_list = cl_cdr(l_do_list); }} - return l; } - static cl_object from_char(char ch) { - cl_object l_char = cl_code_char(MAKE_FIXNUM((int)ch)); + cl_object l_char = cl_code_char(ecl_make_fixnum((int)ch)); return l_char; } static cl_object from_qchar(const QChar& ch) { - cl_object l_char = cl_code_char(MAKE_FIXNUM(ch.unicode())); + cl_object l_char = cl_code_char(ecl_make_fixnum(ch.unicode())); return l_char; } static cl_object from_qbytearray(const QByteArray& ba) { cl_object l_vec = make_vector(); for(int i = 0; i < ba.size(); ++i) { - cl_vector_push_extend(2, MAKE_FIXNUM(ba.at(i)), l_vec); } + cl_vector_push_extend(2, ecl_make_fixnum(ba.at(i)), l_vec); } return l_vec; } static cl_object from_qstring(const QString& s) { @@ -1009,28 +987,28 @@ static cl_object from_qstring(const QString& s) { return l_s; } static cl_object from_qstringlist(const QStringList& l) { - cl_object l_list = Cnil; + cl_object l_list = ECL_NIL; Q_FOREACH(QString s, l) { l_list = CONS(from_qstring(s), l_list); } l_list = cl_nreverse(l_list); return l_list; } static cl_object from_intlist(const QList& l) { - cl_object l_list = Cnil; + cl_object l_list = ECL_NIL; Q_FOREACH(int i, l) { l_list = CONS(ecl_make_integer(i), l_list); } l_list = cl_nreverse(l_list); return l_list; } static cl_object from_qreallist(const QList& l) { - cl_object l_list = Cnil; + cl_object l_list = ECL_NIL; Q_FOREACH(qreal r, l) { l_list = CONS(ecl_make_doublefloat(r), l_list); } l_list = cl_nreverse(l_list); return l_list; } static cl_object from_qcolor(const QColor& col) { - cl_object l_ret = Cnil; + cl_object l_ret = ECL_NIL; if(col.isValid()) { // return NIL for invalid QColors if(EQL::return_value_p) { l_ret = qt_object_from_name("QColor", new QColor(col), 0, true); } // GC @@ -1039,7 +1017,7 @@ static cl_object from_qcolor(const QColor& col) { return l_ret; } static cl_object from_qpolygon(const QPolygon& p) { - cl_object l_list = Cnil; + cl_object l_list = ECL_NIL; for(int i = 0; i < p.size(); ++i) { int x, y; p.point(i, &x, &y); @@ -1048,7 +1026,7 @@ static cl_object from_qpolygon(const QPolygon& p) { return l_list; } static cl_object from_qpolygonf(const QPolygonF& pol) { - cl_object l_list = Cnil; + cl_object l_list = ECL_NIL; for(int i = 0; i < pol.size(); ++i) { QPointF p = pol.at(i); l_list = CONS(ecl_make_doublefloat(p.y()), CONS(ecl_make_doublefloat(p.x()), l_list)); } @@ -1060,7 +1038,7 @@ static cl_object from_qgradientstop(const QGradientStop& gs) { return l_gs; } static cl_object from_qwidgetlist(const QWidgetList& wl) { - cl_object l_list = Cnil; + cl_object l_list = ECL_NIL; Q_FOREACH(QWidget* w, wl) { l_list = CONS(qt_object_from_name(w->metaObject()->className(), w, @@ -1070,7 +1048,7 @@ static cl_object from_qwidgetlist(const QWidgetList& wl) { return l_list; } static cl_object from_qobjectlist(const QObjectList& ol) { - cl_object l_list = Cnil; + cl_object l_list = ECL_NIL; Q_FOREACH(QObject* o, ol) { l_list = CONS(qt_object_from_name(o->metaObject()->className(), o, @@ -1080,7 +1058,7 @@ static cl_object from_qobjectlist(const QObjectList& ol) { return l_list; } static cl_object from_qtexteditextraselectionlist(const QList& list) { - cl_object l_list = Cnil; + cl_object l_list = ECL_NIL; Q_FOREACH(QTextEdit::ExtraSelection sel, list) { l_list = CONS(LIST2(qt_object_from_name("QTextCursor", new QTextCursor(sel.cursor)), qt_object_from_name("QTextCharFormat", new QTextCharFormat(sel.format))), @@ -1089,7 +1067,7 @@ static cl_object from_qtexteditextraselectionlist(const QList it(hash); while(it.hasNext()) { it.next(); @@ -1149,10 +1127,10 @@ TO_CL_VECTOR_VAL2 (int, int, ecl_make_integer) TO_CL_VECTOR_VAL2 (qreal, qreal, ecl_make_doublefloat) static cl_object from_qvariant_value(const QVariant& var) { - cl_object l_obj = Cnil; + cl_object l_obj = ECL_NIL; int type = var.type(); switch(type) { - case QVariant::Bool: l_obj = var.toBool() ? Ct : Cnil; break; + case QVariant::Bool: l_obj = var.toBool() ? ECL_T : ECL_NIL; break; case QVariant::Brush: l_obj = from_qbrush(var.value()); break; case QVariant::ByteArray: l_obj = from_qbytearray(var.toByteArray()); break; case QVariant::Char: l_obj = from_qchar(var.toChar()); break; @@ -1199,7 +1177,7 @@ static cl_object from_qvariant_value(const QVariant& var) { return l_obj; } static cl_object from_qvariantlist(const QVariantList& l) { - cl_object l_list = Cnil; + cl_object l_list = ECL_NIL; Q_FOREACH(QVariant v, l) { l_list = CONS(from_qvariant_value(v), l_list); } l_list = cl_nreverse(l_list); @@ -1208,7 +1186,7 @@ static cl_object from_qvariantlist(const QVariantList& l) { static void* ensurePersistentFunction(cl_object l_fun) { STATIC_SYMBOL_PKG (s_ensure_persistent_function, "%ENSURE-PERSISTENT-FUNCTION", "EQL") // see "lisp/ini.lisp" cl_object l_ret = cl_funcall(2, s_ensure_persistent_function, l_fun); - return (Cnil == l_ret) ? 0 : (void*)l_ret; } + return (ECL_NIL == l_ret) ? 0 : (void*)l_ret; } void FunctorOrLambda::operator()(const QVariant& var) { if(function) { @@ -1218,7 +1196,7 @@ static MetaArg toMetaArg(const QByteArray& sType, cl_object l_arg) { void* p = 0; const int n = QMetaType::type(sType); switch(n) { - case QMetaType::Bool: p = new bool(l_arg != Cnil); break; + case QMetaType::Bool: p = new bool(l_arg != ECL_NIL); break; case QMetaType::Char: p = new char(toChar(l_arg)); break; case QMetaType::Double: p = new double(toFloat(l_arg)); break; case QMetaType::Float: p = new float(toFloat(l_arg)); break; @@ -1396,20 +1374,20 @@ static MetaArg toMetaArg(const QByteArray& sType, cl_object l_arg) { return MetaArg(sType, p); } cl_object to_lisp_arg(const MetaArg& arg) { - cl_object l_ret = Cnil; + cl_object l_ret = ECL_NIL; void* p = arg.second; if(p) { QByteArray sType(arg.first); const int n = QMetaType::type(sType); switch(n) { - case QMetaType::Bool: l_ret = *(bool*)p ? Ct : Cnil; break; + case QMetaType::Bool: l_ret = *(bool*)p ? ECL_T : ECL_NIL; break; case QMetaType::Char: l_ret = from_char(*(char*)p); break; case QMetaType::Double: l_ret = ecl_make_doublefloat(*(double*)p); break; case QMetaType::Float: l_ret = ecl_make_singlefloat(*(float*)p); break; case QMetaType::Int: l_ret = ecl_make_integer(*(int*)p); break; case QMetaType::Long: l_ret = ecl_make_integer(*(long*)p); break; case QMetaType::LongLong: l_ret = ecl_make_integer(*(qlonglong*)p); break; - case QMetaType::UChar: l_ret = MAKE_FIXNUM(*(uchar*)p); break; + case QMetaType::UChar: l_ret = ecl_make_fixnum(*(uchar*)p); break; case QMetaType::UInt: l_ret = ecl_make_unsigned_integer(*(uint*)p); break; case QMetaType::ULong: l_ret = ecl_make_unsigned_integer(*(ulong*)p); break; case QMetaType::ULongLong: l_ret = ecl_make_unsigned_integer(*(qulonglong*)p); break; @@ -1455,7 +1433,7 @@ cl_object to_lisp_arg(const MetaArg& arg) { case QMetaType::QVariantList: l_ret = from_qvariantlist(*(QVariantList*)p); break; default: if(T_bool_ok_pointer == n) { - l_ret = _ok_ ? Ct : Cnil; } + l_ret = _ok_ ? ECL_T : ECL_NIL; } else if(sType.endsWith('*')) { if(sType.startsWith('Q') || sType.startsWith("const Q")) { l_ret = qt_object_from_name(sType, *(void**)p); } @@ -1691,7 +1669,7 @@ static bool metaInfoLessThan(const QByteArray& s1, const QByteArray& s2) { static cl_object collect_info(const QByteArray& type, const QByteArray& qclass, const QByteArray& qsearch, bool non, bool* found, const QMetaObject* mo, bool no_offset = false) { - cl_object l_info = Cnil; + cl_object l_info = ECL_NIL; StrList info = metaInfo(type, qclass, qsearch, non, mo, no_offset); qSort(info.begin(), info.end(), metaInfoLessThan); if(info.size()) { @@ -1713,18 +1691,18 @@ cl_object qapropos2(cl_object l_search, cl_object l_class, cl_object l_type, cl_ QByteArray search; if(ECL_STRINGP(l_search)) { search = toCString(l_search); } - bool all = (Cnil == l_type); - bool q = all ? false : (Ct == cl_eql(q_keyword(), l_type)); - bool no_offset = (l_no_offset != Cnil); // for QML (all instance properties) + bool all = (ECL_NIL == l_type); + bool q = all ? false : (ECL_T == cl_eql(q_keyword(), l_type)); + bool no_offset = (l_no_offset != ECL_NIL); // for QML (all instance properties) StrList classes; bool qt_eql = false; const QMetaObject* mo = 0; if(ECL_STRINGP(l_class)) { if(!classId(l_class)) { error_msg("QAPROPOS: class not found:", LIST1(l_class)); - return Cnil; } + return ECL_NIL; } classes << toCString(l_class); } - else if(Cnil == l_class) { + else if(ECL_NIL == l_class) { if(all) { classes << LObjects::qNames; classes << LObjects::nNames; @@ -1741,15 +1719,15 @@ cl_object qapropos2(cl_object l_search, cl_object l_class, cl_object l_type, cl_ .arg(mo->className()) .arg(QString(obj.className())) .toLatin1(); }}} - cl_object l_docs = Cnil; + cl_object l_docs = ECL_NIL; Q_FOREACH(QByteArray cl, classes) { bool found = false; bool non = LObjects::n_names.contains(cl); if(non || qt_eql || LObjects::q_names.contains(cl)) { - cl_object l_doc_pro = Cnil; - cl_object l_doc_slo = Cnil; - cl_object l_doc_sig = Cnil; - cl_object l_doc_ovr = Cnil; + cl_object l_doc_pro = ECL_NIL; + cl_object l_doc_slo = ECL_NIL; + cl_object l_doc_sig = ECL_NIL; + cl_object l_doc_ovr = ECL_NIL; if(!non) { l_doc_pro = collect_info("properties", cl, search, non, &found, mo, no_offset); } cl_object l_doc_met = collect_info("methods", cl, search, non, &found, mo); @@ -1758,19 +1736,19 @@ cl_object qapropos2(cl_object l_search, cl_object l_class, cl_object l_type, cl_ l_doc_sig = collect_info("signals", cl, search, non, &found, mo); } l_doc_ovr = collect_info("override", cl, search, non, &found, mo); if(found) { - cl_object l_doc = Cnil; - if(l_doc_pro != Cnil) { + cl_object l_doc = ECL_NIL; + if(l_doc_pro != ECL_NIL) { l_doc = CONS(CONS(STRING("Properties:"), l_doc_pro), l_doc); } - if(l_doc_met != Cnil) { + if(l_doc_met != ECL_NIL) { l_doc = CONS(CONS(STRING("Methods:"), l_doc_met), l_doc); } - if(l_doc_slo != Cnil) { + if(l_doc_slo != ECL_NIL) { l_doc = CONS(CONS(STRING("Slots:"), l_doc_slo), l_doc); } - if(l_doc_sig != Cnil) { + if(l_doc_sig != ECL_NIL) { l_doc = CONS(CONS(STRING("Signals:"), l_doc_sig), l_doc); } - if((l_doc_ovr != Cnil) && !qt_eql) { + if((l_doc_ovr != ECL_NIL) && !qt_eql) { l_doc = CONS(CONS(STRING("Override:"), l_doc_ovr), l_doc); } l_doc = cl_nreverse(l_doc); - if(l_doc != Cnil) { + if(l_doc != ECL_NIL) { l_docs = CONS(CONS(STRING_COPY(cl.data()), l_doc), l_docs); }}}} cl_object l_ret = cl_nreverse(l_docs); return l_ret; } @@ -1826,7 +1804,7 @@ cl_object qnew_instance2(cl_object l_name, cl_object l_args) { MetaArgList mArgs; cl_object l_do_args = l_args; if(p != -1) { - for(int i = 0; (i < (types.length() - 1)) && (i < MAX_ARGS) && (l_do_args != Cnil); ++i) { + for(int i = 0; (i < (types.length() - 1)) && (i < MAX_ARGS) && (l_do_args != ECL_NIL); ++i) { MetaArg m_arg(toMetaArg(types.at(i + 1), cl_car(l_do_args))); args[i + 2] = m_arg.second; mArgs << m_arg; @@ -1839,12 +1817,12 @@ cl_object qnew_instance2(cl_object l_name, cl_object l_args) { QObject* obj = (QObject*)pointer; if(obj->isWidgetType()) { obj->setProperty("EQL.unique", unique); } - while(l_do_args != Cnil) { + while(l_do_args != ECL_NIL) { qset_property(l_ret, cl_first(l_do_args), cl_second(l_do_args)); l_do_args = cl_cddr(l_do_args); }} return l_ret; }}}}}} error_msg("QNEW-INSTANCE", LIST2(l_name, l_args)); - return Cnil; } + return ECL_NIL; } cl_object qcopy(cl_object l_obj) { /// args: (object) @@ -1870,12 +1848,11 @@ cl_object qcopy(cl_object l_obj) { cl_object l_ret = new_qt_object(pointer, unique, o.id); return l_ret; }}}} error_msg("QCOPY", LIST1(l_obj)); - return Cnil; } + return ECL_NIL; } cl_object qset_gc(cl_object l_obj) { - ecl_process_env()->nvalues = 1; - _garbage_collection_ = (l_obj != Cnil); - return l_obj; } + _garbage_collection_ = (l_obj != ECL_NIL); + ecl_return1(ecl_process_env(), l_obj); } enum { GarbageCollection = 1 }; @@ -1890,7 +1867,7 @@ cl_object qdelete2(cl_object l_obj, cl_object l_later) { if(o.pointer) { bool ok = false; STATIC_SYMBOL_PKG (s_qt_object_finalize, "QT-OBJECT-FINALIZE", "EQL") - if(cl_funcall(2, s_qt_object_finalize, l_obj) != Cnil) { + if(cl_funcall(2, s_qt_object_finalize, l_obj) != ECL_NIL) { if(_garbage_collection_) { if(o.isQObject()) { QObject* obj = (QObject*)o.pointer; @@ -1899,11 +1876,11 @@ cl_object qdelete2(cl_object l_obj, cl_object l_later) { LObjects::deleteNObject(-o.id, o.pointer, GarbageCollection); } ok = true; } else { - return Cnil; }} + return ECL_NIL; }} else { if(o.isQObject()) { QObject* obj = (QObject*)o.pointer; - if(Cnil == l_later) { + if(ECL_NIL == l_later) { delete obj; } else { obj->deleteLater(); }} @@ -1912,10 +1889,10 @@ cl_object qdelete2(cl_object l_obj, cl_object l_later) { ok = true; } if(ok) { STATIC_SYMBOL_PKG (s_qset_null, "QSET-NULL", "EQL") - cl_funcall(3, s_qset_null, l_obj, Cnil); - return Ct; }} + cl_funcall(3, s_qset_null, l_obj, ECL_NIL); + return ECL_T; }} // no error message (unintentional multiple deletion) - return Cnil; } + return ECL_NIL; } cl_object qproperty(cl_object l_obj, cl_object l_name) { /// args: (object name) @@ -1930,24 +1907,20 @@ cl_object qproperty(cl_object l_obj, cl_object l_name) { if(n != -1) { QMetaProperty mp(mo->property(n)); QVariant var(mp.read((QObject*)o.pointer)); - const cl_env_ptr l_env = ecl_process_env(); - l_env->nvalues = 2; bool return_value_p = EQL::return_value_p; EQL::return_value_p = true; - l_env->values[0] = from_qvariant_value(var); + cl_object l_ret1 = from_qvariant_value(var); EQL::return_value_p = return_value_p; - l_env->values[1] = Ct; - return l_env->values[0]; }}} + ecl_return2(ecl_process_env(), l_ret1, ECL_T); }}} ecl_process_env()->nvalues = 1; error_msg("QPROPERTY", LIST2(l_obj, l_name)); - return Cnil; } + ecl_return1(ecl_process_env(), ECL_NIL); } cl_object qset_property(cl_object l_obj, cl_object l_name, cl_object l_val) { /// args: (object name value) /// alias: qset /// Sets a Qt property. Enumerators have to be passed as int values.
Returns T as second return value for successful calls. /// (qset label "alignment" |Qt.AlignCenter|) - ecl_process_env()->nvalues = 1; QtObject o = toQtObject(l_obj); if(ECL_STRINGP(l_name)) { if(o.isQObject() && o.pointer) { @@ -1961,13 +1934,9 @@ cl_object qset_property(cl_object l_obj, cl_object l_name, cl_object l_val) { else { var = toQVariant(l_val, mp.typeName()); } if(mp.write((QObject*)o.pointer, var)) { - const cl_env_ptr l_env = ecl_process_env(); - l_env->nvalues = 2; - l_env->values[0] = l_val; - l_env->values[1] = Ct; - return l_env->values[0]; }}}} + ecl_return2(ecl_process_env(), l_val, ECL_T); }}}} error_msg("QSET-PROPERTY", LIST3(l_obj, l_name, l_val)); - return Cnil; } + ecl_return1(ecl_process_env(), ECL_NIL); } cl_object qvariant_value(cl_object l_obj) { /// args: (object) @@ -1982,7 +1951,7 @@ cl_object qvariant_value(cl_object l_obj) { EQL::return_value_p = return_value_p; return l_ret; } error_msg("QVARIANT-VALUE", LIST1(l_obj)); - return Cnil; } + return ECL_NIL; } cl_object qvariant_from_value(cl_object l_val, cl_object l_type) { /// args: (value type-name) @@ -1995,14 +1964,14 @@ cl_object qvariant_from_value(cl_object l_val, cl_object l_type) { QVariant var(toQVariant(l_val, typeName, -1, &ok)); if(ok) { QVariant* p = new QVariant(var); - cl_object l_ret = Cnil; + cl_object l_ret = ECL_NIL; if(EQL::return_value_p) { l_ret = qt_object_from_name("QVariant", p, 0, true); } // GC else { l_ret = qt_object_from_name("QVariant", p); } return l_ret; }} error_msg("QVARIANT-FROM-VALUE", LIST2(l_val, l_type)); - return Cnil; } + return ECL_NIL; } cl_object qinvoke_method2(cl_object l_obj, cl_object l_cast, cl_object l_name, cl_object l_args) { /// args: (object function-name &rest arguments) @@ -2025,16 +1994,16 @@ cl_object qinvoke_method2(cl_object l_obj, cl_object l_cast, cl_object l_name, c /// (|valueChanged| slider 10) static QHash i_slot; static QHash i_method; - if((l_obj != Cnil) && ECL_STRINGP(l_name)) { + if((l_obj != ECL_NIL) && ECL_STRINGP(l_name)) { bool qobject_align = false; bool qt_eql = false; QByteArray castClass; - if(l_cast != Cnil) { + if(l_cast != ECL_NIL) { if(ECL_STRINGP(l_cast)) { castClass = toCString(l_cast); } else if(cl_eql(qt_keyword(), l_cast)) { qt_eql = true; }} - QtObject obj = toQtObject(l_obj, qt_eql ? Cnil : l_cast, &qobject_align); + QtObject obj = toQtObject(l_obj, qt_eql ? ECL_NIL : l_cast, &qobject_align); IntList method_i; if(obj.id) { QByteArray name(QMetaObject::normalizedSignature(toCString(l_name))); @@ -2144,7 +2113,7 @@ cl_object qinvoke_method2(cl_object l_obj, cl_object l_cast, cl_object l_name, c // in front of the list (auto-optimization of inner loops) int m1 = method_i.at(0); StrList types1(mo->method(m1).parameterTypes()); - while((l_do_args != Cnil) && (i < MAX_ARGS)) { + while((l_do_args != ECL_NIL) && (i < MAX_ARGS)) { ++i; QByteArray curr(types1.at(i)); if(curr.endsWith('*')) { @@ -2163,7 +2132,7 @@ ok1: i = i_start; l_do_args = l_args; IntList method_i_orig = method_i; - while((l_do_args != Cnil) && (i < MAX_ARGS)) { + while((l_do_args != ECL_NIL) && (i < MAX_ARGS)) { ++i; cl_object l_arg = cl_car(l_do_args); QByteArray typeName(qtObjectName(l_arg)); @@ -2202,12 +2171,12 @@ ok3: l_do_args = l_args; already_checked = i; i = i_start; - while((l_do_args != Cnil) && (i < MAX_ARGS)) { + while((l_do_args != ECL_NIL) && (i < MAX_ARGS)) { ++i; cl_object l_arg = cl_car(l_do_args); // type check if(_check_argument_types_ && (i > already_checked)) { - if((l_arg != Cnil) && + if((l_arg != ECL_NIL) && (types.at(i).startsWith('Q')) && !types.at(i).contains(':') && !types.at(i).endsWith('>')) { @@ -2237,23 +2206,18 @@ ok3: if(caller) { caller->qt_metacall(QMetaObject::InvokeMetaMethod, method_index, args); clearMetaArgList(mArgs); - cl_object l_ret = Cnil; + cl_object l_ret = ECL_NIL; if(ret.second) { bool return_value_p = EQL::return_value_p; EQL::return_value_p = true; l_ret = to_lisp_arg(ret); EQL::return_value_p = return_value_p; clearMetaArg(ret, true); } - const cl_env_ptr l_env = ecl_process_env(); - l_env->nvalues = 2; - l_env->values[0] = l_ret; - l_env->values[1] = Ct; - return l_env->values[0]; } + ecl_return2(ecl_process_env(), l_ret, ECL_T); } else { clearMetaArgList(mArgs); }}}}}} - ecl_process_env()->nvalues = 1; error_msg("QINVOKE-METHOD", LIST4(l_obj, l_cast, l_name, l_args)); - return Cnil; } + ecl_return1(ecl_process_env(), ECL_NIL); } cl_object qconnect2(cl_object l_caller, cl_object l_signal, cl_object l_receiver, cl_object l_slot) { /// args: (caller signal receiver/function &optional slot) @@ -2271,8 +2235,8 @@ cl_object qconnect2(cl_object l_caller, cl_object l_signal, cl_object l_receiver QByteArray slot(QMetaObject::normalizedSignature(toCString(l_slot))); if(QMetaObject::checkConnectArgs(signal, slot)) { if(QObject::connect((QObject*)o1.pointer, SIG + signal, (QObject*)o2.pointer, SLO + slot)) { - return Ct; }}}} - else if(Cnil == l_slot) { + return ECL_T; }}}} + else if(ECL_NIL == l_slot) { void* fun = ensurePersistentFunction(l_receiver); if(fun) { QObject* object = (QObject*)o1.pointer; @@ -2280,9 +2244,9 @@ cl_object qconnect2(cl_object l_caller, cl_object l_signal, cl_object l_receiver // when object gets deleted, remove all Lisp connections QObject::connect(object, QSIGNAL(destroyed(QObject*)), LObjects::eql, QSLOT(removeConnections(QObject*))); - return Ct; }}}}} + return ECL_T; }}}}} error_msg("QCONNECT", LIST4(l_caller, l_signal, l_receiver, l_slot)); - return Cnil; } + return ECL_NIL; } cl_object qdisconnect2(cl_object l_caller, cl_object l_signal, cl_object l_receiver, cl_object l_slot) { /// args: (caller &optional signal receiver/function slot) @@ -2294,7 +2258,7 @@ cl_object qdisconnect2(cl_object l_caller, cl_object l_signal, cl_object l_recei ecl_process_env()->nvalues = 1; QtObject o1 = toQtObject(l_caller); if(o1.isQObject() && o1.pointer) { - QtObject o2 = toQtObject(l_receiver, Cnil, 0, true); // quiet + QtObject o2 = toQtObject(l_receiver, ECL_NIL, 0, true); // quiet QByteArray signal(toCString(l_signal)); QByteArray slot(toCString(l_slot)); if(!signal.isEmpty()) { @@ -2304,7 +2268,7 @@ cl_object qdisconnect2(cl_object l_caller, cl_object l_signal, cl_object l_recei slot = QMetaObject::normalizedSignature(slot); slot.prepend(SLO); } bool disconnected = false; - bool null_receiver = (l_receiver == Cnil); + bool null_receiver = (l_receiver == ECL_NIL); if(null_receiver || o2.isQObject()) { if(QObject::disconnect((QObject*)o1.pointer, signal.isEmpty() ? 0: signal.constData(), @@ -2317,9 +2281,9 @@ cl_object qdisconnect2(cl_object l_caller, cl_object l_signal, cl_object l_recei LObjects::dynObject, l_receiver)) { disconnected = true; }} - return disconnected ? Ct : Cnil; } + return disconnected ? ECL_T : ECL_NIL; } error_msg("QDISCONNECT", LIST4(l_caller, l_signal, l_receiver, l_slot)); - return Cnil; } + return ECL_NIL; } cl_object qsender() { /// args: () @@ -2331,11 +2295,11 @@ cl_object qsender() { curr, curr->property("EQL.unique").toUInt()); return l_ret; } - error_msg("QSENDER", Cnil); - return Cnil; } + error_msg("QSENDER", ECL_NIL); + return ECL_NIL; } static cl_object call_lisp_fun(cl_object l_fun, cl_object l_args, quint64 override_id = 0) { - cl_object l_ret = Cnil; + cl_object l_ret = ECL_NIL; const cl_env_ptr l_env = ecl_process_env(); if(override_id) { LObjects::callingList.append(override_id); @@ -2353,7 +2317,7 @@ static cl_object call_lisp_fun(cl_object l_fun, cl_object l_args, quint64 overri void callConnectFun(void* fun, const StrList& types, void** args) { int i = 0; - cl_object l_args = Cnil; + cl_object l_args = ECL_NIL; Q_FOREACH(QByteArray type, types) { l_args = CONS(to_lisp_arg(MetaArg(type, args[++i])), l_args); } call_lisp_fun((cl_object)fun, cl_nreverse(l_args)); } @@ -2364,22 +2328,21 @@ cl_object qoverride(cl_object l_obj, cl_object l_name, cl_object l_fun) { /// (qoverride edit "keyPressEvent(QKeyEvent*)" (lambda (ev) (print (|key| ev)) (qcall-default))) ecl_process_env()->nvalues = 1; QtObject o = toQtObject(l_obj); - void* fun = (Cnil == l_fun) ? 0 : ensurePersistentFunction(l_fun); + void* fun = (ECL_NIL == l_fun) ? 0 : ensurePersistentFunction(l_fun); if(o.pointer) { QByteArray name(QMetaObject::normalizedSignature(toCString(l_name))); uint id = LObjects::override_function_ids.value(name, 0); if(id) { LObjects::setOverrideFun(LObjects::override_id(o.unique, id), fun); - return Ct; }} + return ECL_T; }} error_msg("QOVERRIDE", LIST3(l_obj, l_name, l_fun)); - return Cnil; } + return ECL_NIL; } cl_object qcall_default() { /// args: () /// To use anywhere inside an overridden function (see qoverride).
Calls the base implementation of the virtual Qt method after leaving the function body.

Optionally call the base implementation directly (if you want to do post-processing of the return value). - ecl_process_env()->nvalues = 1; LObjects::call_default = true; - return Ct; } + ecl_return1(ecl_process_env(), ECL_T); } QVariant callOverrideFun(void* fun, int id, const void** args, quint64 override_id) { STATIC_SYMBOL_PKG (s_qt_object_p, "QT-OBJECT-P", "EQL") @@ -2387,7 +2350,7 @@ QVariant callOverrideFun(void* fun, int id, const void** args, quint64 override_ int n = id - 1; int i = 0; const char* arg_type = 0; - cl_object l_args = Cnil; + cl_object l_args = ECL_NIL; while((arg_type = LObjects::override_arg_types[n][i + 1])) { l_args = CONS(to_lisp_arg(MetaArg(arg_type, (void*)args[i])), l_args); ++i; } @@ -2401,7 +2364,7 @@ QVariant callOverrideFun(void* fun, int id, const void** args, quint64 override_ if(ret_type) { QByteArray retType(ret_type); void* pointer = 0; - if(cl_funcall(2, s_qt_object_p, l_ret) == Ct) { + if(cl_funcall(2, s_qt_object_p, l_ret) == ECL_T) { pointer = (void*)fixnnint(cl_funcall(2, s_qt_object_pointer, l_ret)); } if(retType.startsWith('Q') && retType.endsWith('*')) { ret.setValue(pointer); } @@ -2429,7 +2392,7 @@ cl_object qadd_event_filter(cl_object l_obj, cl_object l_ev, cl_object l_fun) { void* fun = ensurePersistentFunction(l_fun); if(fun) { QObject* obj = 0; - if(l_obj != Cnil) { + if(l_obj != ECL_NIL) { QtObject o = toQtObject(l_obj); if(o.isQObject()) { obj = (QObject*)o.pointer; }} @@ -2437,16 +2400,16 @@ cl_object qadd_event_filter(cl_object l_obj, cl_object l_ev, cl_object l_fun) { cl_object l_id = ecl_make_integer(id); return l_id; } error_msg("QADD-EVENT-FILTER", LIST3(l_obj, l_ev, l_fun)); - return Cnil; } + return ECL_NIL; } cl_object qremove_event_filter(cl_object l_handle) { /// args: (handle) /// Removes the event filter corresponding to handle, which is the return value of qadd-event-filter.
Returns handle if the event filter has effectively been removed.
See also qclear-event-filters. ecl_process_env()->nvalues = 1; - if(cl_integerp(l_handle) == Ct) { - return LObjects::dynObject->removeEventFilter(toInt(l_handle)) ? l_handle : Cnil; } + if(cl_integerp(l_handle) == ECL_T) { + return LObjects::dynObject->removeEventFilter(toInt(l_handle)) ? l_handle : ECL_NIL; } error_msg("QREMOVE-EVENT-FILTER", LIST1(l_handle)); - return Cnil; } + return ECL_NIL; } bool callEventFun(void* fun, QObject* obj, QEvent* ev) { if(fun) { @@ -2455,15 +2418,14 @@ bool callEventFun(void* fun, QObject* obj, QEvent* ev) { return (call_lisp_fun((cl_object)fun, LIST2(qt_object_from_name(obj->metaObject()->className(), (void*)obj), qt_object_from_name(eventName(ev->type()), (void*)ev))) - != Cnil); } + != ECL_NIL); } return true; } cl_object qclear_event_filters() { /// args: () /// Clears all added event filters. - ecl_process_env()->nvalues = 1; LObjects::dynObject->clearEventFilters(); - return Ct; } + ecl_return1(ecl_process_env(), ECL_T); } cl_object qrequire2(cl_object l_name, cl_object l_quiet) { /// qrequire /// args: (module &optional quiet) @@ -2505,7 +2467,7 @@ cl_object qrequire2(cl_object l_name, cl_object l_quiet) { /// qrequire else if("webkit" == name) { if(!ModuleInterface::webkit) { ModuleInterface::webkit = new ModuleWebkit; }} */ - else if(l_quiet == Cnil) { + else if(l_quiet == ECL_NIL) { error_msg("QREQUIRE", LIST1(l_name)); } return l_name; #else @@ -2571,9 +2533,9 @@ cl_object qrequire2(cl_object l_name, cl_object l_quiet) { /// qrequire ModuleInterface::webkit = ini(); return l_name; }} #endif - if(l_quiet == Cnil) { + if(l_quiet == ECL_NIL) { error_msg("QREQUIRE", LIST1(l_name)); } - return Cnil; } + return ECL_NIL; } cl_object qload_cpp(cl_object l_lib_name, cl_object l_unload) { /// qload-c++ /// args: (library-name &optional unload) @@ -2585,7 +2547,7 @@ cl_object qload_cpp(cl_object l_lib_name, cl_object l_unload) { /// qload-c++ /// (! "mySpeedyQtFunction" (:qt *c++*)) ; call library function (see also DEFINE-QT-WRAPPERS) static QHash libraries; QString libName = toQString(l_lib_name); - bool unload = (l_unload != Cnil); + bool unload = (l_unload != ECL_NIL); if(!libName.isEmpty()) { if(!libName.contains('/')) { libName.prepend("./"); } @@ -2601,7 +2563,7 @@ cl_object qload_cpp(cl_object l_lib_name, cl_object l_unload) { /// qload-c++ delete lib; libraries.remove(libName); return l_lib_name; } - return Cnil; } + return ECL_NIL; } if(!lib) { lib = new QLibrary(libName); libraries[libName] = lib; } @@ -2610,28 +2572,23 @@ cl_object qload_cpp(cl_object l_lib_name, cl_object l_unload) { /// qload-c++ if(ini) { QObject* main = ini(); if(main) { - cl_object l_ret = qt_object_from_name(LObjects::vanillaQtSuperClassName(main->metaObject()), - main, - main->property("EQL.unique").toUInt()); - const cl_env_ptr l_env = ecl_process_env(); - l_env->nvalues = 2; - l_env->values[0] = l_ret; + cl_object l_ret1 = qt_object_from_name(LObjects::vanillaQtSuperClassName(main->metaObject()), + main, + main->property("EQL.unique").toUInt()); // for QFileSystemWatcher (QAUTO-RELOAD-C++) QString fileName(lib->fileName()); if(fileName.startsWith("./")) { fileName.prepend(QDir::currentPath() + "/"); } - l_env->values[1] = from_qstring(fileName); - return l_ret; }}} - ecl_process_env()->nvalues = 1; + cl_object l_ret2 = from_qstring(fileName); + ecl_return2(ecl_process_env(), l_ret1, l_ret2); }}} error_msg("QLOAD-C++", LIST2(l_lib_name, l_unload)); - return Cnil; } + ecl_return1(ecl_process_env(), ECL_NIL); } // *** convenience functions *** cl_object qtranslate(cl_object l_con, cl_object l_src, cl_object l_n) { - ecl_process_env()->nvalues = 1; QByteArray context(toQString(l_con).toUtf8()); QByteArray source(toQString(l_src).toUtf8()); int n = toInt(l_n); @@ -2640,43 +2597,38 @@ cl_object qtranslate(cl_object l_con, cl_object l_src, cl_object l_n) { l_ret = from_qstring(QCoreApplication::translate(context, source)); } else { l_ret = from_qstring(QCoreApplication::translate(context, source, 0, n)); } - return l_ret; } + ecl_return1(ecl_process_env(), l_ret); } cl_object qlocal8bit(cl_object l_str) { /// args: (string) /// Converts a Unicode pathname to a simple ECL base string, using QString::toLocal8Bit() (see QLocale settings).
Depending on the OS (namely Windows), this is necessary if you get a filename from Qt and want to use it in ECL.

See also QUTF8. - ecl_process_env()->nvalues = 1; cl_object l_ret = from_cstring(toQString(l_str).toLocal8Bit()); // returns 'ecl_simple_base_string', not Unicode - return l_ret; } + ecl_return1(ecl_process_env(), l_ret); } cl_object qutf8(cl_object l_str) { /// args: (string) /// Converts a Unicode pathname to a simple ECL base string, using QString::toUtf8().
Depending on the OS (namely OSX, Linux), this is necessary if you get a filename from Qt and want to use it in ECL.

See also QLOCAL8BIT. - ecl_process_env()->nvalues = 1; cl_object l_ret = from_cstring(toQString(l_str).toUtf8()); // returns 'ecl_simple_base_string', not Unicode - return l_ret; } + ecl_return1(ecl_process_env(), l_ret); } cl_object qfrom_utf8(cl_object l_ba) { /// args: (byte-array) /// Returns the byte array (vector of octets) converted using QString::fromUtf8(). - ecl_process_env()->nvalues = 1; cl_object l_ret = from_qstring(QString::fromUtf8(toQByteArray(l_ba))); - return l_ret; } + ecl_return1(ecl_process_env(), l_ret); } cl_object qescape(cl_object l_str) { /// args: (string) /// Calls QString::toHtmlEscaped(). - ecl_process_env()->nvalues = 1; cl_object l_ret = from_qstring(toQString(l_str).toHtmlEscaped()); - return l_ret; } + ecl_return1(ecl_process_env(), l_ret); } cl_object qt_object_name(cl_object l_obj) { /// args: (object) /// Returns the Qt class name. - ecl_process_env()->nvalues = 1; QtObject o = toQtObject(l_obj); cl_object l_ret = from_cstring(o.className()); - return l_ret; } + ecl_return1(ecl_process_env(), l_ret); } cl_object qt_object_x(cl_object l_obj) { /// qt-object-? /// args: (object) @@ -2684,7 +2636,6 @@ cl_object qt_object_x(cl_object l_obj) { /// qt-object-? /// (qt-object-? (|parentWidget| widget)) /// (qt-object-? (|widget| (|itemAt| box-layout 0))) /// (qt-object-? event) - ecl_process_env()->nvalues = 1; QtObject o = toQtObject(l_obj); cl_object l_ret = l_obj; if(o.pointer) { @@ -2699,25 +2650,24 @@ cl_object qt_object_x(cl_object l_obj) { /// qt-object-? const char* name = eventName(((QEvent*)o.pointer)->type()); if(name) { l_ret = qt_object_from_name(name, o.pointer, o.unique); }}} - return l_ret; } + ecl_return1(ecl_process_env(), l_ret); } cl_object qobject_names2(cl_object l_type) { /// args: (&optional type) /// Returns all supported object names. Passing either :q or :n returns only the QObject inherited, or not QObject inherited names, respectively. - ecl_process_env()->nvalues = 1; - bool all = (Cnil == l_type); + bool all = (ECL_NIL == l_type); StrList names; if(all) { names << LObjects::qNames; names << LObjects::nNames; qSort(names.begin(), names.end()); } else { - names = (Ct == cl_eql(q_keyword(), l_type)) ? LObjects::qNames : LObjects::nNames; } + names = (ECL_T == cl_eql(q_keyword(), l_type)) ? LObjects::qNames : LObjects::nNames; } QStringList list; Q_FOREACH(QByteArray name, names) { list << QString(name); } cl_object l_ret = from_qstringlist(list); - return l_ret; } + ecl_return1(ecl_process_env(), l_ret); } cl_object qenums2(cl_object l_class, cl_object l_name) { /// args: (class-name &optional enum-name) @@ -2730,10 +2680,10 @@ cl_object qenums2(cl_object l_class, cl_object l_name) { QByteArray name(toCString(l_name)); const QMetaObject* mo = ("Qt" == className) ? staticQtMetaObject : LObjects::staticMetaObject(className); if(mo) { - cl_object l_enums = Cnil; + cl_object l_enums = ECL_NIL; for(int i = mo->enumeratorOffset(); i < mo->enumeratorCount(); ++i) { QMetaEnum me(mo->enumerator(i)); - if((l_name == Cnil) || (me.name() == name)) { + if((l_name == ECL_NIL) || (me.name() == name)) { cl_object l_keys = LIST1(from_cstring(me.name())); for(int j = 0; j < me.keyCount(); ++j) { QByteArray key(me.key(j)); @@ -2743,27 +2693,25 @@ cl_object qenums2(cl_object l_class, cl_object l_name) { l_enums = CONS(l_class, cl_nreverse(l_enums)); return l_enums; }} error_msg("QENUMS", LIST2(l_class, l_name)); - return Cnil; } + return ECL_NIL; } cl_object qapp() { /// args: () /// Convenience function returning qApp. - ecl_process_env()->nvalues = 1; cl_object l_ret = qt_object_from_name("QApplication", (void*)qApp); - return l_ret; } + ecl_return1(ecl_process_env(), l_ret); } cl_object qprocess_events() { /// args: () /// Convenience function to call QApplication::processEvents(). - ecl_process_env()->nvalues = 1; QApplication::processEvents(); - return Ct; } + ecl_return1(ecl_process_env(), ECL_T); } cl_object qexec2(cl_object l_milliseconds) { /// args: (&optional milliseconds) /// Convenience function to call QApplication::exec().
Optionally pass the time in milliseconds after which QEventLoop::exit() will be called.
See also qsleep. ecl_process_env()->nvalues = 1; - if(l_milliseconds != Cnil) { + if(l_milliseconds != ECL_NIL) { static QTimer* timer = 0; if(!timer) { timer = new QTimer; @@ -2775,11 +2723,11 @@ cl_object qexec2(cl_object l_milliseconds) { return l_milliseconds; } QCoreApplication::exit(); // prevent "The event loop is already running" QApplication::exec(); - return Ct; } + return ECL_T; } cl_object no_qexec() { EQL::qexec = false; - return Cnil; } + ecl_return1(ecl_process_env(), ECL_NIL); } cl_object qexit() { /// args: () @@ -2788,8 +2736,8 @@ cl_object qexit() { if(EQL::eventLoop) { if(EQL::eventLoop->isRunning()) { EQL::eventLoop->exit(); - return Ct; }} - return Cnil; } + return ECL_T; }} + return ECL_NIL; } cl_object qstatic_meta_object(cl_object l_class) { /// args: (class-name) @@ -2802,7 +2750,7 @@ cl_object qstatic_meta_object(cl_object l_class) { cl_object l_ret = qt_object_from_name("QMetaObject", (void*)m); return l_ret; }} error_msg("QSTATIC-META-OBJECT", LIST1(l_class)); - return Cnil; } + return ECL_NIL; } cl_object qload_ui(cl_object l_ui) { /// args: (file-name) @@ -2824,7 +2772,7 @@ cl_object qload_ui(cl_object l_ui) { w->property("EQL.unique").toUInt()); return l_ret; }}} error_msg("QLOAD-UI", LIST1(l_ui)); - return Cnil; } + return ECL_NIL; } cl_object qfind_child(cl_object l_obj, cl_object l_name) { /// args: (object object-name) @@ -2842,7 +2790,7 @@ cl_object qfind_child(cl_object l_obj, cl_object l_name) { obj->property("EQL.unique").toUInt()); return l_ret; }}} error_msg("QFIND-CHILD", LIST2(l_obj, l_name)); - return Cnil; } + return ECL_NIL; } cl_object qfind_children2(cl_object l_obj, cl_object l_name, cl_object l_class) { /// args: (object &optional object-name class-name) @@ -2854,7 +2802,7 @@ cl_object qfind_children2(cl_object l_obj, cl_object l_name, cl_object l_class) QtObject o = toQtObject(l_obj); if(o.isQObject()) { QObjectList children = ((QObject*)o.pointer)->findChildren(objectName); - cl_object l_children = Cnil; + cl_object l_children = ECL_NIL; Q_FOREACH(QObject* child, children) { QByteArray className2(child->metaObject()->className()); QByteArray className3(LObjects::vanillaQtSuperClassName(child->metaObject())); @@ -2866,7 +2814,7 @@ cl_object qfind_children2(cl_object l_obj, cl_object l_name, cl_object l_class) l_children = cl_nreverse(l_children); return l_children; } error_msg("QFIND-CHILDREN", LIST3(l_obj, l_name, l_class)); - return Cnil; } + return ECL_NIL; } cl_object qui_class2(cl_object l_ui, cl_object l_name) { /// args: (file-name &optional object-name) @@ -2911,7 +2859,7 @@ cl_object qui_class2(cl_object l_ui, cl_object l_name) { cl_object l_ret = from_qstring(className); return l_ret; }}} error_msg("QUI-CLASS", LIST2(l_ui, l_name)); - return Cnil; } + return ECL_NIL; } cl_object qui_names(cl_object l_ui) { /// args: (file-name) @@ -2941,7 +2889,7 @@ cl_object qui_names(cl_object l_ui) { cl_object l_ret = from_qstringlist(names); return l_ret; }} error_msg("QUI-NAMES", LIST1(l_ui)); - return Cnil; } + return ECL_NIL; } cl_object qsuper_class_name(cl_object l_name) { /// args: (name) @@ -2950,15 +2898,11 @@ cl_object qsuper_class_name(cl_object l_name) { if(ECL_STRINGP(l_name)) { bool found = false; QByteArray super = superClassName(toCString(l_name), &found); - const cl_env_ptr l_env = ecl_process_env(); if(found) { - l_env->nvalues = 2; - l_env->values[0] = super.isEmpty() ? Cnil : from_cstring(super); - l_env->values[1] = Ct; - return l_env->values[0]; }} - ecl_process_env()->nvalues = 1; + cl_object l_ret1 = super.isEmpty() ? ECL_NIL : from_cstring(super); + ecl_return2(ecl_process_env(), l_ret1, ECL_T); }} error_msg("QSUPER-CLASS-NAME", LIST1(l_name)); - return Cnil; } + ecl_return1(ecl_process_env(), ECL_NIL); } cl_object qsingle_shot2(cl_object l_msec, cl_object l_fun) { /// args: (milliseconds function) @@ -2968,11 +2912,11 @@ cl_object qsingle_shot2(cl_object l_msec, cl_object l_fun) { /// (let ((ms 500)) ///   (qsingle-shot ms (lambda () (qmsg ms)))) ecl_process_env()->nvalues = 1; - if(l_fun != Cnil) { + if(l_fun != ECL_NIL) { new SingleShot(toInt(l_msec), l_fun); // see "delete this;" in "single_shot.h" return l_msec; } error_msg("QSINGLE-SHOT", LIST2(l_msec, l_fun)); - return Cnil; } + return ECL_NIL; } cl_object qok() { /// args: () @@ -2980,8 +2924,8 @@ cl_object qok() { /// (! "getFont(bool*)" "QFontDialog" nil) /// /// (|getFont.QFontDialog| nil) ; NIL needed for <bool*> - ecl_process_env()->nvalues = 1; - return _ok_ ? Ct : Cnil; } + cl_object l_ret = _ok_ ? ECL_T : ECL_NIL; + ecl_return1(ecl_process_env(), l_ret); } cl_object qid(cl_object l_class) { /// args: (name) @@ -2991,10 +2935,10 @@ cl_object qid(cl_object l_class) { if(ECL_STRINGP(l_class)) { int id = classId(l_class); if(id) { - cl_object l_ret = MAKE_FIXNUM(id); + cl_object l_ret = ecl_make_fixnum(id); return l_ret; }} // no error message (testing for a supported Qt class) - return Cnil; } + return ECL_NIL; } cl_object qvariant_equal2(cl_object l_var1, cl_object l_var2) { // for internal use only (use QEQL instead, which will call this function for QVariants) @@ -3005,18 +2949,16 @@ cl_object qvariant_equal2(cl_object l_var1, cl_object l_var2) { if((var1.id == id_var) && (var2.id == id_var)) { QVariant* vp1 = (QVariant*)var1.pointer; QVariant* vp2 = (QVariant*)var2.pointer; - cl_object l_ret = (*vp1 == *vp2) ? Ct : Cnil; // QVariant::operator== + cl_object l_ret = (*vp1 == *vp2) ? ECL_T : ECL_NIL; // QVariant::operator== return l_ret; } - return Cnil; } + return ECL_NIL; } cl_object qversion() { /// args: () /// Returns the EQL version number as "<year>.<month>.<counter>".
The second return value is the Qt version as returned by qVersion(). - const cl_env_ptr l_env = ecl_process_env(); - l_env->nvalues = 2; - l_env->values[0] = from_cstring(EQL::version); - l_env->values[1] = from_cstring(qVersion()); - return l_env->values[0]; } + cl_object l_ret1 = from_cstring(EQL::version); + cl_object l_ret2 = from_cstring(qVersion()); + ecl_return2(ecl_process_env(), l_ret1, l_ret2); } cl_object qrun_on_ui_thread2(cl_object l_function_or_closure, cl_object l_blocking) { /// args: (function &optional (blocking t)) @@ -3024,64 +2966,82 @@ cl_object qrun_on_ui_thread2(cl_object l_function_or_closure, cl_object l_blocki /// Runs function on the UI thread while (by default) blocking the calling thread (if called from main thread, function will simply be called directly).
This is needed to run GUI code from ECL threads other than the main thread.
Returns T on success.

There are 2 reasons to always wrap any EQL function like this, if called from another ECL thread:
  • Qt UI methods always need to run on the UI thread
  • EQL functions are not designed to be reentrant (not needed for UI code)
See also macro qrun*. /// (qrun 'update-view-data) ecl_process_env()->nvalues = 1; - if(l_function_or_closure != Cnil) { + if(l_function_or_closure != ECL_NIL) { QObject o; if(o.thread() == QApplication::instance()->thread()) { // direct call LObjects::eql->runOnUiThread(l_function_or_closure); - return Ct; } + return ECL_T; } else { // queued call in main event loop (GUI thread) QMetaObject::invokeMethod(LObjects::eql, "runOnUiThread", - (l_blocking != Cnil) ? Qt::BlockingQueuedConnection : Qt::QueuedConnection, + (l_blocking != ECL_NIL) ? Qt::BlockingQueuedConnection : Qt::QueuedConnection, Q_ARG(void*, l_function_or_closure)); - return Ct; }} + return ECL_T; }} error_msg("QRUN-ON-UI-THREAD", LIST1(l_function_or_closure)); - return Cnil; } + return ECL_NIL; } cl_object qlog2(cl_object l_msg) { // for android logging only; see 'lisp/ini.lisp::qlog' and 'eql.cpp::logMessageHandler' - ecl_process_env()->nvalues = 1; qDebug() << toQString(l_msg); - return Cnil; } + ecl_return1(ecl_process_env(), ECL_NIL); } + +QVariantList lispToQVariantList(cl_object); + +static QVariant lispToQVariant(cl_object l_arg) { + // helper for lispToQVariantList() + QVariant var; + if(cl_integerp(l_arg) == ECL_T) { // int + var = QVariant(toInt(l_arg)); } + else if(cl_floatp(l_arg) == ECL_T) { // double + var = QVariant(toFloat(l_arg)); } + else if(cl_stringp(l_arg) == ECL_T) { // string + var = QVariant(toQString(l_arg)); } + else if(l_arg == ECL_T) { // true + var = QVariant(true); } + else if(l_arg == ECL_NIL) { // false + var = QVariant(false); } + else if(cl_listp(l_arg) == ECL_T) { // list + var = QVariant::fromValue(lispToQVariantList(l_arg)); } + else { // default: undefined + var = QVariant(); } + return var; } + +QVariantList lispToQVariantList(cl_object l_list) { + // helper for QJS_CALL + // converts (nested) Lisp lists to (nested) QVariant lists + QVariantList l; + if(ECL_LISTP(l_list)) { + cl_object l_do_list = l_list; + for(cl_object l_do_list = l_list; l_do_list != ECL_NIL; l_do_list = cl_cdr(l_do_list)) { + cl_object l_el = cl_car(l_do_list); + l << lispToQVariant(l_el); }} + return l; } cl_object qjs_call(cl_object l_item, cl_object l_name, cl_object l_args) { // direct, fast JS calls, see 'qml-lisp' in QML examples // max. 10 arguments // supported argument types: T, NIL, INTEGER, FLOAT, STRING, (nested) LIST of mentioned arguments ecl_process_env()->nvalues = 1; - QVariant arg[10]; - QGenericArgument genA[10]; + const int MAX = 10; + QVariant arg[MAX]; + QGenericArgument genA[MAX]; const char* v = "QVariant"; - cl_object l_do_args = l_args; int i = 0; - for(; l_do_args != Cnil; i++) { - cl_object l_arg = cl_car(l_do_args); - if(cl_integerp(l_arg) == ECL_T) { // int - arg[i] = QVariant(toInt(l_arg)); } - else if(cl_floatp(l_arg) == ECL_T) { // double - arg[i] = QVariant(toFloat(l_arg)); } - else if(cl_stringp(l_arg) == ECL_T) { // string - arg[i] = QVariant(toQString(l_arg)); } - else if(l_arg == ECL_T) { // true - arg[i] = QVariant(true); } - else if(l_arg == ECL_NIL) { // false - arg[i] = QVariant(false); } - else if(LISTP(l_arg)) { // list - arg[i] = QVariant::fromValue(lispToQVariantList(l_arg)); } - else { // default: undefined - arg[i] = QVariant(); } - genA[i] = QGenericArgument(v, &arg[i]); - l_do_args = cl_cdr(l_do_args); } + for(cl_object l_do_list = l_args; l_do_list != ECL_NIL; l_do_list = cl_cdr(l_do_list), i++) { + cl_object l_el = cl_car(l_do_list); + arg[i] = lispToQVariant(l_el); + genA[i] = QGenericArgument(v, &arg[i]); } QGenericArgument null; - for(; i < 10; i++) { + for(; i < MAX; i++) { genA[i] = null; } QtObject o = toQtObject(l_item); - QVariant ret; - QGenericReturnArgument genR(v, &ret); - if(o.isQObject()) { - QMetaObject::invokeMethod((QObject*)o.pointer, toCString(l_name), genR, + QByteArray name(toCString(l_name)); + if(o.isQObject() && o.pointer && !name.isEmpty()) { + QVariant ret; + QGenericReturnArgument genR(v, &ret); + QMetaObject::invokeMethod((QObject*)o.pointer, name, genR, genA[0], genA[1], genA[2], genA[3], genA[4], genA[5], genA[6], genA[7], genA[8], genA[9]); return from_qvariant_value(ret); } error_msg("QJS-CALL", LIST3(l_item, l_name, l_args)); @@ -3089,6 +3049,37 @@ cl_object qjs_call(cl_object l_item, cl_object l_name, cl_object l_args) { +// *** QML *** + +cl_object qml_get2(cl_object l_item, cl_object l_name) { + QtObject o = toQtObject(l_item); + QByteArray name = toCString(l_name); + if(o.isQObject() && o.pointer && !name.isEmpty()) { + QObject* qobject = (QObject*)o.pointer; + QQmlProperty property(qobject, name); + if(property.isValid()) { + cl_object l_val = from_qvariant_value(property.read()); + ecl_return2(ecl_process_env(), l_val, ECL_T); }} + error_msg("QML-GET", LIST2(l_item, l_name)); + ecl_return1(ecl_process_env(), ECL_NIL); } + +cl_object qml_set2(cl_object l_item, cl_object l_name, cl_object l_value) { + ecl_process_env()->nvalues = 1; + QtObject o = toQtObject(l_item); + QByteArray name = toCString(l_name); + if(o.isQObject() && o.pointer && !name.isEmpty()) { + QObject* qobject = (QObject*)o.pointer; + QQmlProperty property(qobject, name); + if(property.isValid()) { + QByteArray type(property.propertyTypeName()); + if(type.contains(':')) { + type = "int"; } + return property.write(toQVariant(l_value, type)) ? ECL_T : ECL_NIL; }} + error_msg("QML-SET", LIST3(l_item, l_name, l_value)); + return ECL_NIL; } + + + // *** special extensions *** // @@ -3101,7 +3092,7 @@ cl_object make_qimage_dangerous(cl_object l_vector, cl_object l_width, cl_object // make sure all the input data is of the correct type. if (!ECL_VECTORP(l_vector) || !ECL_FIXNUMP(l_width) || !ECL_FIXNUMP(l_height) || !ECL_FIXNUMP(l_bytes_per_line) || !ECL_FIXNUMP(l_format)) { error_msg("MAKE-QIMAGE", LIST5(l_vector, l_width, l_height, l_bytes_per_line, l_format)); - return Cnil; } + return ECL_NIL; } ecl_vector *v = &l_vector->vector; switch (v->elttype) { @@ -3112,7 +3103,7 @@ cl_object make_qimage_dangerous(cl_object l_vector, cl_object l_width, cl_object break; default: error_msg("MAKE-QIMAGE", LIST5(l_vector, l_width, l_height, l_bytes_per_line, l_format)); - return Cnil; } + return ECL_NIL; } int width = toInt(l_width); int height = toInt(l_height); diff --git a/src/ecl_fun.h b/src/ecl_fun.h index bcd7769..7f859a3 100644 --- a/src/ecl_fun.h +++ b/src/ecl_fun.h @@ -22,28 +22,28 @@ QT_BEGIN_NAMESPACE static const int constant = qRegisterMetaType< type >(#type); #define DEFUN(name, c_name, num_args) \ - ecl_def_c_function(c_string_to_object((char*)name), (cl_objectfn_fixed)c_name, num_args); + ecl_def_c_function(ecl_read_from_cstring((char*)name), (cl_objectfn_fixed)c_name, num_args); -#define STRING(s) make_constant_base_string((char*)s) +#define STRING(s) ecl_make_constant_base_string((char*)s, -1) -#define STRING_COPY(s) (s ? make_base_string_copy((char*)s) : Cnil) +#define STRING_COPY(s) (s ? ecl_make_simple_base_string((char*)s, -1) : ECL_NIL) #define PRINT(x) cl_print(1, x) #define TERPRI() cl_terpri(0) #define STATIC_SYMBOL(var, name) \ - static cl_object var = cl_intern(1, make_constant_base_string((char*)name)); + static cl_object var = cl_intern(1, ecl_make_constant_base_string((char*)name, -1)); #define STATIC_SYMBOL_PKG(var, name, pkg) \ static cl_object var = cl_intern(2, \ - make_constant_base_string((char*)name), \ - cl_find_package(make_constant_base_string((char*)pkg))); + ecl_make_constant_base_string((char*)name, -1), \ + cl_find_package(ecl_make_constant_base_string((char*)pkg, -1))); #define LEN(x) fixint(cl_length(x)) #define LIST1(a1) \ - CONS(a1, Cnil) + CONS(a1, ECL_NIL) #define LIST2(a1, a2) \ CONS(a1, LIST1(a2)) #define LIST3(a1, a2, a3) \ @@ -97,7 +97,7 @@ static cap_name* to##cap_name##Pointer(cl_object x) { \ p = (cap_name*)o.pointer; } \ return p; } \ static cl_object from_##name(const cap_name& x) { \ - cl_object l_ret = Cnil; \ + cl_object l_ret = ECL_NIL; \ if(EQL::return_value_p) { \ l_ret = qt_object_from_name(#cap_name, new cap_name(x), 0, true); } \ else { \ @@ -106,7 +106,7 @@ static cl_object from_##name(const cap_name& x) { \ #define FROM_QT_TYPE_ONLY(cap_name, name) \ static cl_object from_##name(const cap_name& x) { \ - cl_object l_ret = Cnil; \ + cl_object l_ret = ECL_NIL; \ if(EQL::return_value_p) { \ l_ret = qt_object_from_name(#cap_name, new cap_name(x), 0, true); } \ else { \ @@ -123,7 +123,7 @@ static cap_name to##cap_name(cl_object l_x) { \ #define TO_CL_TYPE(cap_name, name, x1, x2) \ static cl_object from_##name(const cap_name& q) { \ - cl_object l_ret = LIST2(MAKE_FIXNUM(q.x1()), MAKE_FIXNUM(q.x2())); \ + cl_object l_ret = LIST2(ecl_make_fixnum(q.x1()), ecl_make_fixnum(q.x2())); \ return l_ret; } #define TO_CL_TYPEF(cap_name, name, x1, x2) \ @@ -134,7 +134,7 @@ static cap_name to##cap_name(cl_object l_x) { \ #define TO_CL_TYPE2(cap_name, name, x1, x2, x3, x4) \ static cl_object from_##name(const cap_name& q) { \ - cl_object l_ret = LIST4(MAKE_FIXNUM(q.x1()), MAKE_FIXNUM(q.x2()), MAKE_FIXNUM(q.x3()), MAKE_FIXNUM(q.x4())); \ + cl_object l_ret = LIST4(ecl_make_fixnum(q.x1()), ecl_make_fixnum(q.x2()), ecl_make_fixnum(q.x3()), ecl_make_fixnum(q.x4())); \ return l_ret; } #define TO_CL_TYPEF2(cap_name, name, x1, x2, x3, x4) \ @@ -145,7 +145,7 @@ static cap_name to##cap_name(cl_object l_x) { \ #define TO_CL_LIST_PTR(cap_type, type) \ static cl_object from_##type##list(const QList& l) { \ - cl_object l_list = Cnil; \ + cl_object l_list = ECL_NIL; \ Q_FOREACH(cap_type* x, l) { \ l_list = CONS(qt_object_from_name(#cap_type, x), l_list); } \ l_list = cl_nreverse(l_list); \ @@ -153,7 +153,7 @@ static cap_name to##cap_name(cl_object l_x) { \ #define TO_CL_LIST_VAL(cap_type, type) \ static cl_object from_##type##list(const QList& l) { \ - cl_object l_list = Cnil; \ + cl_object l_list = ECL_NIL; \ Q_FOREACH(cap_type x, l) { \ l_list = CONS(from_##type(x), l_list); } \ l_list = cl_nreverse(l_list); \ @@ -161,7 +161,7 @@ static cap_name to##cap_name(cl_object l_x) { \ #define TO_CL_LIST_VAL2(cap_type, fun) \ static cl_object from_##type##list(const QList& l) { \ - cl_object l_list = Cnil; \ + cl_object l_list = ECL_NIL; \ Q_FOREACH(cap_type* x, l) { \ l_list = CONS(fun(*x), l_list); } \ l_list = cl_nreverse(l_list); \ @@ -172,7 +172,7 @@ static cap_name to##cap_name(cl_object l_x) { \ QList l; \ if(LISTP(l_list)) { \ cl_object l_el = l_list; \ - while(l_el != Cnil) { \ + while(l_el != ECL_NIL) { \ l << (type*)toQtObject(cl_car(l_el)).pointer; \ l_el = cl_cdr(l_el); }} \ return l; } @@ -182,7 +182,7 @@ static cap_name to##cap_name(cl_object l_x) { \ QList l; \ if(LISTP(l_list)) { \ cl_object l_el = l_list; \ - while(l_el != Cnil) { \ + while(l_el != ECL_NIL) { \ l << to##type(cl_car(l_el)); \ l_el = cl_cdr(l_el); }} \ return l; } @@ -192,7 +192,7 @@ static cap_name to##cap_name(cl_object l_x) { \ QList l; \ if(LISTP(l_list)) { \ cl_object l_el = l_list; \ - while(l_el != Cnil) { \ + while(l_el != ECL_NIL) { \ l << to##fun(cl_car(l_el)); \ l_el = cl_cdr(l_el); }} \ return l; } @@ -200,17 +200,17 @@ static cap_name to##cap_name(cl_object l_x) { \ #define TO_QT_VECTOR_VAL(type) \ static QVector to##type##Vector(cl_object l_v) { \ QVector v; \ - if(cl_simple_vector_p(l_v) == Ct) { \ + if(cl_simple_vector_p(l_v) == ECL_T) { \ for(int i = 0; i < LEN(l_v); ++i) { \ - v.append(to##type(cl_svref(l_v, MAKE_FIXNUM(i)))); }} \ + v.append(to##type(cl_svref(l_v, ecl_make_fixnum(i)))); }} \ return v; } #define TO_QT_VECTOR_VAL2(type, fun) \ static QVector to##type##Vector(cl_object l_v) { \ QVector v; \ - if(cl_simple_vector_p(l_v) == Ct) { \ + if(cl_simple_vector_p(l_v) == ECL_T) { \ for(int i = 0; i < LEN(l_v); ++i) { \ - v.append(to##fun(cl_svref(l_v, MAKE_FIXNUM(i)))); }} \ + v.append(to##fun(cl_svref(l_v, ecl_make_fixnum(i)))); }} \ return v; } #define TO_CL_VECTOR_VAL(cap_type, type) \ @@ -265,6 +265,8 @@ cl_object qload_ui (cl_object); cl_object qlocal8bit (cl_object); cl_object qlog2 (cl_object); cl_object qmeta_enums (); +cl_object qml_get2 (cl_object, cl_object); +cl_object qml_set2 (cl_object, cl_object, cl_object); cl_object qnew_instance2 (cl_object, cl_object); cl_object qobject_names2 (cl_object); cl_object qok (); @@ -338,7 +340,7 @@ cl_object to_lisp_arg(const MetaArg&); EQL_EXPORT QVariant callOverrideFun(void*, int, const void**, quint64); EQL_EXPORT cl_object qt_object_from_name(const QByteArray&, void*, uint = 0, bool = false); -EQL_EXPORT QtObject toQtObject(cl_object, cl_object = Cnil, bool* = 0, bool = false); +EQL_EXPORT QtObject toQtObject(cl_object, cl_object = ECL_NIL, bool* = 0, bool = false); QT_END_NAMESPACE diff --git a/src/eql.cpp b/src/eql.cpp index e7bf121..b0a9bcc 100644 --- a/src/eql.cpp +++ b/src/eql.cpp @@ -9,7 +9,7 @@ #include #include -const char EQL::version[] = "21.3.1"; // March 2021 +const char EQL::version[] = "21.3.2"; // March 2021 extern "C" void ini_EQL(cl_object); @@ -45,7 +45,7 @@ EQL::EQL() : QObject() { cl_boot(1, (char**)_argv_); } iniCLFunctions(); LObjects::ini(this); - read_VV(OBJNULL, ini_EQL); } // see "src/make.lisp" + ecl_init_module(NULL, ini_EQL); } // see "src/make.lisp" void EQL::ini(char** argv) { cl_booted = true; @@ -88,7 +88,7 @@ void EQL::ignoreIOStreams() { eval("(eql::ignore-io-streams)"); } void EQL::exec(const QStringList& args) { - cl_object s_qtpl = cl_intern(1, make_constant_base_string("*QTPL*")); + cl_object s_qtpl = cl_intern(1, ecl_make_constant_base_string("*QTPL*", -1)); bool exec_with_simple_restart = false; QStringList arguments(args); eval("(in-package :eql-user)"); @@ -121,10 +121,10 @@ void EQL::exec(const QStringList& args) { arguments << swankFile; } exec_with_simple_restart = true; } // -qtpl - else if(arguments.contains("-qtpl") || (cl_symbol_value(s_qtpl) == Ct)) { + else if(arguments.contains("-qtpl") || (cl_symbol_value(s_qtpl) == ECL_T)) { arguments.removeAll("-qtpl"); evalMode = DebugOnError; - ecl_setq(ecl_process_env(), s_qtpl, Ct); + ecl_setq(ecl_process_env(), s_qtpl, ECL_T); QApplication::setQuitOnLastWindowClosed(false); forms << "(when (directory (in-home \"lib/ecl-readline.fas*\"))" " (load (x:check-recompile (in-home \"lib/ecl-readline\"))))" @@ -179,7 +179,7 @@ void EQL::exec(const QStringList& args) { void EQL::exec(lisp_ini ini, const QByteArray& expression, const QByteArray& package) { // see my_app example - read_VV(OBJNULL, ini); + ecl_init_module(NULL, ini); eval(QString("(in-package :%1)").arg(QString(package)).toLatin1().constData()); eval(expression.constData()); } diff --git a/src/eql_lib.pro b/src/eql_lib.pro index aafad32..ce7a2cd 100644 --- a/src/eql_lib.pro +++ b/src/eql_lib.pro @@ -1,4 +1,4 @@ -QT += widgets printsupport uitools +QT += widgets printsupport uitools qml TEMPLATE = lib CONFIG += dll no_keywords release DEFINES += EQL_LIBRARY diff --git a/src/lisp/ini.lisp b/src/lisp/ini.lisp index 8090b91..63a18aa 100644 --- a/src/lisp/ini.lisp +++ b/src/lisp/ini.lisp @@ -1,5 +1,7 @@ ;;; copyright (c) Polos Ruetz +(si::trap-fpe t nil) ; ignore floating point exceptions (they happen on Qt side) + (ffi:clines "#include ") (in-package :eql) diff --git a/src/lisp/package.lisp b/src/lisp/package.lisp index b42d9a4..3b7284e 100644 --- a/src/lisp/package.lisp +++ b/src/lisp/package.lisp @@ -116,5 +116,33 @@ (defpackage :eql-user (:use :common-lisp :eql)) +(defpackage :qml-lisp + (:use :common-lisp :eql) + (:nicknames :qml) + (:export + #:*quick-view* + #:*root* + #:*caller* + #:children + #:file-to-url + #:find-quick-item + #:ini-quick-view + #:js + #:js-arg + #:qml-call + #:qml-get + #:qml-set + #:qml-set-all + #:q! + #:q< + #:q> + #:q>* + #:qjs + #:paint + #:scale + #:reload + #:root-context + #:root-item)) + (pushnew :eql *features*) (pushnew :eql5 *features*) diff --git a/examples/M-modules/quick/9999/lisp/qml-lisp.lisp b/src/lisp/qml.lisp similarity index 83% rename from examples/M-modules/quick/9999/lisp/qml-lisp.lisp rename to src/lisp/qml.lisp index 4c837c4..f997f1d 100644 --- a/examples/M-modules/quick/9999/lisp/qml-lisp.lisp +++ b/src/lisp/qml.lisp @@ -38,6 +38,7 @@ (defvar *quick-view* nil) (defvar *caller* nil) +(defvar *root* nil) (defun string-to-symbol (name) (let ((upper (string-upcase name)) @@ -135,10 +136,10 @@ (defun file-to-url (file) "Convert FILE to a QUrl, distinguishing between development and release version." - #+release - (qnew "QUrl(QString)" (x:cc "qrc:/" file)) ; see "Qt Resource System" - #-release - (|fromLocalFile.QUrl| file)) + (if (probe-file file) + (|fromLocalFile.QUrl| file) + (qnew "QUrl(QString)" + (x:cc (or *root* "qrc:/") file)))) ; see "Qt Resource System" ;;; call QML methods @@ -150,27 +151,14 @@ (defun qml-get (item/name property-name) "Gets QQmlProperty of either ITEM or first object matching NAME." - (qrun* (qlet ((property "QQmlProperty(QObject*,QString)" - (quick-item item/name) - property-name)) - (if (|isValid| property) - (qlet ((variant (|read| property))) - (values (qvariant-value variant) - t)) - (eql::%error-msg "QML-GET" (list item/name property-name)))))) + (qrun* (eql::%qml-get (quick-item item/name) property-name))) (defun qml-set (item/name property-name value &optional update) "Sets QQmlProperty of either ITEM, or first object matching NAME. Returns T on success. If UPDATE is not NIL and ITEM is a QQuickPaintedItem, |update| will be called on it." - (qrun* (let ((item (quick-item item/name))) - (qlet ((property "QQmlProperty(QObject*,QString)" item property-name)) - (if (|isValid| property) - (let ((type-name (|propertyTypeName| property))) - (qlet ((variant (qvariant-from-value value (if (find #\: type-name) "int" type-name)))) - (prog1 - (|write| property variant) - (when (and update (= (qt-object-id item) (qid "QQuickPaintedItem"))) - (|update| item))))) - (eql::%error-msg "QML-SET" (list item/name property-name value))))))) + (qrun* (prog1 + (eql::%qml-set (quick-item item/name) property-name value) + (when (and update (= (qt-object-id item) (qid "QQuickPaintedItem"))) + (|update| item))))) (defun qml-set-all (name property-name value &optional update) "Sets QQmlProperty of all objects matching NAME." @@ -201,24 +189,26 @@ (qrun* (qlet ((qml-exp "QQmlExpression(QQmlContext*,QObject*,QString)" (root-context) (quick-item item/name) - (apply 'format nil js-format-string arguments)) + (apply 'format nil js-format-string (mapcar 'js-arg arguments))) (variant (|evaluate| qml-exp))) (qvariant-value variant)))) (defun js-arg (object) - "To be used for arguments in function JS." - (with-output-to-string (*standard-output*) - (print-js-readably object))) + "Used for arguments in function JS." + (if (stringp object) + object + (with-output-to-string (*standard-output*) + (print-js-readably object)))) (defun %qjs (item/name function-name &rest arguments) ;; QJS-CALL is defined in EQL5, function 'ecl_fun.cpp' - (eql::qjs-call (quick-item item/name) function-name arguments)) + (qrun* (eql::qjs-call (quick-item item/name) function-name arguments))) (defmacro qjs (function-name item/name &rest arguments) "Fast and direct JS calls; max 10 arguments of type: T, NIL, INTEGER, FLOAT, STRING, (nested) LIST of mentioned types. Examples: (qjs |drawLine| *canvas* 0 0 100.0 100.0) - (qjs |drawPath| *canvas* (list (list 0 0) (list 0 10.0) (list 10.0 10.0)))" + (qjs |addItems| *model* (list (list \"Frank\" 42) (list \"Susan\" 40)))" `(%qjs ,item/name ,(symbol-name function-name) ,@arguments)) ;;; ini @@ -233,7 +223,7 @@ (|setProfile| f |QSurfaceFormat.CoreProfile|) (|setVersion| f 4 4) (|setFormat| *quick-view* f)))) - (qconnect (|engine| *quick-view*) "quit()" (qapp) "quit()") + (qconnect (|engine| *quick-view*) "quit()" 'qquit) (qnew "QQmlFileSelector(QQmlEngine*,QObject*)" (|engine| *quick-view*) *quick-view*) (|setSource| *quick-view* (file-to-url file)) (when (= |QQuickView.Error| (|status| *quick-view*)) diff --git a/src/make.lisp b/src/make.lisp index 5090a3c..7894bd5 100644 --- a/src/make.lisp +++ b/src/make.lisp @@ -39,6 +39,10 @@ (dolist (file *all-wrappers*) (compile-file (format nil "lisp/~A.lisp" file) :system-p t)) +(progn + (compile-file "lisp/qml" :system-p t) + (setf *lisp-files* (append *lisp-files* (list "qml")))) + ;; lib (c:build-static-library "ini_eql5"