[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [PATCH] Support automatic D-Bus proxy generation
From: |
joakim |
Subject: |
Re: [PATCH] Support automatic D-Bus proxy generation |
Date: |
Wed, 25 Feb 2015 18:18:11 +0100 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/25.0.50 (gnu/linux) |
Daiki Ueno <address@hidden> writes:
> For what it's worth, I've turned it into a patch (still work in
> progress). It ended up with a new module dbus-codegen.el, with two
> different interfaces: one is a static version (`define-dbus-proxy'),
> which takes an interface definition as an argument and expands at
> compile-time. The other is a dynamic version (`make-dbus-proxy'), which
> retrieves the interface through introspection.
>
> I initially thought that it might fit in dbus.el, but it would be better
> to keep it essential and not to bother with the boring code-generating
> code.
>
> address@hidden writes:
>
>> I use Jan Moringens dbus-proxy in my Inkmacs project, which is an Emacs
>> interface for Inkscape.
>
> Nice. I'm playing with it as an example:
> https://github.com/ueno/inkmacs/commit/d5835d2bIt seems partly working (I got
> 'dbus-call-method: D-Bus error: "Object
> 'inkmacs-flow-layer' not found in document."', maybe my programming
> error somewhere).
Well, Inkmacs can be pretty funky to get working, and sometimes it
depends on a patched Inkscape with better dbus primitives. I cant
remember at the moment.
Thanks for having a look. I will try your dbus framework also.
>
> Regards,
> --
> Daiki Ueno
>
> From 2a01d1fc73017cb2550d1ec47207fd1f0427e8b5 Mon Sep 17 00:00:00 2001
> From: Daiki Ueno <address@hidden>
> Date: Wed, 25 Feb 2015 16:25:30 +0900
> Subject: [PATCH] Support automatic D-Bus proxy generation
>
> * lisp/net/dbus-codegen.el: New file.
> ---
> lisp/net/dbus-codegen.el | 329
> +++++++++++++++++++++++++++++++++++++++++++++++
> 1 file changed, 329 insertions(+)
> create mode 100644 lisp/net/dbus-codegen.el
>
> diff --git a/lisp/net/dbus-codegen.el b/lisp/net/dbus-codegen.el
> new file mode 100644
> index 0000000..e2550f9
> --- /dev/null
> +++ b/lisp/net/dbus-codegen.el
> @@ -0,0 +1,329 @@
> +;;; dbus-codegen.el --- Lisp code generation for D-Bus. -*- lexical-biding:
> t; -*-
> +
> +;; Copyright (C) 2015 Free Software Foundation, Inc.
> +
> +;; Author: Daiki Ueno <address@hidden>
> +;; Keywords: comm, hardware
> +
> +;; This file is part of GNU Emacs.
> +
> +;; GNU Emacs is free software: you can redistribute it and/or modify
> +;; it under the terms of the GNU General Public License as published by
> +;; the Free Software Foundation, either version 3 of the License, or
> +;; (at your option) any later version.
> +
> +;; GNU Emacs is distributed in the hope that it will be useful,
> +;; but WITHOUT ANY WARRANTY; without even the implied warranty of
> +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> +;; GNU General Public License for more details.
> +
> +;; You should have received a copy of the GNU General Public License
> +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.+
> +;;; Commentary:
> +
> +;; This package provides two interfaces to make D-Bus proxy
> +;; implementation easy. One is `define-dbus-proxy', which takes a
> +;; static definition of a D-Bus service and generates code at
> +;; byte-compilation time. The following code defines
> +;; `search-provider-make' and
> +;; `search-provider-get-initial-result-set'.
> +;;
> +;; (define-dbus-proxy search-provider "\
> +;; <node>
> +;; <interface name=\"org.gnome.Shell.SearchProvider2\">
> +;; <method name=\"GetInitialResultSet\">
> +;; <arg type=\"as\" name=\"terms\" direction=\"in\" />
> +;; <arg type=\"as\" name=\"results\" direction=\"out\" />
> +;; </method>
> +;; </interface>
> +;; </node>"
> +;; "org.gnome.Shell.SearchProvider2"
> +;; :transform-name #'dbus-codegen-transform-name)
> +;;
> +;; This is good for stable D-Bus services.
> +
> +;; The other is `make-dbus-proxy', which retrieves the D-Bus service
> +;; definition from the running service itself through D-Bus
> +;; introspection. This is good for unstable D-Bus services.
> +
> +;;; Code:
> +
> +(require 'dbus)
> +(require 'xml)
> +(require 'cl-lib)
> +(require 'subword)
> +
> +;; Base type of a D-Bus proxy.
> +(cl-defstruct (dbus-proxy
> + (:constructor nil))
> + (bus :read-only t)
> + (service :read-only t)
> + (path :read-only t))
> +
> +;; Return a list of elements in the form: (LISP-NAME ORIG-NAME MEMBER).
> +(defun dbus-codegen--apply-transform-name (elements transform-name)
> + (mapcar (lambda (elements)
> + (let ((name (xml-get-attribute-or-nil elements 'name)))
> + (unless name
> + (error "missing \"name\" attribute of %s"
> + (xml-node-name elements)))
> + (list (funcall transform-name name)
> + name
> + elements)))
> + elements))
> +
> +;; Return a list of symbols.
> +(defun dbus-codegen--collect-arglist (args transform-name)
> + (delq nil
> + (mapcar
> + (lambda (arg)
> + (let ((direction
> + (xml-get-attribute-or-nil (nth 2 arg) 'direction)))
> + (if (or (null direction)
> + (equal direction "in"))
> + (intern (car arg)))))
> + (dbus-codegen--apply-transform-name args transform-name))))
> +
> +(defun dbus-codegen-transform-name (name)
> + "Transform NAME into suitable Lisp function name."
> + (with-temp-buffer
> + (let (words)
> + (insert name)
> + (goto-char (point-min))
> + (while (not (eobp))
> + ;; Skip characters not recognized by subword-mode.
> + (if (looking-at "[^[:lower:][:upper:][:digit:]]+")
> + (goto-char (match-end 0)))
> + (push (downcase (buffer-substring (point) (progn (subword-forward 1)
> + (point))))
> + words))
> + (mapconcat #'identity (nreverse words) "-"))))
> +
> +;;;###autoload
> +(defmacro define-dbus-proxy (name xml interface &rest args)
> + "Define a new D-Bus proxy NAME.
> +This defines a new struct type for the proxy and convenient
> +functions for D-Bus method calls and signal registration.
> +
> +XML is either a string which defines the interface of the D-Bus
> +proxy, or a tree already parsed with `xml-parse-file'. It must
> +comply with the standard D-Bus introspection XML format, and can
> +contain only a single \"interface\" element under the root
> +\"node\" element.
> +
> +INTERFACE is an interface which is represented by this proxy.
> +
> +ARGS are keyword-value pair. Currently only one keyword is
> +supported:
> +
> +:transform-name FUNCTION -- FUNCTION is a function which converts
> +D-Bus method/signal/property names, into another representation.
> +Use `dbus-codegen-transform-name' to convert all
> +camel-cased names to suitable Lisp function names."
> + (unless (symbolp name)
> + (signal 'wrong-type-argument (list 'symbolp name)))
> + (unless (stringp xml)
> + (signal 'wrong-type-argument (list 'stringp xml)))
> + (let ((node (if (stringp xml)
> + (car (with-temp-buffer
> + (insert xml)
> + (xml-parse-region (point-min) (point-max))))
> + xml))
> + (transform-name (or (plist-get args :transform-name)
> + #'identity)))
> + (unless (eq (xml-node-name node) 'node)
> + (error "Root is not \"node\""))
> + (unless (functionp transform-name)
> + (setq transform-name (eval transform-name)))
> + (let ((interface-node
> + (cl-find-if (lambda (element)
> + (equal (xml-get-attribute-or-nil element 'name)
> + interface))
> + (xml-get-children node 'interface))))
> + (unless interface-node
> + (error "Interface %s is missing" interface))
> + (let ((methods (dbus-codegen--apply-transform-name
> + (xml-get-children interface-node 'method)
> + transform-name))
> + (properties (dbus-codegen--apply-transform-name
> + (xml-get-children interface-node 'properties)
> + transform-name))
> + (signals (dbus-codegen--apply-transform-name
> + (xml-get-children interface-node 'signals)
> + transform-name)))
> + `(progn
> + ;; Define a new struct.
> + (cl-defstruct (,name (:include dbus-proxy)
> + (:constructor nil)
> + (:constructor ,(intern (format "%s--make" name))
> + (bus service path)))
> + ;; Slots for cached property values.
> + ,@(mapcar
> + (lambda (property)
> + (intern (car property)))
> + properties))
> +
> + (defun ,(intern (format "%s-make" name)) (bus service path)
> + ,(format "Create a new D-Bus proxy for %s.
> +
> +BUS is either a Lisp symbol, `:system' or `:session', or a string
> +denoting the bus address.
> +
> +SERVICE is the D-Bus service name to be used. PATH is the D-Bus
> +object path SERVICE is registered at. INTERFACE is an interface
> +offered by SERVICE."
> + interface)
> + (let ((proxy (,(intern (format "%s--make" name))
> + bus service path)))
> + ,(when (and properties
> + ;; FIXME: See the handler definition below.
> + lexical-binding)
> + ;; Initialize slots.
> + `(let ((properties (dbus-get-all-properties bus service path
> + ,interface)))
> + ,@(mapcar
> + (lambda (property)
> + `(setf (,(intern (format "%s-%s" name (car property)))
> + proxy)
> + (cdr (assoc ,(nth 1 property) properties))))
> + properties)
> + (dbus-register-signal
> + bus service path dbus-interface-properties
> + "PropertiesChanged"
> + (lambda (interface changed invalidated)
> + (funcall
> + ,(intern (format "%s--handle-properties-changed"
> + name))
> + proxy
> + interface changed invalidated)))))
> + proxy))
> +
> + ;; Define a handler of PropertiesChanged signal.
> + (defun ,(intern (format "%s--handle-properties-changed" name))
> + (proxy interface changed invalidated)
> + (when (equal interface ,interface)
> + ,@(mapcar
> + (lambda (property)
> + `(setf (,(intern (format "%s-%s" name (car property)))
> + proxy)
> + (cdr (assoc ,(nth 1 property) changed))))
> + properties)))
> +
> + ;; Define wrappers around `dbus-call-method'.
> + ,@(mapcar
> + (lambda (method)
> + (let ((arglist (dbus-codegen--collect-arglist
> + (xml-get-children method 'arg)
> + transform-name)))
> + `(cl-defmethod
> + ,(intern (format "%s-%s" name (car method)))
> + ((proxy ,name) ,@arglist &rest args)
> + (apply #'dbus-call-method
> + (dbus-proxy-bus proxy)
> + (dbus-proxy-service proxy)
> + (dbus-proxy-path proxy)
> + ,interface
> + ,(nth 1 method)
> + ,@arglist
> + args))))
> + methods)
> +
> + ;; Define wrappers around `dbus-call-method-asynchronously'.
> + ,@(mapcar
> + (lambda (method)
> + (let ((arglist (dbus-codegen--collect-arglist
> + (xml-get-children method 'arg)
> + transform-name)))
> + `(cl-defmethod
> + ,(intern (format "%s-%s-asynchronously"
> + name (car method)))
> + ((proxy ,name) ,@arglist handler &rest args)
> + (apply #'dbus-call-method-asynchronously
> + (dbus-proxy-bus proxy)
> + (dbus-proxy-service proxy)
> + (dbus-proxy-path proxy)
> + ,interface
> + ,(nth 1 method)
> + handler
> + ,@arglist
> + args))))
> + methods)
> +
> + ;; Define wrappers around `dbus-register-signal'.
> + ,@(mapcar
> + (lambda (signal)
> + `(cl-defmethod
> + ,(intern (format "%s-register-%s-signal"
> + name (car signal)))
> + ((proxy ,name) handler &rest args)
> + (apply #'dbus-register-signal
> + (dbus-proxy-bus proxy)
> + (dbus-proxy-service proxy)
> + (dbus-proxy-path proxy)
> + ,interface
> + ,(nth 1 signal)
> + handler
> + args)))
> + signals)
> +
> + ;; Define wrappers around `dbus-send-signal'.
> + ,@(mapcar
> + (lambda (signal)
> + (let ((arglist (dbus-codegen--collect-arglist
> + (xml-get-children signal 'arg)
> + transform-name)))
> + `(cl-defmethod
> + ,(intern (format "%s-send-%s-signal"
> + name (car signal)))
> + ((proxy ,name) ,@arglist &rest args)
> + (apply #'dbus-register-signal
> + (dbus-proxy-bus proxy)
> + (dbus-proxy-service proxy)
> + (dbus-proxy-path proxy)
> + ,interface
> + ,(nth 1 signal)
> + ,@arglist
> + args))))
> + signals))))))
> +
> +;;;###autoload
> +(defun make-dbus-proxy (name bus service path interface &rest args)
> + "Create a new D-Bus proxy based on the introspection data.
> +
> +If the data type of the D-Bus proxy is not yet defined, this will
> +define it with `define-dbus-proxy', under a type name NAME.
> +
> +BUS is either a Lisp symbol, `:system' or `:session', or a string
> +denoting the bus address.
> +
> +SERVICE is the D-Bus service name to be used. PATH is the D-Bus
> +object path SERVICE is registered at. INTERFACE is an interface
> +offered by SERVICE.
> +
> +INTERFACE is an interface which is represented by this proxy.
> +
> +ARGS are keyword-value pair. Currently only one keyword is
> +supported:
> +
> +:redefine FLAG -- if FLAG is non-nil, redefine the data type and
> +associated functions.
> +
> +Other keywords are same as `define-dbus-proxy'."
> + (let ((constructor (intern (format "%s-make" name))))
> + (if (or (plist-get args :redefine)
> + (not (fboundp constructor)))
> + (eval `(define-dbus-proxy ,(intern name)
> + ,(dbus-introspect bus service path)
> + ,interface
> + ,@args)))
> + (funcall constructor bus service path)))
> +
> +(provide 'dbus-codegen)
> +
> +;;; TODO
> +
> +;; * Property setters
> +;; * Server-side code generation
> +
> +;;; dbus-codegen.el ends here
--
Joakim Verona