code.delx.au - gnu-emacs/blob - src/dbusbind.c

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