add support for keyword arguments in 'Lisp.call()', like '":start", 10'

This commit is contained in:
pls.153 2024-09-16 14:11:46 +02:00
parent a3879f7288
commit eb67c56fd2

View file

@ -38,24 +38,33 @@
;; Every 'Lisp.call()' or 'Lisp.apply()' function call in QML will call this ;; Every 'Lisp.call()' or 'Lisp.apply()' function call in QML will call this
;: function. The variable *CALLER* will be bound to the calling QQuickItem, ;: function. The variable *CALLER* will be bound to the calling QQuickItem,
;; if passed with 'this' as first argument to 'Lisp.call()' / 'Lisp.apply()'. ;; if passed with 'this' as first argument to 'Lisp.call()' / 'Lisp.apply()'.
;;
;; Possible integers encoded as hex strings in JS (see function HEX above) ;; Possible integers encoded as hex strings in JS (see function HEX above)
;; are automatically converted back to integers. ;; are automatically converted back to integers.
;;
;; Strings starting with ':' are assumed to be Lisp keywords, if composed by
;; alphanumeric characters, and if they have a following argument.
(let ((fun (string-to-symbol function)) (let ((fun (string-to-symbol function))
(*caller* (if (zerop caller) (*caller* (if (zerop caller)
*caller* *caller*
(qt-object caller)))) (qt-object caller))))
(if (fboundp fun) (if (fboundp fun)
(apply fun (mapcar (lambda (arg) (apply fun (let ((len (length arguments)))
(if (and (stringp arg) (loop :for arg :in arguments
(x:starts-with "#x" arg)) :for n :from 1 :to len
:collect (if (and (stringp arg)
(or (x:starts-with "#x" arg) ; integer
(and (char= #\: (char arg 0)) ; keyword
(> (length arg) 1)
(every 'alphanumericp (subseq arg 1))
(< n len))))
(or (ignore-errors (read-from-string arg)) (or (ignore-errors (read-from-string arg))
arg) arg)
arg)) arg))))
arguments))
(let ((msg (format nil "[LQML:error] Lisp.call(): ~S is undefined." function))) (let ((msg (format nil "[LQML:error] Lisp.call(): ~S is undefined." function)))
(when *break-on-errors* (when *break-on-errors*
(break msg) (break msg))
(format *error-output* "~%~A~%" msg)))))) (format *error-output* "~%~A~%" msg)))))
;;; utils ;;; utils