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