From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Jan Moringen Newsgroups: gmane.emacs.devel Subject: Inclusion of dbus-proxy Date: Sun, 22 Aug 2010 00:03:33 +0200 Message-ID: <4045_1282428217_ZZh07312bUcyR.00_1282428214.23884.594.camel@steed.robot-madness> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="Boundary_(ID_+FgRhfigVZn1+uFep0W1iw)" X-Trace: dough.gmane.org 1282428258 16951 80.91.229.12 (21 Aug 2010 22:04:18 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Sat, 21 Aug 2010 22:04:18 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun Aug 22 00:04:16 2010 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1OmwAQ-0002K0-8t for ged-emacs-devel@m.gmane.org; Sun, 22 Aug 2010 00:04:16 +0200 Original-Received: from localhost ([127.0.0.1]:44755 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1OmwAO-0003g8-7M for ged-emacs-devel@m.gmane.org; Sat, 21 Aug 2010 18:03:56 -0400 Original-Received: from [140.186.70.92] (port=46604 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1OmwAD-0003g3-4x for emacs-devel@gnu.org; Sat, 21 Aug 2010 18:03:48 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.69) (envelope-from ) id 1OmwA9-00060o-CQ for emacs-devel@gnu.org; Sat, 21 Aug 2010 18:03:44 -0400 Original-Received: from mux2-unibi-smtp.hrz.uni-bielefeld.de ([129.70.204.73]:34228) by eggs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1OmwA8-00060S-OV for emacs-devel@gnu.org; Sat, 21 Aug 2010 18:03:41 -0400 Original-Received: from pmxchannel-daemon.mux2-unibi-smtp.hrz.uni-bielefeld.de by mux2-unibi-smtp.hrz.uni-bielefeld.de (Sun Java(tm) System Messaging Server 6.3-6.03 (built Mar 14 2008; 32bit)) id <0L7I00G00VY1S700@mux2-unibi-smtp.hrz.uni-bielefeld.de> for emacs-devel@gnu.org; Sun, 22 Aug 2010 00:03:38 +0200 (CEST) Original-Received: from [192.168.2.100] ([217.25.161.12]) by mux2-unibi-smtp.hrz.uni-bielefeld.de (Sun Java(tm) System Messaging Server 6.3-6.03 (built Mar 14 2008; 32bit)) with ESMTPPSA id <0L7I00CH8VXZDG30@mux2-unibi-smtp.hrz.uni-bielefeld.de> for emacs-devel@gnu.org; Sun, 22 Aug 2010 00:03:36 +0200 (CEST) X-Mailer: Evolution 2.30.3 X-EnvFrom: jan.moringen@uni-bielefeld.de X-PMX-Version: 5.5.9.395186, Antispam-Engine: 2.7.2.376379, Antispam-Data: 2010.8.21.215415, pmx7 X-Connecting-IP: 217.25.161.12 X-detected-operating-system: by eggs.gnu.org: Solaris 10 (beta) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:128998 Archived-At: --Boundary_(ID_+FgRhfigVZn1+uFep0W1iw) Content-type: text/plain; charset=UTF-8 Content-transfer-encoding: 7BIT Hi, I recently developed dbus-proxy, a framework that makes accessing remote D-Bus objects from Emacs Lisp easier and more transparent than the current `dbus-call-method' mechanism. Since I was encouraged to propose it for inclusion in Emacs, I'm hereby doing so. Besides being attached, the code is also available here: http://bazaar.launchpad.net/~scymtym/+junk/dbus-proxy/files Let me start with a simple example of how a typical usage of dbus-proxy looks: (let ((device-kit (dbus-proxy-make-remote-proxy :system "org.freedesktop.DeviceKit" "/org/freedesktop/DeviceKit"))) ;; Retrieve the daemon-version property. (slot-value device-kit :daemon-version) (oref device-kit :daemon-version) ;; Connect to the device-event signal. (connect device-kit 'device-event (lambda (&rest args) (message "Device event %s" args))) ;; Enumerate subsystems. (enumerate-by-subsystem device-kit '("sound"))) This example creates a proxy object for the device kit D-Bus object and uses its methods, properties and signals. dbus-proxy uses D-Bus introspection information to dynamically create classes and methods that reflect the structure of the remote interface in Emacs Lisp as naturally as possible. For example, `describe-class' can used to inspect the methods supported by a particular D-Bus object. dbus-proxy consists of the following components: + dbus-proxy.el + public programming interface + interface analysis + proxy superclasses + code generation + unit tests + dbus-introspection.el + accessors for D-Bus introspection data (similar to those in dbus.el) + parsing of signature strings + unit tests I am aware of the following problems with respect to the inclusion in Emacs: + Names: + Generated class names tend to be long and ugly and do not follow usual Lisp conventions + `connect' and `disconnect' may need a `dbus-proxy-' prefix? + The generated class hierarchies only work with the :c3 method resolution order which was added to EIEIO upstream a few months ago but does not seem to have been merged yet + The unit tests use ert which is also not currently included in Emacs + The use of the cl library may or may not be acceptable I have signed the copyright assignment for Emacs. What do you think? Kind regards, Jan --Boundary_(ID_+FgRhfigVZn1+uFep0W1iw) Content-type: text/x-changelog; name=ChangeLog; charset=UTF-8 Content-transfer-encoding: 7BIT Content-disposition: attachment; filename=ChangeLog 2010-08-21 Jan Moringen Added tests for type parsers in dbus-introspection.el * dbus-introspection.el (header): added version 0.2 to history section (test dbus-introspection-test-parse-simple-type-smoke): new test; smoke test for `dbus-proxy-parse-simple-type' (test dbus-introspection-test-parse-composite-type-smoke): new test; smoke test for `dbus-proxy-parse-composite-type' (test dbus-introspection-test-parse-type-list-smoke): new test; smoke test for `dbus-proxy-parse-type-list' Support parsing of lists of types in dbus-introspection.el * dbus-introspection.el (dbus-proxy-parse-composite-type): do not encapsulate the single subtype of an array in a list; call `dbus-proxy-parse-type-list' when multiple subtypes are allowed (dbus-proxy-parse-type-list): new function; parse a string containing a list of type designators Improved dbus-proxy-parse-composite-type in dbus-introspection.el * dbus-introspection.el (dbus-proxy-parse-composite-type): made this work properly in most cases; removed handling of variant type which is not really a composite type; added documentation string Better error handling for simple types in dbus-introspection.el * dbus-introspection.el (malformed-signature): new condition symbol; this condition is signaled when parsing of a type signature fails (dbus-proxy-parse-simple-type): signal `malformed-signature' instead of using `error'; added documentation string; cleanup Added test dbus-proxy-test-gdm in dbus-proxy.el * dbus-proxy.el (test dbus-proxy-test-gdm): new test; added because the Gdm object has methods that return object paths Changed DBus -> D-Bus in all comments in dbus-proxy.el * dbus-proxy.el: changed DBus -> D-Bus in all comments 2010-08-15 Jan Moringen Added unit test for interaction with rhythmbox in dbus-proxy.el * dbus-proxy.el (test dbus-proxy-test-rhythmbox): new test; test some interaction with the rhythmbox application Removed resolved TODO tags in dbus-proxy.el * dbus-proxy.el (dbus-proxy-make-interface-class): removed TODO tag about defining the condition symbols Added unit test for connecting signals in dbus-proxy.el * dbus-proxy.el (test dbus-proxy-test-connect): new test; test connecting DBus signals to handlers Test constructing proxy for system bus object in dbus-proxy.el * dbus-proxy.el (test dbus-proxy-test-make-remote-proxy): also test constructing a proxy for an object that resides on the system bus Added conditions no-such-{property, signal} in dbus-proxy.el * dbus-proxy.el (condition no-such-property): new condition; signaled when a specified property cannot be found (condition no-such-signal): new condition; signaled when a specified signal cannot be found Added TODO which contains a list of unresolved issues * TODO: new file; list of unresolved issues 2010-08-13 Jan Moringen Extended unit test in dbus-proxy.el * dbus-proxy.el (test dbus-proxy-test-mission-control): improved comment (test dbus-proxy-test-devicekit): improved tests for slot access; test connecting signals Signal connect and disconnect methods in dbus-proxy.el * dbus-proxy.el (header): bumped version to 0.3 section; extended description in commentary section to cover handling of properties and signals; added version 0.3 to history section (dbus-proxy-remote-object::connect): new method; connect a handler to a DBus signal (dbus-proxy-remote-object::disconnect): new method; disconnect a handler from a DBus signal (dbus-proxy-make-method): cosmetic changes in logging (dbus-proxy-make-interface-class): generate `dbus-proxy-find-signal' method for the interface class; cosmetic changes in logging (dbus-proxy-make-object-class): cosmetic changes in logging Find slot properties using stored interface info in dbus-proxy.el * dbus-proxy.el (dbus-proxy-remote-object::slot-missing): moved into this class from `dbus-proxy-interface-object'; use `dbus-proxy-find-property' to find interface name and property name (dbus-proxy-interface-object::slot-missing): moved to `dbus-proxy-remote-object' class (dbus-proxy-make-interface-class): generate `dbus-proxy-find-property' method for the interface class 2010-08-12 Jan Moringen Store properties and signals in interface slots in dbus-proxy.el * dbus-proxy.el (dbus-proxy-interface-object::properties): new slot; list of properties in the interface (dbus-proxy-interface-object::signals): new slot; list of signals in the interface (dbus-proxy-transform-property-name-function): new variable; the value is a function that transforms DBus property names into suitable slot names (dbus-proxy-transform-signal-name-function): new variable; the value is a function that transforms DBus signal names into suitable signal names (dbus-proxy-make-property-name): new function; transform a DBus property name into a slot name (dbus-proxy-make-signal-name): new function; transform a DBus signal name into a lispy signal name (dbus-proxy-make-interface-class): compute and install values for properties and signals slots Reanimated signal {,dis}connect methods in dbus-proxy.el * dbus-proxy.el (dbus-proxy-remote-object::connect): renamed `dbus-proxy-connect' -> `connect'; reanimated as stub (dbus-proxy-remote-object::disconnect): renamed `dbus-proxy-disconnect' -> `disconnect'; reanimated as stub Increased sophistication of method name transform in dbus-proxy.el * dbus-proxy.el (dbus-proxy-transform-method-name-function): changed value to `dbus-proxy-transform-method-name' (dbus-proxy-transform-method-name): new function; transform method names using `dbus-proxy-transform-camel-case' and additional rules (dbus-proxy-transform-camel-case): improved documentation string (test dbus-proxy-test-transform-camel-case-smoke): added more cases Added property introspection functions in dbus-introspection.el * dbus-introspection.el (dbus-property-p): new function; predicate for property introspection elements (dbus-property-name): new function; name accessor for property introspection elements (dbus-property-type): new function; type accessor for property introspection elements (dbus-property-access): new function; access accessor for property introspection elements (dbus-interface-properties): new function; return property elements of an introspection interface 2010-08-11 Jan Moringen Added some comments in dbus-introspection.el * dbus-introspection.el: added some comments Added new introspection accessors in dbus-introspection.el * dbus-introspection.el (dbus-signal-name): new method; return name of a signal introspection element (dbus-interface-methods): new method; return method elements of an interface element (dbus-interface-signals): new method; return signal elements of an introspection element Added docstring to -simple-type-codes in dbus-introspection.el * dbus-introspection.el (dbus-proxy-simple-type-codes): added documentation string Added variant type to -simple-type-codes in dbus-introspection.el * dbus-introspection.el (dbus-proxy-simple-type-codes): added code for variant type 2010-08-10 Jan Moringen Generate type specifiers in DBus method calls in dbus-proxy.el * dbus-proxy.el (dbus-proxy-make-method): call `dbus-proxy-make-call-args' to construct call arguments (dbus-proxy-make-call-args): new function; construct typed call arguments based on DBus argument specification if possible (dbus-proxy-test-make-call-arg-smoke): new unit test; smoke test for `dbus-proxy-make-call-args' Added function dbus-arg-type in dbus-introspection.el * dbus-introspection.el (dbus-proxy-simple-type-codes): added type ?d (dbus-arg-type): new function; return type of DBus argument 2010-08-09 Jan Moringen Add documentation strings to generated classes in dbus-proxy.el * dbus-proxy.el (dbus-proxy-make-object-class): generate a simple documentation string for the generated class 2010-08-08 Jan Moringen Added messages to code generating functions in dbus-proxy.el * dbus-proxy.el (dbus-proxy-make-method): added a message (dbus-proxy-make-interface-class): likewise (dbus-proxy-make-object-class): likewise Make redefinition actual work in dbus-proxy.el * dbus-proxy.el (dbus-proxy-make-remote-proxy): added optional argument redefine-classes (dbus-proxy-make-method-name): use `dbus-proxy-symbol-unsuitable-for-method' instead of just `fboundp' (dbus-proxy-make-object-class): added optional argument redefine-interface-classes (dbus-proxy-ensure-object-class): pass redefine argument to `dbus-proxy-make-object-class' (dbus-proxy-symbol-unsuitable-for-method): new function; check whether a method can be installed on a symbol 2010-08-07 Jan Moringen Added and improved docstrings in dbus-proxy.el (dbus-proxy-interface-object::slot-missing): added documentation string (dbus-proxy-interface-object::object-print): likewise (dbus-proxy-transform-method-name-function): likewise (test dbus-proxy-test-transform-camel-case-smoke): refer to correct function in documentation string Added a method name transformation facility in dbus-proxy.el * dbus-proxy.el (header): added version field; extended and adapted algorithm description in commentary section; bumped version to 0.2 in version section (dbus-proxy-transform-method-name-function): new variable; function used to transform DBus method names into corresponding lisp function names (dbus-proxy-make-method-name): new function; transforms a DBus method name into a lisp method name by applying `dbus-proxy-transform-method-name-function' and uniquifying the result (dbus-proxy-make-method): call `dbus-proxy-make-method-name' to obtain the name of the new method (dbus-proxy-transform-camel-case): new function; default name transformation function (test dbus-proxy-test-transform-camel-case-smoke): new unit test; test basic behavior of `dbus-proxy-transform-camel-case' (test dbus-proxy-test-dbus): expect transformed method names (test dbus-proxy-test-mission-control): likewise (test dbus-proxy-test-epiphany): likewise (test dbus-proxy-test-devicekit): likewise Added and improved unit tests in dbus-proxy.el * dbus-proxy.el (test dbus-proxy-test-make-remote-proxy): commented out expected error since we cannot implement this right now (test dbus-proxy-test-dbus): renamed `dbus-proxy-test-bus-proxy' -> `dbus-proxy-test-dbus' (test dbus-proxy-test-mission-control): new unit test; call some methods on the mission control object Added new unit tests in dbus-proxy.el * dbus-proxy.el (test dbus-proxy-test-bus-proxy): removed; split into dbus-proxy-test-bus-proxy, dbus-proxy-test-epiphany and dbus-proxy-test-devicekit (dbus-proxy-test-make-remote-proxy): new unit test; tests for `dbus-proxy-make-remote-proxy' (test dbus-proxy-test-bus-proxy): new unit test; call some methods on the DBus object (test dbus-proxy-test-epiphany): new unit test; call some methods on the epiphany browser object (test dbus-proxy-test-devicekit): new unit test; call some methods on the devicekit object Added a comment in dbus-proxy.el * dbus-proxy.el (dbus-proxy-get-object-class): added a comment Improved implementations of code generators in dbus-proxy.el * dbus-proxy.el (dbus-proxy-make-method): improved implementation; added documentation string (dbus-proxy-make-interface-class): improved implementation (dbus-proxy-make-object-class): improved implementation Use -ensure-object-class in -make-remote-proxy in dbus-proxy.el * dbus-proxy.el (dbus-proxy-make-remote-proxy): use `dbus-proxy-ensure-object-class' instead of -get and -make Reorganized getting, creating, ensuring of things in dbus-proxy.el * dbus-proxy.el (dbus-proxy-get-interface-class): moved (dbus-proxy-ensure-interface-class): new function; find interface class, creating it if necessary (dbus-proxy-get-object-class): moved (dbus-proxy-get-interface-class): new function; find object class, creating it if necessary Reordering in dbus-proxy.el * dbus-proxy.el (dbus-proxy-make-interface-class-symbol): moved to interface section (dbus-proxy-make-object-class-symbol): moved to object section Smarter conditional definition of unit tests in dbus-proxy.el * dbus-proxy.el (dbus-proxy-make-interface-class): added some comments (unit tests): require ert without error to conditionally define unit tests Added object-print method for interface objects in dbus-proxy.el * dbus-proxy.el (dbus-proxy-interface-object::object-print): new method; return string representation of the interface object (call): removed; obsolete (connect): renamed `connect' -> `dbus-proxy-connect'; commented out for now Fixed proxy creation in unit tests in dbus-proxy.el * dbus-proxy.el (unit tests): fixed calls to `dbus-proxy-make-remote-proxy' Renamed object class and added interface class in dbus-proxy.el * dbus-proxy.el (dbus-proxy-remote-object): renamed `dbus-proxy' -> `dbus-proxy-remote-object' (dbus-proxy-interface-object): new class; represents DBus interfaces (dbus-proxy-interface-object::slot-missing): now specialized on `dbus-proxy-interface-object'; cleanup; added comments (dbus-proxy-make-interface-class): interface class are subclasses of `dbus-proxy-interface object' Added docstrings to class dbus-proxy in dbus-proxy.el * dbus-proxy.el (dbus-proxy::service): added documentation string (dbus-proxy::object): likewise (dbus-proxy): improved documentation string Removed obsolete eval-backup in dbus-proxy.el * dbus-proxy.el (dbus-proxy-make-remote-proxy): comment changes (eval-backup): removed Renamed dbus-proxy-make-remote-proxy in dbus-proxy.el * dbus-proxy.el (header): updated copyright; updated commentary and history sections (dbus-proxy-make-remote-proxy): renamed `dbus-proxy-make-proxy' -> `dbus-proxy-make-remote-proxy' Minor cosmetic improvements in dbus-introspection.el * dbus-introspection.el (header): added one-line description; updated copyright; added keywords; added contents to commentary and history sections --Boundary_(ID_+FgRhfigVZn1+uFep0W1iw) Content-type: text/x-emacs-lisp; name=dbus-introspection.el; charset=UTF-8 Content-transfer-encoding: 7BIT Content-disposition: attachment; filename=dbus-introspection.el ;;; dbus-introspection.el --- Helper functions for D-Bus introspection ;; ;; Copyright (C) 2009, 2010 Jan Moringen ;; ;; Author: Jan Moringen ;; Keywords: dbus, ipc ;; Version: 0.1 ;; X-RCS: $Id:$ ;; ;; This Program 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. ;; ;; This Program 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 this program. If not, see . ;;; Commentary: ;; ;; Helper functions for the `dbus-proxy' library. ;;; History: ;; ;; 0.2 - Parsing of complex signatures ;; ;; 0.1 - Initial version ;;; Code: ;; (require 'dbus) ;;; Error Conditions ;; ;; malformed-signature (intern "malformed-signature") (put 'malformed-signature 'error-conditions '(error malformed-signature)) (put 'malformed-signature 'error-message "Malformed signature signature") ;;; ;; (defconst dbus-proxy-simple-type-codes '((?b . :boolean) (?y . :byte) (?n . :int16) (?q . :uint16) (?i . :int32) (?u . :uint32) (?x . :int64) (?t . :uint64) (?d . :double) (?s . :string) (?o . :object-path) (?g . :signature) (?v . :variant)) "Mapping type indication characters to type keywords") (defun dbus-proxy-parse-simple-type (string) "Parse (a substring of) STRING as a simple type designator. The returned value is of the form (TYPE CONSUMED) where the number of consumed characters is always one. If STRING is not recognized as starting with a simple type designator, a `malformed-signature' error condition is signaled. A list of recognized simple type designators is available in the variable `dbus-proxy-simple-type-codes." (let ((type (cdr (assoc (aref string 0) dbus-proxy-simple-type-codes)))) (if type (list type 1) (signal 'malformed-signature (list "Unknown simple type designator" string))))) (defun dbus-proxy-parse-composite-type (string) "Parse (a substring of) STRING as composite type designator. A composite type is a simple type or one of struct, array or dict-entry. The returned value is of the form (TYPE CONSUMED) where the number of consumed characters is at least one but potentially less than the length of STRING. TYPE is a list starting with a type keyword: \(SIMPLE\) for SIMPLE one of the cdrs in `dbus-proxy-simple-type-codes' \(:struct (SUBSTYPE1 SUBTYPE2 ...)\) \(:array SUBTYPE\) \(:dict-entry (KEYTYPE VALUETYPE)\)" (destructuring-bind (outer inner consumed) (case (aref string 0) ;; Closing delimiters are consumed without generating ;; anything. ((?\) ?}) (list nil nil 1)) ;; Struct type ((?r ?\() (destructuring-bind (types consumed) (dbus-proxy-parse-type-list (substring string 1)) (unless (= (aref string consumed) ?\)) ;; TODO check end of string (signal 'malformed-signature (list "struct misses closing parenthesis"))) `(:struct ,types ,consumed))) ;; Array type (?a `(:array ,@(dbus-proxy-parse-composite-type (substring string 1)))) ;; Dict entry type. ;; ;; From the D-Bus spec: The restrictions are: it occurs only as ;; an array element type; it has exactly two single complete ;; types inside the curly braces; the first single complete ;; type (the "key") must be a basic type rather than a ;; container type. ((?e ?{) (destructuring-bind (types consumed) (dbus-proxy-parse-type-list (substring string 1)) (unless (= (length types) 2) (signal 'malformed-signature (list "dict entry has to contain exactly two types"))) (unless (= (aref string consumed) ?}) ;; TODO check end of string (signal 'malformed-signature (list "dict entry misses closing curly brace"))) `(:dict-entry ,types ,consumed))) (t `(nil ,@(dbus-proxy-parse-simple-type string)))) ;; Return the parsed type as a list of the form (TYPE CONSUMED). (cond (outer (list (list outer inner) (1+ consumed))) (inner (list inner consumed)) (t (list nil consumed))))) (defun dbus-proxy-parse-type-list (string) "Parse STRING as a list of type designators. The returned value is of the form (TYPES CONSUMED). Where consumed is equal to the length of STRING. TYPES is a list of types \(TYPE1 TYPE2 ...\) where each element is of the form produced by `dbus-proxy-parse-type-list'." (let ((remaining string) (all-consumed 0) (all-types)) (catch 'early (while (> (length remaining) 0) (destructuring-bind (type consumed) (dbus-proxy-parse-composite-type remaining) (setq remaining (substring remaining consumed)) (incf all-consumed consumed) (if type (push type all-types) (throw 'early nil))))) (list (reverse all-types) all-consumed))) ;;; Predicates and accessors for dbus types. ;; ;; Argument introspection elements (defsubst dbus-arg-p (element) (eq (car-safe element) 'arg)) (defsubst dbus-arg-name (arg) (cdr (assoc 'name (second arg)))) (defsubst dbus-arg-type (arg) (cdr (assoc 'type (second arg)))) (defsubst dbus-arg-in-p (arg) (string= (cdr (assoc 'direction (second arg))) "in")) ;; Property introspection elements (defsubst dbus-property-p (element) (eq (car-safe element) 'property)) (defsubst dbus-property-name (property) (cdr (assoc 'name (second property)))) (defsubst dbus-property-type (property) (cdr (assoc 'type (second property)))) (defsubst dbus-property-access (property) (cdr (assoc 'access (second property)))) ;; Method introspection elements (defsubst dbus-method-p (element) (eq (car-safe element) 'method)) (defsubst dbus-method-name (method) (cdr (assoc 'name (second method)))) ;; Signal introspection elements (defsubst dbus-signal-p (element) (eq (car-safe element) 'signal)) (defsubst dbus-signal-name (signal) (cdr (assoc 'name (second signal)))) ;; Interface introspection elements (defsubst dbus-interface-name (interface) (cdr (assoc 'name (second interface)))) (defsubst dbus-interface-elements (interface) (cddr interface)) (defsubst dbus-interface-properties (interface) (remove-if-not #'dbus-property-p (cddr interface))) (defsubst dbus-interface-methods (interface) (remove-if-not #'dbus-method-p (cddr interface))) (defsubst dbus-interface-signals (interface) (remove-if-not #'dbus-signal-p (cddr interface))) (provide 'dbus-introspection) ;;; Unit Tests: ;; (eval-when-compile (when (require 'ert nil t) (ert-deftest dbus-introspection-test-parse-simple-type-smoke () "Smoke test for the `dbus-proxy-parse-simple-type' function." (dolist (case '(("u" (:uint32 1)) ("ab" error) ("!" error))) (destructuring-bind (input expected) case (if (eq expected 'error) (should-error (dbus-proxy-parse-simple-type input) :type 'error) (should (equal (dbus-proxy-parse-simple-type input) expected))))) ) (ert-deftest dbus-introspection-test-parse-composite-type-smoke () "Smoke test for the `dbus-proxy-parse-composite-type' function." (dolist (case '(;; Simple ("i" (:int32 1)) ("ii" (:int32 1)) ("u" (:uint32 1)) ("uu" (:uint32 1)) ;; Struct ("(u)" ((:struct (:uint32)) 3)) ("(v)" ((:struct (:variant)) 3)) ("(ii)" ((:struct (:int32 :int32)) 4)) ("(i(ii))" ((:struct (:int32 (:struct (:int32 :int32)))) 7)) ("(ius)" ((:struct (:int32 :uint32 :string)) 5)) ("(ii" error) ("ii)" (:int32 1)) ;; Array ("au" ((:array :uint32) 2)) ("ai" ((:array :int32) 2)) ("av" ((:array :variant) 2)) ("a(ii)" ((:array (:struct (:int32 :int32))) 5)) ("aai" ((:array (:array :int32)) 3)) ("aa" error) ;; Dict entry ("a{su}" ((:array (:dict-entry (:string :uint32))) 5)) ("a{su}s" ((:array (:dict-entry (:string :uint32))) 5)) ("a{suu}" error) ("a{su" error) ("a{s" error) ;; Random stuff ("!" error))) (destructuring-bind (input expected) case (if (eq expected 'error) (should-error (dbus-proxy-parse-composite-type input) :type 'error) (should (equal (dbus-proxy-parse-composite-type input) expected))))) ) (ert-deftest dbus-introspection-test-parse-type-list-smoke () "Smoke test for the `dbus-proxy-parse-type-list' function." (dolist (case '(;; Simple ("i" ((:int32) 1)) ("ii" ((:int32 :int32) 2)) ("u" ((:uint32) 1)) ("uu" ((:uint32 :uint32) 2)) ;; Struct ("(ii)" (((:struct (:int32 :int32))) 4)) ("(i(ii))" (((:struct (:int32 (:struct (:int32 :int32))))) 7)) ;("(ii" error) ;("ii)" error) ("(u)" (((:struct (:uint32))) 3)) ("(v)" (((:struct (:variant))) 3)) ("(ius)" (((:struct (:int32 :uint32 :string))) 5)) ;; Array ("ai" (((:array :int32)) 2)) ("a(ii)" (((:array (:struct (:int32 :int32)))) 5)) ("aai" (((:array (:array :int32))) 3)) ("aa" error) ("au" (((:array :uint32)) 2)) ("av" (((:array :variant)) 2)) ;; Dict entry ("a{su}" (((:array (:dict-entry (:string :uint32)))) 5)) ("a{su}s" (((:array (:dict-entry (:string :uint32))) :string) 6)) ("a{suu}" error) ("a{su" error) ("a{s" error) ;; Random stuff ("!" error))) (destructuring-bind (input expected) case (if (eq expected 'error) (should-error (dbus-proxy-parse-composite-type input) :type 'error) (should (equal (dbus-proxy-parse-type-list input) expected))))) ) )) ;;; dbus-introspection.el ends here --Boundary_(ID_+FgRhfigVZn1+uFep0W1iw) Content-type: text/x-emacs-lisp; name=dbus-proxy.el; charset=UTF-8 Content-transfer-encoding: 7BIT Content-disposition: attachment; filename=dbus-proxy.el ;;; dbus-proxy.el --- Automatic proxies for remote D-Bus objects ;; ;; Copyright (C) 2009, 2010 Jan Moringen ;; ;; Author: Jan Moringen ;; Keywords: DBus, proxy ;; Version: 0.3 ;; X-RCS: $Id:$ ;; ;; This Program 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. ;; ;; This Program 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 this program. If not, see . ;;; Commentary: ;; ;; Here is a basic example of the intended use: ;; ;; (let ((epiphany (dbus-proxy-make-remote-proxy ;; :session ;; "org.gnome.Epiphany" ;; "/org/gnome/Epiphany"))) ;; (open-bookmarks-editor epiphany 0)) ;; ;; Creating a proxy object works as follows: ;; ;; Input: bus, client, object path ;; ;; 1. Collect all interfaces of the object at the specified path ;; 2. Form class name (1) (which is a symbol) using the sorted ;; interface names ;; 3. Check whether the symbol has a class value ;; 4.a If there is one, continue with 5. ;; 4.b Create a new class for the object ;; 1. For each interface: ;; 1. Form class name (2) (which is a symbol) using the interface ;; name ;; 2. Check whether a class exists for the interface ;; 3.a If there is one, continue with next interface ;; 3.b Create a new class ;; 1. Define the new class using the symbol (2) ;; Parents: `dbus-proxy-interface-object' ;; 2. For each method specified by the interface ;; 1. Transform the method name into a lispy name ;; 2. Create a method definition for the name that calls the ;; D-Bus method ;; 3. For each property specified by the interface ;; 1. Transform the property name into a lispy name ;; 2. Store a mapping from transformed name to interface name ;; and property name ;; 4. For each signal specified by the interface ;; 1. Transform the signal name into a lispy name ;; 2. Store a mapping from transformed name to interface name ;; and signal name ;; 2. Define a (3) class using the symbol (1) ;; Parents: `dbus-proxy-remote-object' and the classes created in ;; 4.b.1 ;; 5. Create an instance of the class from 4.a or (3) for the object ;; at the specified object path ;; ;; This algorithm is implemented by: ;; ;; + `dbus-proxy-make-remote-proxy' (1. 2. 5.) ;; + `dbus-proxy-make-interface-class' (4.b.1.) ;; + `dbus-proxy-make-object-class' (4.b.2.) ;; + `dbus-proxy-make-method-name' (4.b.1.3.b.2.1) ;; + `dbus-proxy-make-method' (4.b.1.3.b.2.2) ;; + `dbus-proxy-make-property-name' (4.b.1.3.b.3.1) ;; + `dbus-proxy-make-signal-name' (4.b.1.3.b.4.1) ;; ;; TODO mention properties ;;; History: ;; ;; 0.3 - Properties ;; - Signals ;; ;; 0.2 - Method name transformations ;; ;; 0.1 - Initial version ;;; Code: ;; (eval-when-compile (require 'cl)) (require 'eieio) (require 'dbus) (require 'dbus-introspection) ;;; Conditions ;; ;; no-such-property (intern "no-such-property") (put 'no-such-property 'error-conditions '(error no-such-property)) (put 'no-such-property 'error-message "The requested property does not exist.") ;; no-such-signal (intern "no-such-signal") (put 'no-such-signal 'error-conditions '(error no-such-signal)) (put 'no-such-signal 'error-message "The requested signal does not exist.") ;;; Proxy creation ;; (defun dbus-proxy-make-remote-proxy (bus service object &optional redefine-classes) "Create and return proxy object for OBJECT of SERVICE on BUS. If necessary, proxy classes are created for OBJECT and the interfaces it implements. The first time an object of a specific class (read: a set of interfaces) is created, the process can take some time since D-Bus introspection and the definition of several classes are required. However, subsequent proxy objects of the same class can be created without the overhead." ;; TODO handle case in which object is not found ;; Retrieve names of all interfaces implemented by the object and ;; get the corresponding proxy class, creating it if required. (let* ((interfaces (dbus-introspect-get-interface-names bus service object)) (class (dbus-proxy-ensure-object-class interfaces bus service object redefine-classes))) ;; The proxy object is an instance of that class. Create the ;; instance, passing it the object address. (make-instance class (concat (symbol-name bus) ":" service ":" object) :bus bus :service service :object object)) ) ;;; Class `dbus-proxy-remote-object' ;; (defclass dbus-proxy-remote-object () ((bus :initarg :bus :type keyword :documentation "The bus this D-Bus object lives on.") (service :initarg :service :type string :documentation "The well known service name held by this object.") (object :initarg :object :type string :documentation "The path of this object.")) "Objects of this class represent D-Bus objects. Methods of the associated D-Bus object can be called like ordinary methods. Properties of the associated D-Bus object are made available using virtual slots that behave like regular slots." :abstract t) (defmethod slot-missing ((this dbus-proxy-remote-object) slot-name operation &optional new-value) "Implement access to slot SLOT-NAME of THIS by calling D-Bus methods." (cond ;; If SLOT-NAME is a keyword, strip the leading colon and try ;; again. ((keywordp slot-name) (slot-missing this (intern (substring (symbol-name slot-name) 1)) operation new-value)) ;; If SLOT-NAME is a symbol, we have to look up the interface and ;; property name to which SLOT-NAME maps. Ask our parents (which ;; are all interface classes) to do this. ((symbolp slot-name) (slot-missing this (dbus-proxy-find-property this slot-name) operation new-value)) ;; If SLOT-NAME is a cons cell, it contains the interface and ;; property name. ((listp slot-name) (with-slots (bus service object) this (destructuring-bind (interface property) slot-name (cond ;; Read access ((eq operation 'oref) (dbus-get-property bus service object interface property)) ;; Write access ((eq operation 'oset) (dbus-set-property bus service object interface property new-value)) ;; Invalid operation (call-next-method)))))) ) (defmethod connect ((this dbus-proxy-remote-object) signal handler) "Connect HANDLER to SIGNAL of THIS. SIGNAL can either be a symbol or a list of the form (INTERFACE-NAME SIGNAL-NAME). When the first form is used, the interface providing the signal will be determined automatically. An error is signaled if SIGNAL is not contained in any of the interfaces provided by THIS." (if (listp signal) ;; If SIGNAL is a cons cell, it contains the interface and ;; signal name. (with-slots (bus service object) this (dbus-register-signal bus service object (first signal) (second signal) handler)) ;; Otherwise SIGNAL is just a symbol and we have to look up the ;; interface and signal name to which SIGNAL maps. Ask our parents ;; (which are all interface classes) to do this. (connect this (dbus-proxy-find-signal this signal) handler))) (defmethod disconnect ((this dbus-proxy-remote-object) registration) "Disconnect HANDLER from SIGNAL of THIS." (dbus-unregister-object registration)) (defclass dbus-proxy-interface-object () ((interface :allocation :class :type string :documentation "The name of the interface to which a particular subclass corresponds.") (properties :allocation :class :type list :documentation "TODO") (signals :allocation :class :type list :documentation "TODO")) "Subclasses of this correspond to D-Bus interfaces.") (defmethod object-print ((this dbus-proxy-interface-object) &rest strings) "Return a textual representation of THIS." (with-slots (bus service object) this (let ((simple-bus (eq bus :session)) (simple-service (string= (concat "/" (replace-regexp-in-string "\\." "/" service)) object))) (if (and simple-bus simple-service) (concat "#") (concat "#")))) ) ;;; Variables ;; (defvar dbus-proxy-transform-property-name-function #'dbus-proxy-transform-camel-case "The value of this is called to transform property names.") (defvar dbus-proxy-transform-signal-name-function #'dbus-proxy-transform-camel-case "The value of this is called to transform signal names.") (defvar dbus-proxy-transform-method-name-function #'dbus-proxy-transform-method-name "The value of this is called to transform method names.") ;;; Code generation ;; (defun dbus-proxy-make-property-name (name) "Transform NAME to make it usable as a slot name." (intern (funcall dbus-proxy-transform-property-name-function name))) (defun dbus-proxy-make-signal-name (name) "Transform NAME into a nice signal name." (intern (funcall dbus-proxy-transform-signal-name-function name))) (defun dbus-proxy-make-method-name (name) "Transform NAME to make it usable as a LISP function name." (let ((preferred-name (funcall dbus-proxy-transform-method-name-function name))) (if (dbus-proxy-symbol-unsuitable-for-method (intern preferred-name)) (let ((fallback (concat preferred-name "1"))) (warn "Preferred method name `%s' in use; falling back to `%s'" preferred-name fallback) (dbus-proxy-make-method-name fallback)) preferred-name))) (defun dbus-proxy-make-method (interface method) "Construct a stub method for METHOD on INTERFACE." (let* ((interface-name (dbus-interface-name interface)) (interface-symbol (dbus-proxy-make-interface-class-symbol interface-name)) (dbus-method-name (dbus-method-name method)) (emacs-method-name (dbus-proxy-make-method-name dbus-method-name)) (method-symbol (intern emacs-method-name)) (dbus-method-args (remove-if-not #'dbus-arg-p (cddr method))) (dbus-method-in-args (remove-if-not #'dbus-arg-in-p dbus-method-args)) (formal-args (let ((count 0)) (mapcar (lambda (arg) (incf count) (make-symbol (or (dbus-arg-name arg) (format "arg-%d" count)))) dbus-method-in-args))) (call-args (dbus-proxy-make-call-args dbus-method-in-args formal-args)) (doc "")) (message "Defining interface method %s:%s with signature `%s' as %s" interface-name dbus-method-name (mapconcat #'dbus-arg-type dbus-method-args "") emacs-method-name) ;; Define method. (eval `(defmethod ,method-symbol ((this ,interface-symbol) ,@formal-args) ,doc (with-slots (bus service object) this (dbus-call-method bus service object ,interface-name ,dbus-method-name ,@call-args)))) ;; Return the symbol method-symbol) ) ;;; Interface Class ;; (defun dbus-proxy-make-interface-class-symbol (interface) "" (intern interface)) (defun dbus-proxy-get-interface-class (interface) "Return the proxy class for INTERFACE or nil." (let ((class (intern-soft (symbol-name (dbus-proxy-make-interface-class-symbol interface))))) (when (class-p class) class)) ) (defun dbus-proxy-make-interface-class (interface) ;; interface name or interface object? "" (let* ((class-name (dbus-interface-name interface)) ;; EIEIO globally binds the name `class-symbol' (class-symbol-1 (dbus-proxy-make-interface-class-symbol class-name)) (properties (mapcar (lambda (property) (let ((name (dbus-property-name property))) (cons (dbus-proxy-make-property-name name) name))) (dbus-interface-properties interface))) (signals (mapcar (lambda (signal) (let ((name (dbus-signal-name signal))) (cons (dbus-proxy-make-signal-name name) name))) (dbus-interface-signals interface))) (doc (format "Abstract class implementing the interface %s" class-name))) (message "Defining interface class %s" class-name) ;; Define the class representing the interface. (eval `(defclass ,class-symbol-1 (dbus-proxy-interface-object) ((interface :initform ,class-name) (properties :initform ,properties) (signals :initform ,signals)) ,doc :abstract t)) ;; Define the property finder method for this interface. (dolist (property properties) (message "Defining interface property %s:%s as %s" class-name (cdr property) (car property))) (eval `(defmethod dbus-proxy-find-property ((this ,class-symbol-1) property) "TODO" (let ((property-info (assoc property (oref ,class-symbol-1 properties)))) (cond ;; Found property info return this interface and the property ;; name. (property-info (list (oref ,class-symbol-1 interface) (cdr property-info))) ;; Not found, but there is another interface class. Try it, ((next-method-p) (call-next-method)) ;; The property could not be found in any interface ;; class. Property an error. (t (property 'no-such-property (list property))))))) ;; Define the signal finder method for this interface. (dolist (signal signals) (message "Defining interface signal %s:%s as %s" class-name (cdr signal) (car signal))) (eval `(defmethod dbus-proxy-find-signal ((this ,class-symbol-1) signal) "TODO" (let ((signal-info (assoc signal (oref ,class-symbol-1 signals)))) (cond ;; Found signal info return this interface and the signal ;; name. (signal-info (list (oref ,class-symbol-1 interface) (cdr signal-info))) ;; Not found, but there is another interface class. Try it, ((next-method-p) (call-next-method)) ;; The signal could not be found in any interface ;; class. Signal an error. (t (signal 'no-such-signal (list signal))))))) ;; Define methods for the method elements of the interface. (dolist (method (dbus-interface-methods interface)) (dbus-proxy-make-method interface method)) ;; Return the symbol. class-symbol-1) ) (defun dbus-proxy-ensure-interface-class (interface &optional redefine) "" (or (and (not redefine) (dbus-proxy-get-interface-class (dbus-interface-name interface))) (dbus-proxy-make-interface-class interface))) ;;; Object Class ;; (defun dbus-proxy-make-object-class-symbol (interfaces) "" (intern (mapconcat #'identity (sort (copy-list interfaces) #'string<) "-")) ) (defun dbus-proxy-get-object-class (interfaces) "Return the proxy class for INTERFACES or nil." ;; Construct the symbol under which the class should be ;; stored. Check whether it is there. (let ((class (intern-soft (symbol-name (dbus-proxy-make-object-class-symbol interfaces))))) (when (class-p class) class)) ) ;; TODO &optional interfaces (defun dbus-proxy-make-object-class (interfaces &optional redefine-interface-classes) "" ;; Make sure there are proxy classes for all the interfaces and ;; define the class. (let (;; EIEIO globally binds the name `class-symbol' (class-symbol-1 (dbus-proxy-make-object-class-symbol (mapcar #'dbus-interface-name interfaces))) (parents (cons dbus-proxy-remote-object (mapcar (lambda (interface) (dbus-proxy-ensure-interface-class interface redefine-interface-classes)) interfaces))) (doc (format "A class implementing the following D-Bus interfaces:\n\n+ %s." (mapconcat #'dbus-interface-name interfaces "\n+ ")))) (message "Defining object class %s" (mapconcat #'dbus-interface-name interfaces "-")) (eval `(defclass ,class-symbol-1 (,@parents) () ,doc :method-invocation-order :c3)) ;; Return the symbol. class-symbol-1) ) (defun dbus-proxy-ensure-object-class (interfaces bus service object &optional redefine) "" (or (and (not redefine) (dbus-proxy-get-object-class interfaces)) ;; If necessary, retrieve full interface information and define ;; the object class. (dbus-proxy-make-object-class (mapcar (lambda (interface) (dbus-introspect-get-interface bus service object interface)) interfaces) redefine)) ) ;;; Utility Functions ;; (defun dbus-proxy-make-call-args (dbus-args formal-args) "Generate typed call arguments based on DBUS-ARGS and FORMAL-ARGS." (let ((dbus-args-rest dbus-args) (formal-args-rest formal-args) (result)) (while (and dbus-args-rest formal-args-rest) (let* ((formal-arg (car formal-args-rest)) (dbus-arg (car dbus-args-rest)) (type (dbus-arg-type dbus-arg))) ;; For simple types, look up the D-Bus type designator and push ;; it onto the call argument list. (when (= (length type) 1) (let ((designator (cdr (assoc (aref type 0) dbus-proxy-simple-type-codes)))) (if designator (push designator result) (warn "Could not find type designator for type `%s'; \ emitting `%s' as untyped argument." type (dbus-arg-name dbus-arg))))) ;; Push the argument variable unconditionally. (push formal-arg result) ;; Advance to next pair of arguments. (setq dbus-args-rest (cdr dbus-args-rest) formal-args-rest (cdr formal-args-rest)))) (nreverse result))) (defun dbus-proxy-symbol-unsuitable-for-method (symbol) "Check whether a D-Bus method can be defined on SYMBOL." (and (fboundp symbol) (not (generic-p symbol)) (or (byte-code-function-p (symbol-function symbol)) (not (eq 'autoload (car-safe (symbol-function symbol))))))) (defun dbus-proxy-transform-method-name (name) "Transform NAME into suitable LISP function name. The following literal translations are applied an addition to the transformation performed by `dbus-proxy-transform-camel-case': + Get -> prop-get + Set -> prop-set" (cond ((string= name "Get") "prop-get") ((string= name "Set") "prop-set") (t (dbus-proxy-transform-camel-case name)))) (defun dbus-proxy-transform-camel-case (name) "Transform NAME from CamelCase to dash-separated lower case. Examples: + CamelCase -> camel-case + UPPERCASE -> uppercase + PARTIALUppercase -> partial-uppercase" (let ((case-fold-search nil)) (downcase (replace-regexp-in-string (rx (seq (group (char lower)) (group (char upper)))) "\\1-\\2" (replace-regexp-in-string (rx (seq (group (1+ (char upper))) (char lower))) (lambda (match) (concat (capitalize (substring match 0 -2)) (substring match -2))) name t) t)))) (provide 'dbus-proxy) ;;; Unit Tests ;; (eval-when-compile (when (require 'ert nil t) (ert-deftest dbus-proxy-test-make-call-arg-smoke () "Test smoke of `make-call-arg'DOC." (should (equal (dbus-proxy-make-call-args '((arg ((type . "d"))) (arg ((type . "s"))) (arg ((type . "s")))) '(arg1 arg2 arg3)) '(:double arg1 :string arg2 :string arg3))) ) (ert-deftest dbus-proxy-test-transform-camel-case-smoke () "Smoke test for `dbus-proxy-transform-camel-case'." (dolist (case '(("CamelCase" "camel-case") ("UPPERCASE" "uppercase") ("PARTIALUppercase" "partial-uppercase") ("CrazyCamelCase" "crazy-camel-case") ("loadURIList" "load-uri-list"))) (destructuring-bind (input expected) case (should (string= (dbus-proxy-transform-camel-case input) expected)))) ) (ert-deftest dbus-proxy-test-make-remote-proxy () "Test `dbus-proxy-make-remote-proxy'." ;; Invalid object path - it seems we cannot check this ;; (should-error (dbus-proxy-make-remote-proxy ;; :session ;; "org.freedesktop.DBus" ;; "/org/freedesktop/DBus-invalid")) ;; Invalid service - it seems we cannot check this ;; (should-error (dbus-proxy-make-remote-proxy ;; :session ;; "org.freedesktop.DBus-invalid" ;; "/org/freedesktop/DBus")) ;; Invalid bus name - it seems we cannot check this ;; (should-error (dbus-proxy-make-remote-proxy ;; :session-invalid ;; "org.freedesktop.DBus" ;; "/org/freedesktop/DBus")) ;; Existing object on session bus. (let ((session-bus (dbus-proxy-make-remote-proxy :session "org.freedesktop.DBus" "/org/freedesktop/DBus"))) (with-slots (bus service object) session-bus (should (eq bus :session)) (should (string= service "org.freedesktop.DBus")) (should (string= object "/org/freedesktop/DBus")))) ;; Existing object on system bus. (let ((session-bus (dbus-proxy-make-remote-proxy :system "org.freedesktop.DBus" "/org/freedesktop/DBus"))) (with-slots (bus service object) session-bus (should (eq bus :system)) (should (string= service "org.freedesktop.DBus")) (should (string= object "/org/freedesktop/DBus")))) ) (ert-deftest dbus-proxy-test-connect () "Test the `connect' mechanism." (let ((hal (dbus-proxy-make-remote-proxy :system "org.freedesktop.Hal" "/org/freedesktop/Hal/Manager"))) ;; Connecting to non-existing signal should signal an error. (should-error (connect hal 'does-not-exist #'ignore) :type 'no-such-signal) ;; Do a successful connection and then disconnect again. (let ((connection (connect hal 'device-added #'ignore))) (should connection) (disconnect hal connection)) ;; Connect by manually specifying the precise D-Bus interface ;; and signal names and then disconnect again. (let ((connection (connect hal (list "org.freedesktop.Hal.Manager" "DeviceAdded") #'ignore))) (should connection) (disconnect hal connection)) ;; TODO test this properly; the problem is that we need a D-Bus ;; service that emits signals regularly and automatically ) ) (ert-deftest dbus-proxy-test-dbus () "Some tests with the D-Bus object." (let ((dbus (dbus-proxy-make-remote-proxy :session "org.freedesktop.DBus" "/org/freedesktop/DBus"))) ;; Call Introspect method of the bus object. (should (stringp (introspect dbus))) ;; Call the Hello method. This fails since the bus does not ;; want us to call the method multiple times. (should-error (hello dbus) :type 'dbus-error) ) ) (ert-deftest dbus-proxy-test-mission-control () "Some tests with the Mission Control D-Bus object." (let ((mission-control (dbus-proxy-make-remote-proxy :session "org.freedesktop.Telepathy.MissionControl5" "/org/freedesktop/Telepathy/AccountManager"))) ;; Call the find-accounts method of the mission control ;; object. (should (listp (find-accounts mission-control '(:array :signature "{sv}"))))) ) (ert-deftest dbus-proxy-test-epiphany () "Some tests with the Epiphany D-Bus object." (let ((epiphany (dbus-proxy-make-remote-proxy :session "org.gnome.Epiphany" "/org/gnome/Epiphany"))) ;; Open the bookmarks editor (open-bookmarks-editor epiphany 0) ;; Load a URL (load-uri-list epiphany '("www.heise.de") "" 1)) ) (ert-deftest dbus-proxy-test-devicekit () "Some tests with the Devicekit D-Bus object." (let ((device-kit (dbus-proxy-make-remote-proxy :system "org.freedesktop.DeviceKit" "/org/freedesktop/DeviceKit"))) ;; Retrieve the daemon-version property. (should (stringp (slot-value device-kit :daemon-version))) (should (stringp (oref device-kit :daemon-version))) ;; Connect to the device-event signal. (connect device-kit 'device-event (lambda (&rest args) (message "Device event %s" args))) ;; Enumerate subsystems. (should (listp (enumerate-by-subsystem device-kit '("sound"))))) ) (ert-deftest dbus-proxy-test-rhythmbox () "Some tests with the Rhythmbox D-Bus object." (let ((rhythmbox (dbus-proxy-make-remote-proxy :session "org.gnome.Rhythmbox" "/org/gnome/Rhythmbox/Player"))) ;; Connect to the playing-uri-changed signal (connect rhythmbox 'playing-uri-changed (lambda (&rest args) (message "Playing URI changed event %s" args))) ;; Why can't we have `compose' :( (dolist (v (mapcar (apply-partially #'* 0.3) (mapcar #'abs (mapcar #'sin (mapcar (apply-partially #'* 0.1) (number-sequence 1 100)))))) (set-volume rhythmbox v) (sit-for 0.02))) ) (ert-deftest dbus-proxy-test-gdm () "Some tests with the GDM D-Bus object." (let ((gdm (dbus-proxy-make-remote-proxy :system "org.gnome.DisplayManager" "/org/gnome/DisplayManager/Manager" t))) ;; List displays. This is interesting because the return value ;; of the call is a list of object paths. (get-displays gdm)) ) )) ;;; dbus-proxy.el ends here --Boundary_(ID_+FgRhfigVZn1+uFep0W1iw) Content-type: text/plain; name=TODO; charset=UTF-8 Content-transfer-encoding: 7BIT Content-disposition: attachment; filename=TODO * TODO Methods which are present in multiple interfaces A fine-grained selection of the method to call is not possible at the moment * TODO Slots do not appear in class descriptions * TODO Complex argument types are not handled properly * TODO Automatic conversion of return values Return values which are object paths are not converted to proxies * TODO Signal an error for invalid object info An error should be signaled if one of the following parameters is invalid: + Bus name + Service + Object path * DONE Support for signals * settings :noexport: # Local Variables: # mode: org # End: --Boundary_(ID_+FgRhfigVZn1+uFep0W1iw)--