on-the-fly D-Bus proxy creation

on-the-fly D-Bus proxy creation

[Daiki Ueno]

[-- Attachment #1: Type: text/plain, Size: 1580 bytes --]

Hello,

There are several programming languages with support for D-Bus client
implementation.  For example, with the following code:
https://git.gnome.org/browse/gnome-shell/tree/js/ui/keyboard.js#n56

  const CaribouDaemonIface = '<node> \
  <interface name="org.gnome.Caribou.Daemon"> \
  <method name="Run" /> \
  <method name="Quit" /> \
  </interface> \
  </node>';

  const CaribouDaemonProxy = Gio.DBusProxy.makeProxyWrapper(CaribouDaemonIface);

One can call a D-Bus method as a normal method of CaribouDaemonProxy.
This is really handy and I wished to have similar feature in Elisp
(though I haven't ever written any practical D-Bus code in Elisp).

Thanks to cl-generic, I gave it a try.  With the attached code (far from
complete though), a client can be implemented as:

  (dbus-define-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>
      <!-- actually, there are more methods in this interface -->
    </interface>
  </node>")

Then you can create a client and call D-Bus methods:

  (setq search-provider
        (search-provider-make :session
                              "org.gnome.Weather.BackgroundService"
                              "/org/gnome/Weather/BackgroundService"))
  (search-provider-call-GetInitialResultSet search-provider '("tokyo"))

If this seems to be useful, I can finish it off as a patch.

Thanks,
--
Daiki Ueno

[-- Attachment #2: dbusproxy.el --]
[-- Type: text/plain, Size: 2253 bytes --]

(require 'dbus)

(eval-when-compile (require 'cl-lib))
(eval-when-compile (require 'xml))

(cl-defstruct dbus-proxy
  (bus :read-only t)
  (service :read-only t)
  (path :read-only t))

(defmacro dbus-define-proxy (name xml)
  (let* ((node (car (with-temp-buffer
		      (insert xml)
		      (xml-parse-region (point-min) (point-max)))))
	 (interface (car (xml-get-children node 'interface)))
	 (methods (xml-get-children interface 'method))
	 (interface-name (xml-get-attribute-or-nil interface 'name)))
    `(progn
       (cl-defstruct (,name (:include dbus-proxy)
			    (:constructor nil)
			    (:constructor ,(intern (format "%s-make" name))
			     (bus service path)))
	 ;; FIXME: slots for cached properties?
	 )
       ,@(mapcar
	  (lambda (method)
	    (let ((method-name (xml-get-attribute-or-nil method 'name))
		  ;; FIXME: parse argument types?
		  (in-args
		   (mapcar #'intern
			   (delq nil
				 (mapcar
				  (lambda (arg)
				    (let ((direction (xml-get-attribute-or-nil
						      arg 'direction)))
				      (if (or (null direction)
					      (not (equal direction "out")))
					  (xml-get-attribute-or-nil
					   arg 'name))))
				  (xml-get-children method 'arg))))))
	      ;; FIXME: un-CamelCasify method-name?
	      `(cl-defmethod ,(intern (format "%s-call-%s" name method-name))
			     ((proxy ,name) ,@in-args &rest args)
		 (apply #'dbus-call-method
			(dbus-proxy-bus proxy)
			(dbus-proxy-service proxy)
			(dbus-proxy-path proxy)
			,interface-name
			,method-name
			,@in-args
			args))))
	  methods)
       ;; FIXME: asynchronous method calls, signals?
       )))

(dbus-define-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>
    <!-- actually, there are more methods in this interface -->
  </interface>
</node>")

;; (setq search-provider
;;       (search-provider-make :session
;;                             "org.gnome.Weather.BackgroundService"
;;                             "/org/gnome/Weather/BackgroundService"))
;; (search-provider-call-GetInitialResultSet search-provider '("tokyo"))

Re: on-the-fly D-Bus proxy creation

[Michael Albinus]

Daiki Ueno <ueno@gnu.org> writes:

> Hello,

Hi,

> One can call a D-Bus method as a normal method of CaribouDaemonProxy.
> This is really handy and I wished to have similar feature in Elisp
> (though I haven't ever written any practical D-Bus code in Elisp).
>
> Thanks to cl-generic, I gave it a try.  With the attached code (far from
> complete though), a client can be implemented as:
>
>   (dbus-define-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>
>       <!-- actually, there are more methods in this interface -->
>     </interface>
>   </node>")
>
> Then you can create a client and call D-Bus methods:
>
>   (setq search-provider
>         (search-provider-make :session
>                               "org.gnome.Weather.BackgroundService"
>                               "/org/gnome/Weather/BackgroundService"))
>   (search-provider-call-GetInitialResultSet search-provider '("tokyo"))
>
> If this seems to be useful, I can finish it off as a patch.

There was some related work, see <http://thread.gmane.org/gmane.emacs.devel/128998>.
I don't know the status, 'tho.

> Thanks,
> 
> Daiki Ueno

Best regards, Michael.

Re: on-the-fly D-Bus proxy creation

[Daiki Ueno]

Michael Albinus <michael.albinus@gmx.de> writes:

(First of all, I am very sorry for making a mistake in the Cc list.)

>>   (dbus-define-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>
>>       <!-- actually, there are more methods in this interface -->
>>     </interface>
>>   </node>")
>>
>> Then you can create a client and call D-Bus methods:
>>
>>   (setq search-provider
>>         (search-provider-make :session
>>                               "org.gnome.Weather.BackgroundService"
>>                               "/org/gnome/Weather/BackgroundService"))
>>   (search-provider-call-GetInitialResultSet search-provider '("tokyo"))
>>
>> If this seems to be useful, I can finish it off as a patch.
>
> There was some related work, see
> <http://thread.gmane.org/gmane.emacs.devel/128998>.
> I don't know the status, 'tho.

Thanks for the information.  I'll try to contact the author (Cc'ed
anyway).

The main differences of mine from that one are:

- 'dbus-define-proxy' is a macro instead of a function.  So, XML parsing
  and code generation happen at byte-compile time.

- it doesn't rely on introspection, but takes an interface definition in
  XML.  I think that's what other languages do these days.

Regards,
--
Daiki Ueno

Re: on-the-fly D-Bus proxy creation

[Michael Albinus]

Daiki Ueno <ueno@gnu.org> writes:

> - it doesn't rely on introspection, but takes an interface definition in
>   XML.  I think that's what other languages do these days.

Introspection is also based on XML interface definitions. Its advantage
is that interface changes will be seen immediately. The disadvantage is,
that not all D-Buse services offer interfaces for introspection. And it
might be slower.

> Regards,
> --
> Daiki Ueno

Best regards, Michael.

Re: on-the-fly D-Bus proxy creation

[Daiki Ueno]

Michael Albinus <michael.albinus@gmx.de> writes:

>> - it doesn't rely on introspection, but takes an interface definition in
>>   XML.  I think that's what other languages do these days.
>
> Introspection is also based on XML interface definitions.  Its
> advantage is that interface changes will be seen immediately.

Flexibility is good, but does it work well with byte-compilation?  It
wouldn't be great if one needs to write a declare-function to suppress
'the function XXX is not known to be defined' warnings for proxy
functions defined at run-time.

Of course it could be suppressed, but from my experience with
gdbus-codegen[1], one of the benefits of auto-generated D-Bus proxy is that
it could help detect programming errors at compile time.

> The disadvantage is, that not all D-Buse services offer interfaces for
> introspection. And it might be slower.

Absolutely.

Regards,
--
Daiki Ueno

Footnotes: 
[1]  https://developer.gnome.org/gio/stable/gdbus-codegen.html

Re: on-the-fly D-Bus proxy creation

[joakim]

Daiki Ueno <ueno@gnu.org> writes:

> Hello,

Hello Daiki,

>
> There are several programming languages with support for D-Bus client
> implementation.  For example, with the following code:
> https://git.gnome.org/browse/gnome-shell/tree/js/ui/keyboard.js#n56
>
>   const CaribouDaemonIface = '<node> \
>   <interface name="org.gnome.Caribou.Daemon"> \
>   <method name="Run" /> \
>   <method name="Quit" /> \
>   </interface> \
>   </node>';

I use Jan Moringens dbus-proxy in my Inkmacs project, which is an Emacs
interface for Inkscape. 

It would be nice if there were comparable functionality directly in
Emacs or ELPA.

>
>   const CaribouDaemonProxy = Gio.DBusProxy.makeProxyWrapper(CaribouDaemonIface);
>
> One can call a D-Bus method as a normal method of CaribouDaemonProxy.
> This is really handy and I wished to have similar feature in Elisp
> (though I haven't ever written any practical D-Bus code in Elisp).
>
> Thanks to cl-generic, I gave it a try.  With the attached code (far from
> complete though), a client can be implemented as:
>
>   (dbus-define-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>
>       <!-- actually, there are more methods in this interface -->
>     </interface>
>   </node>")
>
> Then you can create a client and call D-Bus methods:
>
>   (setq search-provider
>         (search-provider-make :session
>                               "org.gnome.Weather.BackgroundService"
>                               "/org/gnome/Weather/BackgroundService"))
>   (search-provider-call-GetInitialResultSet search-provider '("tokyo"))
>
> If this seems to be useful, I can finish it off as a patch.
>
> Thanks,
> --
> Daiki Ueno
>
> (require 'dbus)
>
> (eval-when-compile (require 'cl-lib))
> (eval-when-compile (require 'xml))
>
> (cl-defstruct dbus-proxy
>   (bus :read-only t)
>   (service :read-only t)
>   (path :read-only t))
>
> (defmacro dbus-define-proxy (name xml)
>   (let* ((node (car (with-temp-buffer
> 		      (insert xml)
> 		      (xml-parse-region (point-min) (point-max)))))
> 	 (interface (car (xml-get-children node 'interface)))
> 	 (methods (xml-get-children interface 'method))
> 	 (interface-name (xml-get-attribute-or-nil interface 'name)))
>     `(progn
>        (cl-defstruct (,name (:include dbus-proxy)
> 			    (:constructor nil)
> 			    (:constructor ,(intern (format "%s-make" name))
> 			     (bus service path)))
> 	 ;; FIXME: slots for cached properties?
> 	 )
>        ,@(mapcar
> 	  (lambda (method)
> 	    (let ((method-name (xml-get-attribute-or-nil method 'name))
> 		  ;; FIXME: parse argument types?
> 		  (in-args
> 		   (mapcar #'intern
> 			   (delq nil
> 				 (mapcar
> 				  (lambda (arg)
> 				    (let ((direction (xml-get-attribute-or-nil
> 						      arg 'direction)))
> 				      (if (or (null direction)
> 					      (not (equal direction "out")))
> 					  (xml-get-attribute-or-nil
> 					   arg 'name))))
> 				  (xml-get-children method 'arg))))))
> 	      ;; FIXME: un-CamelCasify method-name?
> 	      `(cl-defmethod ,(intern (format "%s-call-%s" name method-name))
> 			     ((proxy ,name) ,@in-args &rest args)
> 		 (apply #'dbus-call-method
> 			(dbus-proxy-bus proxy)
> 			(dbus-proxy-service proxy)
> 			(dbus-proxy-path proxy)
> 			,interface-name
> 			,method-name
> 			,@in-args
> 			args))))
> 	  methods)
>        ;; FIXME: asynchronous method calls, signals?
>        )))
>
> (dbus-define-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>
>     <!-- actually, there are more methods in this interface -->
>   </interface>
> </node>")
>
> ;; (setq search-provider
> ;;       (search-provider-make :session
> ;;                             "org.gnome.Weather.BackgroundService"
> ;;                             "/org/gnome/Weather/BackgroundService"))
> ;; (search-provider-call-GetInitialResultSet search-provider '("tokyo"))
>

-- 
Joakim Verona

[PATCH] Support automatic D-Bus proxy generation

[Daiki Ueno]

[-- Attachment #1: Type: text/plain, Size: 938 bytes --]

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.

joakim@verona.se 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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Support-automatic-D-Bus-proxy-generation.patch --]
[-- Type: text/x-patch, Size: 11521 bytes --]

From 2a01d1fc73017cb2550d1ec47207fd1f0427e8b5 Mon Sep 17 00:00:00 2001
From: Daiki Ueno <ueno@gnu.org>
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 <ueno@gnu.org>
+;; 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

Re: [PATCH] Support automatic D-Bus proxy generation

[joakim]

Daiki Ueno <ueno@gnu.org> 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.
>
> joakim@verona.se 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 <ueno@gnu.org>
> 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 <ueno@gnu.org>
> +;; 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