src/dbusbind.c

   1 /* Elisp bindings for D-Bus.
   2    Copyright (C) 2007-2012 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software: you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation, either version 3 of the License, or
   9 (at your option) any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
  18
  19 #include <config.h>
  20
  21 #ifdef HAVE_DBUS
  22 #include <stdio.h>
  23 #include <dbus/dbus.h>
  24 #include <setjmp.h>
  25 #include "lisp.h"
  26 #include "frame.h"
  27 #include "termhooks.h"
  28 #include "keyboard.h"
  29 #include "process.h"
  30
  31 #ifndef DBUS_NUM_MESSAGE_TYPES
  32 #define DBUS_NUM_MESSAGE_TYPES 5
  33 #endif
  34
  35 \f
  36 /* Subroutines.  */
  37 static Lisp_Object Qdbus_init_bus;
  38 static Lisp_Object Qdbus_get_unique_name;
  39 static Lisp_Object Qdbus_message_internal;
  40
  41 /* D-Bus error symbol.  */
  42 static Lisp_Object Qdbus_error;
  43
  44 /* Lisp symbols of the system and session buses.  */
  45 static Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
  46
  47 /* Lisp symbol for method call timeout.  */
  48 static Lisp_Object QCdbus_timeout;
  49
  50 /* Lisp symbols of D-Bus types.  */
  51 static Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
  52 static Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
  53 static Lisp_Object QCdbus_type_int32, QCdbus_type_uint32;
  54 static Lisp_Object QCdbus_type_int64, QCdbus_type_uint64;
  55 static Lisp_Object QCdbus_type_double, QCdbus_type_string;
  56 static Lisp_Object QCdbus_type_object_path, QCdbus_type_signature;
  57 #ifdef DBUS_TYPE_UNIX_FD
  58 static Lisp_Object QCdbus_type_unix_fd;
  59 #endif
  60 static Lisp_Object QCdbus_type_array, QCdbus_type_variant;
  61 static Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
  62
  63 /* Lisp symbols of objects in `dbus-registered-objects-table'.  */
  64 static Lisp_Object QCdbus_registered_serial, QCdbus_registered_method;
  65 static Lisp_Object QCdbus_registered_signal;
  66
  67 /* Whether we are reading a D-Bus event.  */
  68 static int xd_in_read_queued_messages = 0;
  69
  70 \f
  71 /* We use "xd_" and "XD_" as prefix for all internal symbols, because
  72    we don't want to poison other namespaces with "dbus_".  */
  73
  74 /* Raise a signal.  If we are reading events, we cannot signal; we
  75    throw to xd_read_queued_messages then.  */
  76 #define XD_SIGNAL1(arg)                                                 \
  77   do {                                                                  \
  78     if (xd_in_read_queued_messages)                                     \
  79       Fthrow (Qdbus_error, Qnil);                                       \
  80     else                                                                \
  81       xsignal1 (Qdbus_error, arg);                                      \
  82   } while (0)
  83
  84 #define XD_SIGNAL2(arg1, arg2)                                          \
  85   do {                                                                  \
  86     if (xd_in_read_queued_messages)                                     \
  87       Fthrow (Qdbus_error, Qnil);                                       \
  88     else                                                                \
  89       xsignal2 (Qdbus_error, arg1, arg2);                               \
  90   } while (0)
  91
  92 #define XD_SIGNAL3(arg1, arg2, arg3)                                    \
  93   do {                                                                  \
  94     if (xd_in_read_queued_messages)                                     \
  95       Fthrow (Qdbus_error, Qnil);                                       \
  96     else                                                                \
  97       xsignal3 (Qdbus_error, arg1, arg2, arg3);                         \
  98   } while (0)
  99
 100 /* Raise a Lisp error from a D-Bus ERROR.  */
 101 #define XD_ERROR(error)                                                 \
 102   do {                                                                  \
 103     /* Remove the trailing newline.  */                                 \
 104     char const *mess = error.message;                                   \
 105     char const *nl = strchr (mess, '\n');                               \
 106     Lisp_Object err = make_string (mess, nl ? nl - mess : strlen (mess)); \
 107     dbus_error_free (&error);                                           \
 108     XD_SIGNAL1 (err);                                                   \
 109   } while (0)
 110
 111 /* Macros for debugging.  In order to enable them, build with
 112    "env MYCPPFLAGS='-DDBUS_DEBUG -Wall' make".  */
 113 #ifdef DBUS_DEBUG
 114 #define XD_DEBUG_MESSAGE(...)            \
 115   do {                                   \
 116     char s[1024];                        \
 117     snprintf (s, sizeof s, __VA_ARGS__); \
 118     printf ("%s: %s\n", __func__, s);    \
 119     message ("%s: %s", __func__, s);     \
 120   } while (0)
 121 #define XD_DEBUG_VALID_LISP_OBJECT_P(object)                            \
 122   do {                                                                  \
 123     if (!valid_lisp_object_p (object))                                  \
 124       {                                                                 \
 125         XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__);            \
 126         XD_SIGNAL1 (build_string ("Assertion failure"));                \
 127       }                                                                 \
 128   } while (0)
 129
 130 #else /* !DBUS_DEBUG */
 131 #define XD_DEBUG_MESSAGE(...)                                           \
 132   do {                                                                  \
 133     if (!NILP (Vdbus_debug))                                            \
 134       {                                                                 \
 135         char s[1024];                                                   \
 136         snprintf (s, sizeof s, __VA_ARGS__);                            \
 137         message ("%s: %s", __func__, s);                                \
 138       }                                                                 \
 139   } while (0)
 140 #define XD_DEBUG_VALID_LISP_OBJECT_P(object)
 141 #endif
 142
 143 /* Check whether TYPE is a basic DBusType.  */
 144 #ifdef DBUS_TYPE_UNIX_FD
 145 #define XD_BASIC_DBUS_TYPE(type)                                        \
 146   ((type ==  DBUS_TYPE_BYTE)                                            \
 147    || (type ==  DBUS_TYPE_BOOLEAN)                                      \
 148    || (type ==  DBUS_TYPE_INT16)                                        \
 149    || (type ==  DBUS_TYPE_UINT16)                                       \
 150    || (type ==  DBUS_TYPE_INT32)                                        \
 151    || (type ==  DBUS_TYPE_UINT32)                                       \
 152    || (type ==  DBUS_TYPE_INT64)                                        \
 153    || (type ==  DBUS_TYPE_UINT64)                                       \
 154    || (type ==  DBUS_TYPE_DOUBLE)                                       \
 155    || (type ==  DBUS_TYPE_STRING)                                       \
 156    || (type ==  DBUS_TYPE_OBJECT_PATH)                                  \
 157    || (type ==  DBUS_TYPE_SIGNATURE)                                    \
 158    || (type ==  DBUS_TYPE_UNIX_FD))
 159 #else
 160 #define XD_BASIC_DBUS_TYPE(type)                                        \
 161   ((type ==  DBUS_TYPE_BYTE)                                            \
 162    || (type ==  DBUS_TYPE_BOOLEAN)                                      \
 163    || (type ==  DBUS_TYPE_INT16)                                        \
 164    || (type ==  DBUS_TYPE_UINT16)                                       \
 165    || (type ==  DBUS_TYPE_INT32)                                        \
 166    || (type ==  DBUS_TYPE_UINT32)                                       \
 167    || (type ==  DBUS_TYPE_INT64)                                        \
 168    || (type ==  DBUS_TYPE_UINT64)                                       \
 169    || (type ==  DBUS_TYPE_DOUBLE)                                       \
 170    || (type ==  DBUS_TYPE_STRING)                                       \
 171    || (type ==  DBUS_TYPE_OBJECT_PATH)                                  \
 172    || (type ==  DBUS_TYPE_SIGNATURE))
 173 #endif
 174
 175 /* This was a macro.  On Solaris 2.11 it was said to compile for
 176    hours, when optimization is enabled.  So we have transferred it into
 177    a function.  */
 178 /* Determine the DBusType of a given Lisp symbol.  OBJECT must be one
 179    of the predefined D-Bus type symbols.  */
 180 static int
 181 xd_symbol_to_dbus_type (Lisp_Object object)
 182 {
 183   return
 184     ((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE
 185      : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN
 186      : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16
 187      : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16
 188      : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32
 189      : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32
 190      : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64
 191      : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64
 192      : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE
 193      : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING
 194      : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH
 195      : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE
 196 #ifdef DBUS_TYPE_UNIX_FD
 197      : (EQ (object, QCdbus_type_unix_fd)) ? DBUS_TYPE_UNIX_FD
 198 #endif
 199      : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY
 200      : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT
 201      : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT
 202      : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY
 203      : DBUS_TYPE_INVALID);
 204 }
 205
 206 /* Check whether a Lisp symbol is a predefined D-Bus type symbol.  */
 207 #define XD_DBUS_TYPE_P(object)                                          \
 208   (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)))
 209
 210 /* Determine the DBusType of a given Lisp OBJECT.  It is used to
 211    convert Lisp objects, being arguments of `dbus-call-method' or
 212    `dbus-send-signal', into corresponding C values appended as
 213    arguments to a D-Bus message.  */
 214 #define XD_OBJECT_TO_DBUS_TYPE(object)                                  \
 215   ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN           \
 216    : (NATNUMP (object)) ? DBUS_TYPE_UINT32                              \
 217    : (INTEGERP (object)) ? DBUS_TYPE_INT32                              \
 218    : (FLOATP (object)) ? DBUS_TYPE_DOUBLE                               \
 219    : (STRINGP (object)) ? DBUS_TYPE_STRING                              \
 220    : (XD_DBUS_TYPE_P (object)) ? xd_symbol_to_dbus_type (object)        \
 221    : (CONSP (object))                                                   \
 222    ? ((XD_DBUS_TYPE_P (CAR_SAFE (object)))                              \
 223       ? ((XD_BASIC_DBUS_TYPE (xd_symbol_to_dbus_type (CAR_SAFE (object)))) \
 224          ? DBUS_TYPE_ARRAY                                              \
 225          : xd_symbol_to_dbus_type (CAR_SAFE (object)))                  \
 226       : DBUS_TYPE_ARRAY)                                                \
 227    : DBUS_TYPE_INVALID)
 228
 229 /* Return a list pointer which does not have a Lisp symbol as car.  */
 230 #define XD_NEXT_VALUE(object)                                           \
 231   ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
 232
 233 /* Transform the message type to its string representation for debug
 234    messages.  */
 235 #define XD_MESSAGE_TYPE_TO_STRING(mtype)                                \
 236   ((mtype == DBUS_MESSAGE_TYPE_INVALID)                                 \
 237   ? "DBUS_MESSAGE_TYPE_INVALID"                                         \
 238   : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)                            \
 239   ? "DBUS_MESSAGE_TYPE_METHOD_CALL"                                     \
 240   : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)                          \
 241   ? "DBUS_MESSAGE_TYPE_METHOD_RETURN"                                   \
 242   : (mtype == DBUS_MESSAGE_TYPE_ERROR)                                  \
 243    ? "DBUS_MESSAGE_TYPE_ERROR"                                          \
 244    : "DBUS_MESSAGE_TYPE_SIGNAL")
 245
 246 /* Transform the object to its string representation for debug
 247    messages.  */
 248 #define XD_OBJECT_TO_STRING(object)                                     \
 249   SDATA (format2 ("%s", object, Qnil))
 250
 251 /* Check whether X is a valid dbus serial number.  If valid, set
 252    SERIAL to its value.  Otherwise, signal an error. */
 253 #define XD_CHECK_DBUS_SERIAL(x, serial)                                 \
 254   do {                                                                  \
 255     dbus_uint32_t DBUS_SERIAL_MAX = -1;                                 \
 256     if (NATNUMP (x) && XINT (x) <= DBUS_SERIAL_MAX)                     \
 257       serial = XINT (x);                                                \
 258     else if (MOST_POSITIVE_FIXNUM < DBUS_SERIAL_MAX                     \
 259              && FLOATP (x)                                              \
 260              && 0 <= XFLOAT_DATA (x)                                    \
 261              && XFLOAT_DATA (x) <= DBUS_SERIAL_MAX)                     \
 262       serial = XFLOAT_DATA (x);                                         \
 263     else                                                                \
 264       XD_SIGNAL2 (build_string ("Invalid dbus serial"), x);             \
 265   } while (0)
 266
 267 #define XD_DBUS_VALIDATE_BUS_ADDRESS(bus)                               \
 268   do {                                                                  \
 269     if (STRINGP (bus))                                                  \
 270       {                                                                 \
 271         DBusAddressEntry **entries;                                     \
 272         int len;                                                        \
 273         DBusError derror;                                               \
 274         dbus_error_init (&derror);                                      \
 275         if (!dbus_parse_address (SSDATA (bus), &entries, &len, &derror)) \
 276           XD_ERROR (derror);                                            \
 277         /* Cleanup.  */                                                 \
 278         dbus_error_free (&derror);                                      \
 279         dbus_address_entries_free (entries);                            \
 280       }                                                                 \
 281                                                                         \
 282     else                                                                \
 283       {                                                                 \
 284         CHECK_SYMBOL (bus);                                             \
 285         if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus))) \
 286           XD_SIGNAL2 (build_string ("Wrong bus name"), bus);            \
 287         /* We do not want to have an autolaunch for the session bus.  */ \
 288         if (EQ (bus, QCdbus_session_bus)                                \
 289             && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL)             \
 290           XD_SIGNAL2 (build_string ("No connection to bus"), bus);      \
 291       }                                                                 \
 292   } while (0)
 293
 294 #if (HAVE_DBUS_VALIDATE_BUS_NAME || HAVE_DBUS_VALIDATE_PATH \
 295      || XD_DBUS_VALIDATE_OBJECT || HAVE_DBUS_VALIDATE_MEMBER)
 296 #define XD_DBUS_VALIDATE_OBJECT(object, func)                           \
 297   do {                                                                  \
 298     if (!NILP (object))                                                 \
 299       {                                                                 \
 300         DBusError derror;                                               \
 301         CHECK_STRING (object);                                          \
 302         dbus_error_init (&derror);                                      \
 303         if (!func (SSDATA (object), &derror))                           \
 304           XD_ERROR (derror);                                            \
 305         /* Cleanup.  */                                                 \
 306         dbus_error_free (&derror);                                      \
 307       }                                                                 \
 308   } while (0)
 309 #endif
 310
 311 #if HAVE_DBUS_VALIDATE_BUS_NAME
 312 #define XD_DBUS_VALIDATE_BUS_NAME(bus_name)                             \
 313   XD_DBUS_VALIDATE_OBJECT(bus_name, dbus_validate_bus_name);
 314 #else
 315 #define XD_DBUS_VALIDATE_BUS_NAME(bus_name)                             \
 316   if (!NILP (bus_name)) CHECK_STRING (bus_name);
 317 #endif
 318
 319 #if HAVE_DBUS_VALIDATE_PATH
 320 #define XD_DBUS_VALIDATE_PATH(path)                                     \
 321   XD_DBUS_VALIDATE_OBJECT(path, dbus_validate_path);
 322 #else
 323 #define XD_DBUS_VALIDATE_PATH(path)                                     \
 324   if (!NILP (path)) CHECK_STRING (path);
 325 #endif
 326
 327 #if HAVE_DBUS_VALIDATE_INTERFACE
 328 #define XD_DBUS_VALIDATE_INTERFACE(interface)                           \
 329   XD_DBUS_VALIDATE_OBJECT(interface, dbus_validate_interface);
 330 #else
 331 #define XD_DBUS_VALIDATE_INTERFACE(interface)                           \
 332   if (!NILP (interface)) CHECK_STRING (interface);
 333 #endif
 334
 335 #if HAVE_DBUS_VALIDATE_MEMBER
 336 #define XD_DBUS_VALIDATE_MEMBER(member)                                 \
 337   XD_DBUS_VALIDATE_OBJECT(member, dbus_validate_member);
 338 #else
 339 #define XD_DBUS_VALIDATE_MEMBER(member)                                 \
 340   if (!NILP (member)) CHECK_STRING (member);
 341 #endif
 342
 343 /* Append to SIGNATURE a copy of X, making sure SIGNATURE does
 344    not become too long.  */
 345 static void
 346 xd_signature_cat (char *signature, char const *x)
 347 {
 348   ptrdiff_t siglen = strlen (signature);
 349   ptrdiff_t xlen = strlen (x);
 350   if (DBUS_MAXIMUM_SIGNATURE_LENGTH - xlen <= siglen)
 351     string_overflow ();
 352   strcat (signature, x);
 353 }
 354
 355 /* Compute SIGNATURE of OBJECT.  It must have a form that it can be
 356    used in dbus_message_iter_open_container.  DTYPE is the DBusType
 357    the object is related to.  It is passed as argument, because it
 358    cannot be detected in basic type objects, when they are preceded by
 359    a type symbol.  PARENT_TYPE is the DBusType of a container this
 360    signature is embedded, or DBUS_TYPE_INVALID.  It is needed for the
 361    check that DBUS_TYPE_DICT_ENTRY occurs only as array element.  */
 362 static void
 363 xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lisp_Object object)
 364 {
 365   unsigned int subtype;
 366   Lisp_Object elt;
 367   char const *subsig;
 368   int subsiglen;
 369   char x[DBUS_MAXIMUM_SIGNATURE_LENGTH];
 370
 371   elt = object;
 372
 373   switch (dtype)
 374     {
 375     case DBUS_TYPE_BYTE:
 376     case DBUS_TYPE_UINT16:
 377       CHECK_NATNUM (object);
 378       sprintf (signature, "%c", dtype);
 379       break;
 380
 381     case DBUS_TYPE_BOOLEAN:
 382       if (!EQ (object, Qt) && !EQ (object, Qnil))
 383         wrong_type_argument (intern ("booleanp"), object);
 384       sprintf (signature, "%c", dtype);
 385       break;
 386
 387     case DBUS_TYPE_INT16:
 388       CHECK_NUMBER (object);
 389       sprintf (signature, "%c", dtype);
 390       break;
 391
 392     case DBUS_TYPE_UINT32:
 393     case DBUS_TYPE_UINT64:
 394 #ifdef DBUS_TYPE_UNIX_FD
 395     case DBUS_TYPE_UNIX_FD:
 396 #endif
 397     case DBUS_TYPE_INT32:
 398     case DBUS_TYPE_INT64:
 399     case DBUS_TYPE_DOUBLE:
 400       CHECK_NUMBER_OR_FLOAT (object);
 401       sprintf (signature, "%c", dtype);
 402       break;
 403
 404     case DBUS_TYPE_STRING:
 405     case DBUS_TYPE_OBJECT_PATH:
 406     case DBUS_TYPE_SIGNATURE:
 407       CHECK_STRING (object);
 408       sprintf (signature, "%c", dtype);
 409       break;
 410
 411     case DBUS_TYPE_ARRAY:
 412       /* Check that all list elements have the same D-Bus type.  For
 413          complex element types, we just check the container type, not
 414          the whole element's signature.  */
 415       CHECK_CONS (object);
 416
 417       /* Type symbol is optional.  */
 418       if (EQ (QCdbus_type_array, CAR_SAFE (elt)))
 419         elt = XD_NEXT_VALUE (elt);
 420
 421       /* If the array is empty, DBUS_TYPE_STRING is the default
 422          element type.  */
 423       if (NILP (elt))
 424         {
 425           subtype = DBUS_TYPE_STRING;
 426           subsig = DBUS_TYPE_STRING_AS_STRING;
 427         }
 428       else
 429         {
 430           subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 431           xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 432           subsig = x;
 433         }
 434
 435       /* If the element type is DBUS_TYPE_SIGNATURE, and this is the
 436          only element, the value of this element is used as the
 437          array's element signature.  */
 438       if ((subtype == DBUS_TYPE_SIGNATURE)
 439           && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt)))
 440           && NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
 441         subsig = SSDATA (CAR_SAFE (XD_NEXT_VALUE (elt)));
 442
 443       while (!NILP (elt))
 444         {
 445           if (subtype != XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)))
 446             wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt));
 447           elt = CDR_SAFE (XD_NEXT_VALUE (elt));
 448         }
 449
 450       subsiglen = snprintf (signature, DBUS_MAXIMUM_SIGNATURE_LENGTH,
 451                             "%c%s", dtype, subsig);
 452       if (! (0 <= subsiglen && subsiglen < DBUS_MAXIMUM_SIGNATURE_LENGTH))
 453         string_overflow ();
 454       break;
 455
 456     case DBUS_TYPE_VARIANT:
 457       /* Check that there is exactly one list element.  */
 458       CHECK_CONS (object);
 459
 460       elt = XD_NEXT_VALUE (elt);
 461       subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 462       xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 463
 464       if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
 465         wrong_type_argument (intern ("D-Bus"),
 466                              CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
 467
 468       sprintf (signature, "%c", dtype);
 469       break;
 470
 471     case DBUS_TYPE_STRUCT:
 472       /* A struct list might contain any number of elements with
 473          different types.  No further check needed.  */
 474       CHECK_CONS (object);
 475
 476       elt = XD_NEXT_VALUE (elt);
 477
 478       /* Compose the signature from the elements.  It is enclosed by
 479          parentheses.  */
 480       sprintf (signature, "%c", DBUS_STRUCT_BEGIN_CHAR );
 481       while (!NILP (elt))
 482         {
 483           subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 484           xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 485           xd_signature_cat (signature, x);
 486           elt = CDR_SAFE (XD_NEXT_VALUE (elt));
 487         }
 488       xd_signature_cat (signature, DBUS_STRUCT_END_CHAR_AS_STRING);
 489       break;
 490
 491     case DBUS_TYPE_DICT_ENTRY:
 492       /* Check that there are exactly two list elements, and the first
 493          one is of basic type.  The dictionary entry itself must be an
 494          element of an array.  */
 495       CHECK_CONS (object);
 496
 497       /* Check the parent object type.  */
 498       if (parent_type != DBUS_TYPE_ARRAY)
 499         wrong_type_argument (intern ("D-Bus"), object);
 500
 501       /* Compose the signature from the elements.  It is enclosed by
 502          curly braces.  */
 503       sprintf (signature, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR);
 504
 505       /* First element.  */
 506       elt = XD_NEXT_VALUE (elt);
 507       subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 508       xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 509       xd_signature_cat (signature, x);
 510
 511       if (!XD_BASIC_DBUS_TYPE (subtype))
 512         wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt)));
 513
 514       /* Second element.  */
 515       elt = CDR_SAFE (XD_NEXT_VALUE (elt));
 516       subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 517       xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 518       xd_signature_cat (signature, x);
 519
 520       if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
 521         wrong_type_argument (intern ("D-Bus"),
 522                              CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
 523
 524       /* Closing signature.  */
 525       xd_signature_cat (signature, DBUS_DICT_ENTRY_END_CHAR_AS_STRING);
 526       break;
 527
 528     default:
 529       wrong_type_argument (intern ("D-Bus"), object);
 530     }
 531
 532   XD_DEBUG_MESSAGE ("%s", signature);
 533 }
 534
 535 /* Append C value, extracted from Lisp OBJECT, to iteration ITER.
 536    DTYPE must be a valid DBusType.  It is used to convert Lisp
 537    objects, being arguments of `dbus-call-method' or
 538    `dbus-send-signal', into corresponding C values appended as
 539    arguments to a D-Bus message.  */
 540 static void
 541 xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
 542 {
 543   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
 544   DBusMessageIter subiter;
 545
 546   if (XD_BASIC_DBUS_TYPE (dtype))
 547     switch (dtype)
 548       {
 549       case DBUS_TYPE_BYTE:
 550         CHECK_NATNUM (object);
 551         {
 552           unsigned char val = XFASTINT (object) & 0xFF;
 553           XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 554           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 555             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 556           return;
 557         }
 558
 559       case DBUS_TYPE_BOOLEAN:
 560         {
 561           dbus_bool_t val = (NILP (object)) ? FALSE : TRUE;
 562           XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
 563           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 564             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 565           return;
 566         }
 567
 568       case DBUS_TYPE_INT16:
 569         CHECK_NUMBER (object);
 570         {
 571           dbus_int16_t val = XINT (object);
 572           XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
 573           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 574             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 575           return;
 576         }
 577
 578       case DBUS_TYPE_UINT16:
 579         CHECK_NATNUM (object);
 580         {
 581           dbus_uint16_t val = XFASTINT (object);
 582           XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
 583           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 584             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 585           return;
 586         }
 587
 588       case DBUS_TYPE_INT32:
 589         {
 590           dbus_int32_t val = extract_float (object);
 591           XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 592           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 593             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 594           return;
 595         }
 596
 597       case DBUS_TYPE_UINT32:
 598 #ifdef DBUS_TYPE_UNIX_FD
 599       case DBUS_TYPE_UNIX_FD:
 600 #endif
 601         {
 602           dbus_uint32_t val = extract_float (object);
 603           XD_DEBUG_MESSAGE ("%c %u", dtype, val);
 604           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 605             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 606           return;
 607         }
 608
 609       case DBUS_TYPE_INT64:
 610         {
 611           dbus_int64_t val = extract_float (object);
 612           XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
 613           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 614             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 615           return;
 616         }
 617
 618       case DBUS_TYPE_UINT64:
 619         {
 620           dbus_uint64_t val = extract_float (object);
 621           XD_DEBUG_MESSAGE ("%c %"pI"d", dtype, val);
 622           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 623             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 624           return;
 625         }
 626
 627       case DBUS_TYPE_DOUBLE:
 628         {
 629           double val = extract_float (object);
 630           XD_DEBUG_MESSAGE ("%c %f", dtype, val);
 631           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 632             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 633           return;
 634         }
 635
 636       case DBUS_TYPE_STRING:
 637       case DBUS_TYPE_OBJECT_PATH:
 638       case DBUS_TYPE_SIGNATURE:
 639         CHECK_STRING (object);
 640         {
 641           /* We need to send a valid UTF-8 string.  We could encode `object'
 642              but by not encoding it, we guarantee it's valid utf-8, even if
 643              it contains eight-bit-bytes.  Of course, you can still send
 644              manually-crafted junk by passing a unibyte string.  */
 645           char *val = SSDATA (object);
 646           XD_DEBUG_MESSAGE ("%c %s", dtype, val);
 647           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 648             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 649           return;
 650         }
 651       }
 652
 653   else /* Compound types.  */
 654     {
 655
 656       /* All compound types except array have a type symbol.  For
 657          array, it is optional.  Skip it.  */
 658       if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))))
 659         object = XD_NEXT_VALUE (object);
 660
 661       /* Open new subiteration.  */
 662       switch (dtype)
 663         {
 664         case DBUS_TYPE_ARRAY:
 665           /* An array has only elements of the same type.  So it is
 666              sufficient to check the first element's signature
 667              only.  */
 668
 669           if (NILP (object))
 670             /* If the array is empty, DBUS_TYPE_STRING is the default
 671                element type.  */
 672             strcpy (signature, DBUS_TYPE_STRING_AS_STRING);
 673
 674           else
 675             /* If the element type is DBUS_TYPE_SIGNATURE, and this is
 676                the only element, the value of this element is used as
 677                the array's element signature.  */
 678             if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))
 679                  == DBUS_TYPE_SIGNATURE)
 680                 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object)))
 681                 && NILP (CDR_SAFE (XD_NEXT_VALUE (object))))
 682               {
 683                 strcpy (signature, SSDATA (CAR_SAFE (XD_NEXT_VALUE (object))));
 684                 object = CDR_SAFE (XD_NEXT_VALUE (object));
 685               }
 686
 687             else
 688               xd_signature (signature,
 689                             XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
 690                             dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
 691
 692           XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
 693                             XD_OBJECT_TO_STRING (object));
 694           if (!dbus_message_iter_open_container (iter, dtype,
 695                                                  signature, &subiter))
 696             XD_SIGNAL3 (build_string ("Cannot open container"),
 697                         make_number (dtype), build_string (signature));
 698           break;
 699
 700         case DBUS_TYPE_VARIANT:
 701           /* A variant has just one element.  */
 702           xd_signature (signature, XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
 703                         dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
 704
 705           XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
 706                             XD_OBJECT_TO_STRING (object));
 707           if (!dbus_message_iter_open_container (iter, dtype,
 708                                                  signature, &subiter))
 709             XD_SIGNAL3 (build_string ("Cannot open container"),
 710                         make_number (dtype), build_string (signature));
 711           break;
 712
 713         case DBUS_TYPE_STRUCT:
 714         case DBUS_TYPE_DICT_ENTRY:
 715           /* These containers do not require a signature.  */
 716           XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (object));
 717           if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
 718             XD_SIGNAL2 (build_string ("Cannot open container"),
 719                         make_number (dtype));
 720           break;
 721         }
 722
 723       /* Loop over list elements.  */
 724       while (!NILP (object))
 725         {
 726           dtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object));
 727           object = XD_NEXT_VALUE (object);
 728
 729           xd_append_arg (dtype, CAR_SAFE (object), &subiter);
 730
 731           object = CDR_SAFE (object);
 732         }
 733
 734       /* Close the subiteration.  */
 735       if (!dbus_message_iter_close_container (iter, &subiter))
 736         XD_SIGNAL2 (build_string ("Cannot close container"),
 737                     make_number (dtype));
 738     }
 739 }
 740
 741 /* Retrieve C value from a DBusMessageIter structure ITER, and return
 742    a converted Lisp object.  The type DTYPE of the argument of the
 743    D-Bus message must be a valid DBusType.  Compound D-Bus types
 744    result always in a Lisp list.  */
 745 static Lisp_Object
 746 xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
 747 {
 748
 749   switch (dtype)
 750     {
 751     case DBUS_TYPE_BYTE:
 752       {
 753         unsigned int val;
 754         dbus_message_iter_get_basic (iter, &val);
 755         val = val & 0xFF;
 756         XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 757         return make_number (val);
 758       }
 759
 760     case DBUS_TYPE_BOOLEAN:
 761       {
 762         dbus_bool_t val;
 763         dbus_message_iter_get_basic (iter, &val);
 764         XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
 765         return (val == FALSE) ? Qnil : Qt;
 766       }
 767
 768     case DBUS_TYPE_INT16:
 769       {
 770         dbus_int16_t val;
 771         dbus_message_iter_get_basic (iter, &val);
 772         XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 773         return make_number (val);
 774       }
 775
 776     case DBUS_TYPE_UINT16:
 777       {
 778         dbus_uint16_t val;
 779         dbus_message_iter_get_basic (iter, &val);
 780         XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 781         return make_number (val);
 782       }
 783
 784     case DBUS_TYPE_INT32:
 785       {
 786         dbus_int32_t val;
 787         dbus_message_iter_get_basic (iter, &val);
 788         XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 789         return make_fixnum_or_float (val);
 790       }
 791
 792     case DBUS_TYPE_UINT32:
 793 #ifdef DBUS_TYPE_UNIX_FD
 794     case DBUS_TYPE_UNIX_FD:
 795 #endif
 796       {
 797         dbus_uint32_t val;
 798         dbus_message_iter_get_basic (iter, &val);
 799         XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 800         return make_fixnum_or_float (val);
 801       }
 802
 803     case DBUS_TYPE_INT64:
 804       {
 805         dbus_int64_t val;
 806         dbus_message_iter_get_basic (iter, &val);
 807         XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
 808         return make_fixnum_or_float (val);
 809       }
 810
 811     case DBUS_TYPE_UINT64:
 812       {
 813         dbus_uint64_t val;
 814         dbus_message_iter_get_basic (iter, &val);
 815         XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
 816         return make_fixnum_or_float (val);
 817       }
 818
 819     case DBUS_TYPE_DOUBLE:
 820       {
 821         double val;
 822         dbus_message_iter_get_basic (iter, &val);
 823         XD_DEBUG_MESSAGE ("%c %f", dtype, val);
 824         return make_float (val);
 825       }
 826
 827     case DBUS_TYPE_STRING:
 828     case DBUS_TYPE_OBJECT_PATH:
 829     case DBUS_TYPE_SIGNATURE:
 830       {
 831         char *val;
 832         dbus_message_iter_get_basic (iter, &val);
 833         XD_DEBUG_MESSAGE ("%c %s", dtype, val);
 834         return build_string (val);
 835       }
 836
 837     case DBUS_TYPE_ARRAY:
 838     case DBUS_TYPE_VARIANT:
 839     case DBUS_TYPE_STRUCT:
 840     case DBUS_TYPE_DICT_ENTRY:
 841       {
 842         Lisp_Object result;
 843         struct gcpro gcpro1;
 844         DBusMessageIter subiter;
 845         int subtype;
 846         result = Qnil;
 847         GCPRO1 (result);
 848         dbus_message_iter_recurse (iter, &subiter);
 849         while ((subtype = dbus_message_iter_get_arg_type (&subiter))
 850                != DBUS_TYPE_INVALID)
 851           {
 852             result = Fcons (xd_retrieve_arg (subtype, &subiter), result);
 853             dbus_message_iter_next (&subiter);
 854           }
 855         XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (result));
 856         RETURN_UNGCPRO (Fnreverse (result));
 857       }
 858
 859     default:
 860       XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype);
 861       return Qnil;
 862     }
 863 }
 864
 865 /* Return the number of references of the shared CONNECTION.  */
 866 static int
 867 xd_get_connection_references (DBusConnection *connection)
 868 {
 869   ptrdiff_t *refcount;
 870
 871   /* We cannot access the DBusConnection structure, it is not public.
 872      But we know, that the reference counter is the first field in
 873      that structure.  */
 874   refcount = (void *) &connection;
 875   refcount =  (void *) *refcount;
 876   return *refcount;
 877 }
 878
 879 /* Return D-Bus connection address.  BUS is either a Lisp symbol,
 880    :system or :session, or a string denoting the bus address.  */
 881 static DBusConnection *
 882 xd_get_connection_address (Lisp_Object bus)
 883 {
 884   DBusConnection *connection;
 885   Lisp_Object val;
 886
 887   val = CDR_SAFE (Fassoc (bus, Vdbus_registered_buses));
 888   if (NILP (val))
 889     XD_SIGNAL2 (build_string ("No connection to bus"), bus);
 890   else
 891     connection = (DBusConnection *) XFASTINT (val);
 892
 893   if (!dbus_connection_get_is_connected (connection))
 894     XD_SIGNAL2 (build_string ("No connection to bus"), bus);
 895
 896   return connection;
 897 }
 898
 899 /* Return the file descriptor for WATCH, -1 if not found.  */
 900 static int
 901 xd_find_watch_fd (DBusWatch *watch)
 902 {
 903 #if HAVE_DBUS_WATCH_GET_UNIX_FD
 904   /* TODO: Reverse these on Win32, which prefers the opposite.  */
 905   int fd = dbus_watch_get_unix_fd (watch);
 906   if (fd == -1)
 907     fd = dbus_watch_get_socket (watch);
 908 #else
 909   int fd = dbus_watch_get_fd (watch);
 910 #endif
 911   return fd;
 912 }
 913
 914 /* Prototype.  */
 915 static void
 916 xd_read_queued_messages (int fd, void *data, int for_read);
 917
 918 /* Start monitoring WATCH for possible I/O.  */
 919 static dbus_bool_t
 920 xd_add_watch (DBusWatch *watch, void *data)
 921 {
 922   unsigned int flags = dbus_watch_get_flags (watch);
 923   int fd = xd_find_watch_fd (watch);
 924
 925   XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d",
 926                     fd, flags & DBUS_WATCH_WRITABLE,
 927                     dbus_watch_get_enabled (watch));
 928
 929   if (fd == -1)
 930     return FALSE;
 931
 932   if (dbus_watch_get_enabled (watch))
 933     {
 934       if (flags & DBUS_WATCH_WRITABLE)
 935         add_write_fd (fd, xd_read_queued_messages, data);
 936       if (flags & DBUS_WATCH_READABLE)
 937         add_read_fd (fd, xd_read_queued_messages, data);
 938     }
 939   return TRUE;
 940 }
 941
 942 /* Stop monitoring WATCH for possible I/O.
 943    DATA is the used bus, either a string or QCdbus_system_bus or
 944    QCdbus_session_bus.  */
 945 static void
 946 xd_remove_watch (DBusWatch *watch, void *data)
 947 {
 948   unsigned int flags = dbus_watch_get_flags (watch);
 949   int fd = xd_find_watch_fd (watch);
 950
 951   XD_DEBUG_MESSAGE ("fd %d", fd);
 952
 953   if (fd == -1)
 954     return;
 955
 956   /* Unset session environment.  */
 957   if (XSYMBOL (QCdbus_session_bus) == data)
 958     {
 959       //      XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
 960       //      unsetenv ("DBUS_SESSION_BUS_ADDRESS");
 961     }
 962
 963   if (flags & DBUS_WATCH_WRITABLE)
 964     delete_write_fd (fd);
 965   if (flags & DBUS_WATCH_READABLE)
 966     delete_read_fd (fd);
 967 }
 968
 969 /* Toggle monitoring WATCH for possible I/O.  */
 970 static void
 971 xd_toggle_watch (DBusWatch *watch, void *data)
 972 {
 973   if (dbus_watch_get_enabled (watch))
 974     xd_add_watch (watch, data);
 975   else
 976     xd_remove_watch (watch, data);
 977 }
 978
 979 /* Close connection to D-Bus BUS.  */
 980 static void
 981 xd_close_bus (Lisp_Object bus)
 982 {
 983   DBusConnection *connection;
 984   Lisp_Object val;
 985
 986   /* Check whether we are connected.  */
 987   val = Fassoc (bus, Vdbus_registered_buses);
 988   if (NILP (val))
 989     return;
 990
 991   /* Retrieve bus address.  */
 992   connection = xd_get_connection_address (bus);
 993
 994   /* Close connection, if there isn't another shared application.  */
 995   if (xd_get_connection_references (connection) == 1)
 996     {
 997       XD_DEBUG_MESSAGE ("Close connection to bus %s",
 998                         XD_OBJECT_TO_STRING (bus));
 999       dbus_connection_close (connection);
1000     }
1001
1002   /* Decrement reference count.  */
1003   dbus_connection_unref (connection);
1004
1005   /* Remove bus from list of registered buses.  */
1006   Vdbus_registered_buses = Fdelete (val, Vdbus_registered_buses);
1007
1008   /* Return.  */
1009   return;
1010 }
1011
1012 DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 2, 0,
1013        doc: /* Establish the connection to D-Bus BUS.
1014
1015 BUS can be either the symbol `:system' or the symbol `:session', or it
1016 can be a string denoting the address of the corresponding bus.  For
1017 the system and session buses, this function is called when loading
1018 `dbus.el', there is no need to call it again.
1019
1020 The function returns a number, which counts the connections this Emacs
1021 session has established to the BUS under the same unique name (see
1022 `dbus-get-unique-name').  It depends on the libraries Emacs is linked
1023 with, and on the environment Emacs is running.  For example, if Emacs
1024 is linked with the gtk toolkit, and it runs in a GTK-aware environment
1025 like Gnome, another connection might already be established.
1026
1027 When PRIVATE is non-nil, a new connection is established instead of
1028 reusing an existing one.  It results in a new unique name at the bus.
1029 This can be used, if it is necessary to distinguish from another
1030 connection used in the same Emacs process, like the one established by
1031 GTK+.  It should be used with care for at least the `:system' and
1032 `:session' buses, because other Emacs Lisp packages might already use
1033 this connection to those buses.  */)
1034   (Lisp_Object bus, Lisp_Object private)
1035 {
1036   DBusConnection *connection;
1037   DBusError derror;
1038   Lisp_Object val;
1039   int refcount;
1040
1041   /* Check parameter.  */
1042   XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
1043
1044   /* Close bus if it is already open.  */
1045   xd_close_bus (bus);
1046
1047   /* Initialize.  */
1048   dbus_error_init (&derror);
1049
1050   /* Open the connection.  */
1051   if (STRINGP (bus))
1052     if (NILP (private))
1053       connection = dbus_connection_open (SSDATA (bus), &derror);
1054     else
1055       connection = dbus_connection_open_private (SSDATA (bus), &derror);
1056
1057   else
1058     if (NILP (private))
1059       connection = dbus_bus_get (EQ (bus, QCdbus_system_bus)
1060                                  ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
1061                                  &derror);
1062     else
1063       connection = dbus_bus_get_private (EQ (bus, QCdbus_system_bus)
1064                                          ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
1065                                          &derror);
1066
1067   if (dbus_error_is_set (&derror))
1068     XD_ERROR (derror);
1069
1070   if (connection == NULL)
1071     XD_SIGNAL2 (build_string ("No connection to bus"), bus);
1072
1073   /* If it is not the system or session bus, we must register
1074      ourselves.  Otherwise, we have called dbus_bus_get, which has
1075      configured us to exit if the connection closes - we undo this
1076      setting.  */
1077   if (STRINGP (bus))
1078     dbus_bus_register (connection, &derror);
1079   else
1080     dbus_connection_set_exit_on_disconnect (connection, FALSE);
1081
1082   if (dbus_error_is_set (&derror))
1083     XD_ERROR (derror);
1084
1085   /* Add the watch functions.  We pass also the bus as data, in order
1086      to distinguish between the buses in xd_remove_watch.  */
1087   if (!dbus_connection_set_watch_functions (connection,
1088                                             xd_add_watch,
1089                                             xd_remove_watch,
1090                                             xd_toggle_watch,
1091                                             SYMBOLP (bus)
1092                                             ? (void *) XSYMBOL (bus)
1093                                             : (void *) XSTRING (bus),
1094                                             NULL))
1095     XD_SIGNAL1 (build_string ("Cannot add watch functions"));
1096
1097   /* Add bus to list of registered buses.  */
1098   XSETFASTINT (val, connection);
1099   Vdbus_registered_buses = Fcons (Fcons (bus, val), Vdbus_registered_buses);
1100
1101   /* We do not want to abort.  */
1102   putenv ((char *) "DBUS_FATAL_WARNINGS=0");
1103
1104   /* Cleanup.  */
1105   dbus_error_free (&derror);
1106
1107   /* Return reference counter.  */
1108   refcount = xd_get_connection_references (connection);
1109   XD_DEBUG_MESSAGE ("Bus %s, Reference counter %d",
1110                     XD_OBJECT_TO_STRING (bus), refcount);
1111   return make_number (refcount);
1112 }
1113
1114 DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
1115        1, 1, 0,
1116        doc: /* Return the unique name of Emacs registered at D-Bus BUS.  */)
1117   (Lisp_Object bus)
1118 {
1119   DBusConnection *connection;
1120   const char *name;
1121
1122   /* Check parameter.  */
1123   XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
1124
1125   /* Retrieve bus address.  */
1126   connection = xd_get_connection_address (bus);
1127
1128   /* Request the name.  */
1129   name = dbus_bus_get_unique_name (connection);
1130   if (name == NULL)
1131     XD_SIGNAL1 (build_string ("No unique name available"));
1132
1133   /* Return.  */
1134   return build_string (name);
1135 }
1136
1137 DEFUN ("dbus-message-internal", Fdbus_message_internal, Sdbus_message_internal,
1138        4, MANY, 0,
1139        doc: /* Send a D-Bus message.
1140 This is an internal function, it shall not be used outside dbus.el.
1141
1142 The following usages are expected:
1143
1144 `dbus-call-method', `dbus-call-method-asynchronously':
1145   \(dbus-message-internal
1146     dbus-message-type-method-call BUS SERVICE PATH INTERFACE METHOD HANDLER
1147     &optional :timeout TIMEOUT &rest ARGS)
1148
1149 `dbus-send-signal':
1150   \(dbus-message-internal
1151     dbus-message-type-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)
1152
1153 `dbus-method-return-internal':
1154   \(dbus-message-internal
1155     dbus-message-type-method-return BUS SERVICE SERIAL &rest ARGS)
1156
1157 `dbus-method-error-internal':
1158   \(dbus-message-internal
1159     dbus-message-type-error BUS SERVICE SERIAL &rest ARGS)
1160
1161 usage: (dbus-message-internal &rest REST)  */)
1162   (ptrdiff_t nargs, Lisp_Object *args)
1163 {
1164   Lisp_Object message_type, bus, service, handler;
1165   Lisp_Object path = Qnil;
1166   Lisp_Object interface = Qnil;
1167   Lisp_Object member = Qnil;
1168   Lisp_Object result;
1169   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1170   DBusConnection *connection;
1171   DBusMessage *dmessage;
1172   DBusMessageIter iter;
1173   unsigned int dtype;
1174   unsigned int mtype;
1175   dbus_uint32_t serial = 0;
1176   int timeout = -1;
1177   ptrdiff_t count;
1178   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1179
1180   /* Initialize parameters.  */
1181   message_type = args[0];
1182   bus = args[1];
1183   service = args[2];
1184   handler = Qnil;
1185
1186   CHECK_NATNUM (message_type);
1187   mtype = XFASTINT (message_type);
1188   if ((mtype <= DBUS_MESSAGE_TYPE_INVALID) || (mtype >= DBUS_NUM_MESSAGE_TYPES))
1189     XD_SIGNAL2 (build_string ("Invalid message type"), message_type);
1190
1191   if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1192       || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
1193     {
1194       path = args[3];
1195       interface = args[4];
1196       member = args[5];
1197       if (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1198         handler = args[6];
1199       count = (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) ? 7 : 6;
1200     }
1201   else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR  */
1202     {
1203       XD_CHECK_DBUS_SERIAL (args[3], serial);
1204       count = 4;
1205     }
1206
1207   /* Check parameters.  */
1208   XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
1209   XD_DBUS_VALIDATE_BUS_NAME (service);
1210   if (nargs < count)
1211     xsignal2 (Qwrong_number_of_arguments,
1212               Qdbus_message_internal,
1213               make_number (nargs));
1214
1215   if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1216       || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
1217     {
1218       XD_DBUS_VALIDATE_PATH (path);
1219       XD_DBUS_VALIDATE_INTERFACE (interface);
1220       XD_DBUS_VALIDATE_MEMBER (member);
1221       if (!NILP (handler) && (!FUNCTIONP (handler)))
1222         wrong_type_argument (Qinvalid_function, handler);
1223     }
1224
1225   /* Protect Lisp variables.  */
1226   GCPRO6 (bus, service, path, interface, member, handler);
1227
1228   /* Trace parameters.  */
1229   switch (mtype)
1230     {
1231     case DBUS_MESSAGE_TYPE_METHOD_CALL:
1232       XD_DEBUG_MESSAGE ("%s %s %s %s %s %s %s",
1233                         XD_MESSAGE_TYPE_TO_STRING (mtype),
1234                         XD_OBJECT_TO_STRING (bus),
1235                         XD_OBJECT_TO_STRING (service),
1236                         XD_OBJECT_TO_STRING (path),
1237                         XD_OBJECT_TO_STRING (interface),
1238                         XD_OBJECT_TO_STRING (member),
1239                         XD_OBJECT_TO_STRING (handler));
1240       break;
1241     case DBUS_MESSAGE_TYPE_SIGNAL:
1242       XD_DEBUG_MESSAGE ("%s %s %s %s %s %s",
1243                         XD_MESSAGE_TYPE_TO_STRING (mtype),
1244                         XD_OBJECT_TO_STRING (bus),
1245                         XD_OBJECT_TO_STRING (service),
1246                         XD_OBJECT_TO_STRING (path),
1247                         XD_OBJECT_TO_STRING (interface),
1248                         XD_OBJECT_TO_STRING (member));
1249       break;
1250     default: /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR  */
1251       XD_DEBUG_MESSAGE ("%s %s %s %u",
1252                         XD_MESSAGE_TYPE_TO_STRING (mtype),
1253                         XD_OBJECT_TO_STRING (bus),
1254                         XD_OBJECT_TO_STRING (service),
1255                         serial);
1256     }
1257
1258   /* Retrieve bus address.  */
1259   connection = xd_get_connection_address (bus);
1260
1261   /* Create the D-Bus message.  */
1262   dmessage = dbus_message_new (mtype);
1263   if (dmessage == NULL)
1264     {
1265       UNGCPRO;
1266       XD_SIGNAL1 (build_string ("Unable to create a new message"));
1267     }
1268
1269   if (STRINGP (service))
1270     {
1271       if (mtype != DBUS_MESSAGE_TYPE_SIGNAL)
1272         /* Set destination.  */
1273         {
1274           if (!dbus_message_set_destination (dmessage, SSDATA (service)))
1275             {
1276               UNGCPRO;
1277               XD_SIGNAL2 (build_string ("Unable to set the destination"),
1278                           service);
1279             }
1280         }
1281
1282       else
1283         /* Set destination for unicast signals.  */
1284         {
1285           Lisp_Object uname;
1286
1287           /* If it is the same unique name as we are registered at the
1288              bus or an unknown name, we regard it as broadcast message
1289              due to backward compatibility.  */
1290           if (dbus_bus_name_has_owner (connection, SSDATA (service), NULL))
1291             uname = call2 (intern ("dbus-get-name-owner"), bus, service);
1292           else
1293             uname = Qnil;
1294
1295           if (STRINGP (uname)
1296               && (strcmp (dbus_bus_get_unique_name (connection), SSDATA (uname))
1297                   != 0)
1298               && (!dbus_message_set_destination (dmessage, SSDATA (service))))
1299             {
1300               UNGCPRO;
1301               XD_SIGNAL2 (build_string ("Unable to set signal destination"),
1302                           service);
1303             }
1304         }
1305     }
1306
1307   /* Set message parameters.  */
1308   if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1309       || (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
1310     {
1311       if ((!dbus_message_set_path (dmessage, SSDATA (path)))
1312           || (!dbus_message_set_interface (dmessage, SSDATA (interface)))
1313           || (!dbus_message_set_member (dmessage, SSDATA (member))))
1314         {
1315           UNGCPRO;
1316           XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
1317         }
1318     }
1319
1320   else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR  */
1321     {
1322       if (!dbus_message_set_reply_serial (dmessage, serial))
1323         {
1324           UNGCPRO;
1325           XD_SIGNAL1 (build_string ("Unable to create a return message"));
1326         }
1327
1328       if ((mtype == DBUS_MESSAGE_TYPE_ERROR)
1329           && (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED)))
1330         {
1331           UNGCPRO;
1332           XD_SIGNAL1 (build_string ("Unable to create a error message"));
1333         }
1334     }
1335
1336   /* Check for timeout parameter.  */
1337   if ((count+2 <= nargs) && (EQ ((args[count]), QCdbus_timeout)))
1338     {
1339       CHECK_NATNUM (args[count+1]);
1340       timeout = XFASTINT (args[count+1]);
1341       count = count+2;
1342     }
1343
1344   /* Initialize parameter list of message.  */
1345   dbus_message_iter_init_append (dmessage, &iter);
1346
1347   /* Append parameters to the message.  */
1348   for (; count < nargs; ++count)
1349     {
1350       dtype = XD_OBJECT_TO_DBUS_TYPE (args[count]);
1351       if (XD_DBUS_TYPE_P (args[count]))
1352         {
1353           XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
1354           XD_DEBUG_VALID_LISP_OBJECT_P (args[count+1]);
1355           XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", count - 4,
1356                             XD_OBJECT_TO_STRING (args[count]),
1357                             XD_OBJECT_TO_STRING (args[count+1]));
1358           ++count;
1359         }
1360       else
1361         {
1362           XD_DEBUG_VALID_LISP_OBJECT_P (args[count]);
1363           XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", count - 4,
1364                             XD_OBJECT_TO_STRING (args[count]));
1365         }
1366
1367       /* Check for valid signature.  We use DBUS_TYPE_INVALID as
1368          indication that there is no parent type.  */
1369       xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[count]);
1370
1371       xd_append_arg (dtype, args[count], &iter);
1372     }
1373
1374   if (!NILP (handler))
1375     {
1376       /* Send the message.  The message is just added to the outgoing
1377          message queue.  */
1378       if (!dbus_connection_send_with_reply (connection, dmessage,
1379                                             NULL, timeout))
1380         {
1381           UNGCPRO;
1382           XD_SIGNAL1 (build_string ("Cannot send message"));
1383         }
1384
1385       /* The result is the key in Vdbus_registered_objects_table.  */
1386       serial = dbus_message_get_serial (dmessage);
1387       result = list3 (QCdbus_registered_serial,
1388                       bus, make_fixnum_or_float (serial));
1389
1390       /* Create a hash table entry.  */
1391       Fputhash (result, handler, Vdbus_registered_objects_table);
1392     }
1393   else
1394     {
1395       /* Send the message.  The message is just added to the outgoing
1396          message queue.  */
1397       if (!dbus_connection_send (connection, dmessage, NULL))
1398         {
1399           UNGCPRO;
1400           XD_SIGNAL1 (build_string ("Cannot send message"));
1401         }
1402
1403       result = Qnil;
1404     }
1405
1406   XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result));
1407
1408   /* Cleanup.  */
1409   dbus_message_unref (dmessage);
1410
1411   /* Return the result.  */
1412   RETURN_UNGCPRO (result);
1413 }
1414
1415 /* Read one queued incoming message of the D-Bus BUS.
1416    BUS is either a Lisp symbol, :system or :session, or a string denoting
1417    the bus address.  */
1418 static void
1419 xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1420 {
1421   Lisp_Object args, key, value;
1422   struct gcpro gcpro1;
1423   struct input_event event;
1424   DBusMessage *dmessage;
1425   DBusMessageIter iter;
1426   unsigned int dtype;
1427   unsigned int mtype;
1428   dbus_uint32_t serial;
1429   unsigned int ui_serial;
1430   const char *uname, *path, *interface, *member;
1431
1432   dmessage = dbus_connection_pop_message (connection);
1433
1434   /* Return if there is no queued message.  */
1435   if (dmessage == NULL)
1436     return;
1437
1438   /* Collect the parameters.  */
1439   args = Qnil;
1440   GCPRO1 (args);
1441
1442   /* Loop over the resulting parameters.  Construct a list.  */
1443   if (dbus_message_iter_init (dmessage, &iter))
1444     {
1445       while ((dtype = dbus_message_iter_get_arg_type (&iter))
1446              != DBUS_TYPE_INVALID)
1447         {
1448           args = Fcons (xd_retrieve_arg (dtype, &iter), args);
1449           dbus_message_iter_next (&iter);
1450         }
1451       /* The arguments are stored in reverse order.  Reorder them.  */
1452       args = Fnreverse (args);
1453     }
1454
1455   /* Read message type, message serial, unique name, object path,
1456      interface and member from the message.  */
1457   mtype = dbus_message_get_type (dmessage);
1458   ui_serial = serial =
1459     ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1460      || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1461     ? dbus_message_get_reply_serial (dmessage)
1462     : dbus_message_get_serial (dmessage);
1463   uname = dbus_message_get_sender (dmessage);
1464   path = dbus_message_get_path (dmessage);
1465   interface = dbus_message_get_interface (dmessage);
1466   member = dbus_message_get_member (dmessage);
1467
1468   XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s",
1469                     XD_MESSAGE_TYPE_TO_STRING (mtype),
1470                     ui_serial, uname, path, interface, member,
1471                     XD_OBJECT_TO_STRING (args));
1472
1473   if (mtype == DBUS_MESSAGE_TYPE_INVALID)
1474     goto cleanup;
1475
1476   else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1477            || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1478     {
1479       /* Search for a registered function of the message.  */
1480       key = list3 (QCdbus_registered_serial, bus,
1481                    make_fixnum_or_float (serial));
1482       value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1483
1484       /* There shall be exactly one entry.  Construct an event.  */
1485       if (NILP (value))
1486         goto cleanup;
1487
1488       /* Remove the entry.  */
1489       Fremhash (key, Vdbus_registered_objects_table);
1490
1491       /* Construct an event.  */
1492       EVENT_INIT (event);
1493       event.kind = DBUS_EVENT;
1494       event.frame_or_window = Qnil;
1495       event.arg = Fcons (value, args);
1496     }
1497
1498   else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL.  */
1499     {
1500       /* Vdbus_registered_objects_table requires non-nil interface and
1501          member.  */
1502       if ((interface == NULL) || (member == NULL))
1503         goto cleanup;
1504
1505       /* Search for a registered function of the message.  */
1506       key = list4 ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1507                    ? QCdbus_registered_method
1508                    : QCdbus_registered_signal,
1509                    bus, build_string (interface), build_string (member));
1510       value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1511
1512       /* Loop over the registered functions.  Construct an event.  */
1513       while (!NILP (value))
1514         {
1515           key = CAR_SAFE (value);
1516           /* key has the structure (UNAME SERVICE PATH HANDLER).  */
1517           if (((uname == NULL)
1518                || (NILP (CAR_SAFE (key)))
1519                || (strcmp (uname, SSDATA (CAR_SAFE (key))) == 0))
1520               && ((path == NULL)
1521                   || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1522                   || (strcmp (path,
1523                               SSDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1524                       == 0))
1525               && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))))))
1526             {
1527               EVENT_INIT (event);
1528               event.kind = DBUS_EVENT;
1529               event.frame_or_window = Qnil;
1530               event.arg
1531                 = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))), args);
1532               break;
1533             }
1534           value = CDR_SAFE (value);
1535         }
1536
1537       if (NILP (value))
1538         goto cleanup;
1539     }
1540
1541   /* Add type, serial, uname, path, interface and member to the event.  */
1542   event.arg = Fcons ((member == NULL ? Qnil : build_string (member)),
1543                      event.arg);
1544   event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)),
1545                      event.arg);
1546   event.arg = Fcons ((path == NULL ? Qnil : build_string (path)),
1547                      event.arg);
1548   event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)),
1549                      event.arg);
1550   event.arg = Fcons (make_fixnum_or_float (serial), event.arg);
1551   event.arg = Fcons (make_number (mtype), event.arg);
1552
1553   /* Add the bus symbol to the event.  */
1554   event.arg = Fcons (bus, event.arg);
1555
1556   /* Store it into the input event queue.  */
1557   kbd_buffer_store_event (&event);
1558
1559   XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event.arg));
1560
1561   /* Cleanup.  */
1562  cleanup:
1563   dbus_message_unref (dmessage);
1564
1565   UNGCPRO;
1566 }
1567
1568 /* Read queued incoming messages of the D-Bus BUS.
1569    BUS is either a Lisp symbol, :system or :session, or a string denoting
1570    the bus address.  */
1571 static Lisp_Object
1572 xd_read_message (Lisp_Object bus)
1573 {
1574   /* Retrieve bus address.  */
1575   DBusConnection *connection = xd_get_connection_address (bus);
1576
1577   /* Non blocking read of the next available message.  */
1578   dbus_connection_read_write (connection, 0);
1579
1580   while (dbus_connection_get_dispatch_status (connection)
1581          != DBUS_DISPATCH_COMPLETE)
1582     xd_read_message_1 (connection, bus);
1583   return Qnil;
1584 }
1585
1586 /* Callback called when something is ready to read or write.  */
1587 static void
1588 xd_read_queued_messages (int fd, void *data, int for_read)
1589 {
1590   Lisp_Object busp = Vdbus_registered_buses;
1591   Lisp_Object bus = Qnil;
1592   Lisp_Object key;
1593
1594   /* Find bus related to fd.  */
1595   if (data != NULL)
1596     while (!NILP (busp))
1597       {
1598         key = CAR_SAFE (CAR_SAFE (busp));
1599         if ((SYMBOLP (key) && XSYMBOL (key) == data)
1600             || (STRINGP (key) && XSTRING (key) == data))
1601           bus = key;
1602         busp = CDR_SAFE (busp);
1603       }
1604
1605   if (NILP (bus))
1606     return;
1607
1608   /* We ignore all Lisp errors during the call.  */
1609   xd_in_read_queued_messages = 1;
1610   internal_catch (Qdbus_error, xd_read_message, bus);
1611   xd_in_read_queued_messages = 0;
1612 }
1613
1614 \f
1615 void
1616 syms_of_dbusbind (void)
1617 {
1618
1619   DEFSYM (Qdbus_init_bus, "dbus-init-bus");
1620   defsubr (&Sdbus_init_bus);
1621
1622   DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name");
1623   defsubr (&Sdbus_get_unique_name);
1624
1625   DEFSYM (Qdbus_message_internal, "dbus-message-internal");
1626   defsubr (&Sdbus_message_internal);
1627
1628   DEFSYM (Qdbus_error, "dbus-error");
1629   Fput (Qdbus_error, Qerror_conditions,
1630         list2 (Qdbus_error, Qerror));
1631   Fput (Qdbus_error, Qerror_message,
1632         make_pure_c_string ("D-Bus error"));
1633
1634   DEFSYM (QCdbus_system_bus, ":system");
1635   DEFSYM (QCdbus_session_bus, ":session");
1636   DEFSYM (QCdbus_timeout, ":timeout");
1637   DEFSYM (QCdbus_type_byte, ":byte");
1638   DEFSYM (QCdbus_type_boolean, ":boolean");
1639   DEFSYM (QCdbus_type_int16, ":int16");
1640   DEFSYM (QCdbus_type_uint16, ":uint16");
1641   DEFSYM (QCdbus_type_int32, ":int32");
1642   DEFSYM (QCdbus_type_uint32, ":uint32");
1643   DEFSYM (QCdbus_type_int64, ":int64");
1644   DEFSYM (QCdbus_type_uint64, ":uint64");
1645   DEFSYM (QCdbus_type_double, ":double");
1646   DEFSYM (QCdbus_type_string, ":string");
1647   DEFSYM (QCdbus_type_object_path, ":object-path");
1648   DEFSYM (QCdbus_type_signature, ":signature");
1649 #ifdef DBUS_TYPE_UNIX_FD
1650   DEFSYM (QCdbus_type_unix_fd, ":unix-fd");
1651 #endif
1652   DEFSYM (QCdbus_type_array, ":array");
1653   DEFSYM (QCdbus_type_variant, ":variant");
1654   DEFSYM (QCdbus_type_struct, ":struct");
1655   DEFSYM (QCdbus_type_dict_entry, ":dict-entry");
1656   DEFSYM (QCdbus_registered_serial, ":serial");
1657   DEFSYM (QCdbus_registered_method, ":method");
1658   DEFSYM (QCdbus_registered_signal, ":signal");
1659
1660   DEFVAR_LISP ("dbus-compiled-version",
1661                Vdbus_compiled_version,
1662     doc: /* The version of D-Bus Emacs is compiled against.  */);
1663 #ifdef DBUS_VERSION_STRING
1664   Vdbus_compiled_version = make_pure_c_string (DBUS_VERSION_STRING);
1665 #else
1666   Vdbus_compiled_version = Qnil;
1667 #endif
1668
1669   DEFVAR_LISP ("dbus-runtime-version",
1670                Vdbus_runtime_version,
1671     doc: /* The version of D-Bus Emacs runs with.  */);
1672   {
1673 #ifdef DBUS_VERSION
1674     int major, minor, micro;
1675     char s[1024];
1676     dbus_get_version (&major, &minor, &micro);
1677     snprintf (s, sizeof s, "%d.%d.%d", major, minor, micro);
1678     Vdbus_runtime_version = make_string (s, strlen (s));
1679 #else
1680     Vdbus_runtime_version = Qnil;
1681 #endif
1682   }
1683
1684   DEFVAR_LISP ("dbus-message-type-invalid",
1685                Vdbus_message_type_invalid,
1686     doc: /* This value is never a valid message type.  */);
1687   Vdbus_message_type_invalid = make_number (DBUS_MESSAGE_TYPE_INVALID);
1688
1689   DEFVAR_LISP ("dbus-message-type-method-call",
1690                Vdbus_message_type_method_call,
1691     doc: /* Message type of a method call message.  */);
1692   Vdbus_message_type_method_call = make_number (DBUS_MESSAGE_TYPE_METHOD_CALL);
1693
1694   DEFVAR_LISP ("dbus-message-type-method-return",
1695                Vdbus_message_type_method_return,
1696     doc: /* Message type of a method return message.  */);
1697   Vdbus_message_type_method_return
1698     = make_number (DBUS_MESSAGE_TYPE_METHOD_RETURN);
1699
1700   DEFVAR_LISP ("dbus-message-type-error",
1701                Vdbus_message_type_error,
1702     doc: /* Message type of an error reply message.  */);
1703   Vdbus_message_type_error = make_number (DBUS_MESSAGE_TYPE_ERROR);
1704
1705   DEFVAR_LISP ("dbus-message-type-signal",
1706                Vdbus_message_type_signal,
1707     doc: /* Message type of a signal message.  */);
1708   Vdbus_message_type_signal = make_number (DBUS_MESSAGE_TYPE_SIGNAL);
1709
1710   DEFVAR_LISP ("dbus-registered-buses",
1711                Vdbus_registered_buses,
1712     doc: /* Alist of D-Bus buses we are polling for messages.
1713
1714 The key is the symbol or string of the bus, and the value is the
1715 connection address.  */);
1716   Vdbus_registered_buses = Qnil;
1717
1718   DEFVAR_LISP ("dbus-registered-objects-table",
1719                Vdbus_registered_objects_table,
1720     doc: /* Hash table of registered functions for D-Bus.
1721
1722 There are two different uses of the hash table: for accessing
1723 registered interfaces properties, targeted by signals or method calls,
1724 and for calling handlers in case of non-blocking method call returns.
1725
1726 In the first case, the key in the hash table is the list (TYPE BUS
1727 INTERFACE MEMBER).  TYPE is one of the Lisp symbols `:method',
1728 `:signal' or `:property'.  BUS is either a Lisp symbol, `:system' or
1729 `:session', or a string denoting the bus address.  INTERFACE is a
1730 string which denotes a D-Bus interface, and MEMBER, also a string, is
1731 either a method, a signal or a property INTERFACE is offering.  All
1732 arguments but BUS must not be nil.
1733
1734 The value in the hash table is a list of quadruple lists \((UNAME
1735 SERVICE PATH OBJECT [RULE]) ...).  SERVICE is the service name as
1736 registered, UNAME is the corresponding unique name.  In case of
1737 registered methods and properties, UNAME is nil.  PATH is the object
1738 path of the sending object.  All of them can be nil, which means a
1739 wildcard then.  OBJECT is either the handler to be called when a D-Bus
1740 message, which matches the key criteria, arrives (TYPE `:method' and
1741 `:signal'), or a cons cell containing the value of the property (TYPE
1742 `:property').
1743
1744 For entries of type `:signal', there is also a fifth element RULE,
1745 which keeps the match string the signal is registered with.
1746
1747 In the second case, the key in the hash table is the list (:serial BUS
1748 SERIAL).  BUS is either a Lisp symbol, `:system' or `:session', or a
1749 string denoting the bus address.  SERIAL is the serial number of the
1750 non-blocking method call, a reply is expected.  Both arguments must
1751 not be nil.  The value in the hash table is HANDLER, the function to
1752 be called when the D-Bus reply message arrives.  */);
1753   {
1754     Lisp_Object args[2];
1755     args[0] = QCtest;
1756     args[1] = Qequal;
1757     Vdbus_registered_objects_table = Fmake_hash_table (2, args);
1758   }
1759
1760   DEFVAR_LISP ("dbus-debug", Vdbus_debug,
1761     doc: /* If non-nil, debug messages of D-Bus bindings are raised.  */);
1762 #ifdef DBUS_DEBUG
1763   Vdbus_debug = Qt;
1764   /* We can also set environment variable DBUS_VERBOSE=1 in order to
1765      see more traces.  This requires libdbus-1 to be configured with
1766      --enable-verbose-mode.  */
1767 #else
1768   Vdbus_debug = Qnil;
1769 #endif
1770
1771   Fprovide (intern_c_string ("dbusbind"), Qnil);
1772
1773 }
1774
1775 #endif /* HAVE_DBUS */