Inclusion of dbus-proxy

[Jan Moringen <jan.moringen@uni-bielefeld.de>]

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

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

[-- Attachment #2: ChangeLog --]
[-- Type: text/x-changelog, Size: 14373 bytes --]

2010-08-21  Jan Moringen  <jmoringe@techfak.uni-bielefeld.de>

	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  <jmoringe@techfak.uni-bielefeld.de>

	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  <jmoringe@techfak.uni-bielefeld.de>

	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  <jmoringe@techfak.uni-bielefeld.de>

	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  <jmoringe@techfak.uni-bielefeld.de>

	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  <jmoringe@techfak.uni-bielefeld.de>

	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  <jmoringe@techfak.uni-bielefeld.de>

	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  <jmoringe@techfak.uni-bielefeld.de>

	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  <jmoringe@techfak.uni-bielefeld.de>

	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

[-- Attachment #3: dbus-introspection.el --]
[-- Type: text/x-emacs-lisp, Size: 10326 bytes --]

;;; dbus-introspection.el --- Helper functions for D-Bus introspection
;;
;; Copyright (C) 2009, 2010 Jan Moringen
;;
;; Author: Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
;; 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 <http://www.gnu.org/licenses>.

\f
;;; Commentary:
;;
;; Helper functions for the `dbus-proxy' library.

\f
;;; History:
;;
;; 0.2 - Parsing of complex signatures
;;
;; 0.1 - Initial version

\f
;;; Code:
;;

(require 'dbus)

\f
;;; Error Conditions
;;

;; malformed-signature

(intern "malformed-signature")

(put 'malformed-signature 'error-conditions
     '(error malformed-signature))

(put 'malformed-signature 'error-message
     "Malformed signature signature")

\f
;;;
;;

(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)))

\f
;;; 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)

\f
;;; 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

[-- Attachment #4: dbus-proxy.el --]
[-- Type: text/x-emacs-lisp, Size: 25856 bytes --]

;;; dbus-proxy.el --- Automatic proxies for remote D-Bus objects
;;
;; Copyright (C) 2009, 2010 Jan Moringen
;;
;; Author: Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
;; 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 <http://www.gnu.org/licenses>.

\f
;;; 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

\f
;;; History:
;;
;; 0.3 - Properties
;;     - Signals
;;
;; 0.2 - Method name transformations
;;
;; 0.1 - Initial version

\f
;;; Code:
;;

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

(require 'eieio)

(require 'dbus)
(require 'dbus-introspection)

\f
;;; 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.")

\f
;;; 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))
  )

\f
;;; 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 "#<dbus-proxy " object ">")
	(concat "#<dbus-proxy"
		(unless simple-bus
		  (concat " bus: " (symbol-name bus)))
		(unless simple-service
		  (concat " service: " service))
		" object: "
		object
		strings
		">"))))
  )

\f
;;; 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.")

\f
;;; 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)
  )

\f
;;; 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)))

\f
;;; 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))
  )

\f
;;; 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)

\f
;;; 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

[-- Attachment #5: TODO --]
[-- Type: text/plain, Size: 618 bytes --]

* 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: