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