src/dbusbind.c

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