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