[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH] Support automatic D-Bus proxy generation
|
From: |
Daiki Ueno |
|
Subject: |
[PATCH] Support automatic D-Bus proxy generation |
|
Date: |
Wed, 25 Feb 2015 17:23:53 +0900 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/25.0.50 (gnu/linux) |
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/d5835d2b
It seems partly working (I got 'dbus-call-method: D-Bus error: "Object
'inkmacs-flow-layer' not found in document."', maybe my programming
error somewhere).
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
--
2.1.0