get bus method out args from interface.xml

instead of hardcoding
This commit is contained in:
Daniel Barlow 2022-02-12 22:13:00 +00:00
parent d83fd293b2
commit a9d00b2eb5

View File

@ -198,38 +198,45 @@
(tset out (. list i) (. list (+ 1 i)))) (tset out (. list i) (. list (+ 1 i))))
out)) out))
(fn make-notification [params] (fn make-notification [sender id icon summary body actions hints timeout]
{ {
:sender (. params 1) :sender sender
:id (. params 2) :id id
:app-icon (. params 3) :app-icon icon
:summary (. params 4) :summary summary
:body (. params 5) :body body
:actions (parse-actions (. params 6)) :actions (parse-actions actions)
:hints (. params 7) :hints hints
:timeout (. params 8) :timeout timeout
}) })
(local interface-info
(let [xml (: (io.open "interface.xml" "r") :read "*a")
node-info (Gio.DBusNodeInfo.new_for_xml xml)]
(. node-info.interfaces 1)))
(local dbus-methods
{
"GetCapabilities" #["actions" "body" "persistence"]
"GetServerInformation" #(values "crier" "telent" "0.1" "1.2")
"Notify" #(add-notification (make-notification $...))
})
(fn args-signature [args]
(var sig "")
(each [_ v (ipairs args)]
(set sig (.. sig v.signature)))
sig)
(fn handle-dbus-method-call [conn sender path interface method params invocation] (fn handle-dbus-method-call [conn sender path interface method params invocation]
(print interface)
(when (and (= path dbus-service-attrs.path) (when (and (= path dbus-service-attrs.path)
(= interface dbus-service-attrs.interface)) (= interface dbus-service-attrs.interface))
(match method (let [p (dbus.variant.strip params)
"GetCapabilities" info (interface-info:lookup_method method)
(invocation:return_value (GV "as" ["actions" "body" "persistence"])) ret (table.pack ((. dbus-methods method) (table.unpack p)))
sig (args-signature info.out_args)]
"GetServerInformation" (invocation:return_value (GV (.. "(" sig ")") ret)))))
(invocation:return_value
(GV "(ssss)" ["crier"
"telent"
"0.1"
"1.2"]))
"Notify"
(let [p (dbus.variant.strip params)
n (make-notification p)]
(invocation:return_value (GV "(u)"
[(add-notification n)])))
)))
(fn handle-dbus-get [conn sender path interface name] (fn handle-dbus-get [conn sender path interface name]
(when (and (= path dbus-service-attrs.path) (when (and (= path dbus-service-attrs.path)
@ -237,11 +244,6 @@
(= name "Visible")) (= name "Visible"))
(lgi.GLib.Variant "b" true))) (lgi.GLib.Variant "b" true)))
(local interface-info
(let [xml (: (io.open "interface.xml" "r") :read "*a")
node-info (Gio.DBusNodeInfo.new_for_xml xml)]
(. node-info.interfaces 1)))
(Gio.DBusConnection.register_object (Gio.DBusConnection.register_object
bus.connection bus.connection
dbus-service-attrs.path dbus-service-attrs.path