From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Daiki Ueno Newsgroups: gmane.emacs.devel Subject: [PATCH] Support automatic D-Bus proxy generation Date: Wed, 25 Feb 2015 17:23:53 +0900 Message-ID: References: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1424852652 1120 80.91.229.3 (25 Feb 2015 08:24:12 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 25 Feb 2015 08:24:12 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Feb 25 09:24:06 2015 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1YQXGI-0001mH-4t for ged-emacs-devel@m.gmane.org; Wed, 25 Feb 2015 09:24:06 +0100 Original-Received: from localhost ([::1]:53275 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YQXGH-0002EO-Aj for ged-emacs-devel@m.gmane.org; Wed, 25 Feb 2015 03:24:05 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:35545) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YQXGC-0002EF-2O for emacs-devel@gnu.org; Wed, 25 Feb 2015 03:24:02 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YQXGA-0000Ij-2O for emacs-devel@gnu.org; Wed, 25 Feb 2015 03:24:00 -0500 Original-Received: from fencepost.gnu.org ([2001:4830:134:3::e]:57562) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YQXG9-0000Ie-UR for emacs-devel@gnu.org; Wed, 25 Feb 2015 03:23:57 -0500 Original-Received: from du-a.org ([2001:e41:db5e:fb14::1]:60427 helo=localhost.localdomain) by fencepost.gnu.org with esmtpsa (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1YQXG8-0001TS-T0 for emacs-devel@gnu.org; Wed, 25 Feb 2015 03:23:57 -0500 In-Reply-To: (joakim@verona.se's message of "Tue, 24 Feb 2015 16:13:49 +0100") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.0.50 (gnu/linux) X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2001:4830:134:3::e X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:183484 Archived-At: --=-=-= Content-Type: text/plain 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 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Support-automatic-D-Bus-proxy-generation.patch >From 2a01d1fc73017cb2550d1ec47207fd1f0427e8b5 Mon Sep 17 00:00:00 2001 From: Daiki Ueno 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 +;; 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 . + +;;; 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 "\ +;; +;; +;; +;; +;; +;; +;; +;; " +;; "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 --=-=-=--