cgit.sxemacs.org Git - sxemacs/blob - modules/dbus/dbusbind.c

   1 /* Elisp bindings for D-Bus.
   2    Copyright (C) 2007-2011 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software: you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation, either version 3 of the License, or
   9 (at your option) any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
  18
  19 #include <config.h>
  20
  21 #ifdef HAVE_DBUS
  22 #include <stdio.h>
  23 #include <dbus/dbus.h>
  24 #include <setjmp.h>
  25 #include "lisp.h"
  26 #include "frame.h"
  27 #include "termhooks.h"
  28 #include "keyboard.h"
  29 #include "process.h"
  30
  31 \f
  32 /* Subroutines.  */
  33 static Lisp_Object Qdbus_init_bus;
  34 static Lisp_Object Qdbus_close_bus;
  35 static Lisp_Object Qdbus_get_unique_name;
  36 static Lisp_Object Qdbus_call_method;
  37 static Lisp_Object Qdbus_call_method_asynchronously;
  38 static Lisp_Object Qdbus_method_return_internal;
  39 static Lisp_Object Qdbus_method_error_internal;
  40 static Lisp_Object Qdbus_send_signal;
  41 static Lisp_Object Qdbus_register_service;
  42 static Lisp_Object Qdbus_register_signal;
  43 static Lisp_Object Qdbus_register_method;
  44
  45 /* D-Bus error symbol.  */
  46 static Lisp_Object Qdbus_error;
  47
  48 /* Lisp symbols of the system and session buses.  */
  49 static Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
  50
  51 /* Lisp symbol for method call timeout.  */
  52 static Lisp_Object QCdbus_timeout;
  53
  54 /* Lisp symbols for name request flags.  */
  55 static Lisp_Object QCdbus_request_name_allow_replacement;
  56 static Lisp_Object QCdbus_request_name_replace_existing;
  57 static Lisp_Object QCdbus_request_name_do_not_queue;
  58
  59 /* Lisp symbols for name request replies.  */
  60 static Lisp_Object QCdbus_request_name_reply_primary_owner;
  61 static Lisp_Object QCdbus_request_name_reply_in_queue;
  62 static Lisp_Object QCdbus_request_name_reply_exists;
  63 static Lisp_Object QCdbus_request_name_reply_already_owner;
  64
  65 /* Lisp symbols of D-Bus types.  */
  66 static Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
  67 static Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
  68 static Lisp_Object QCdbus_type_int32, QCdbus_type_uint32;
  69 static Lisp_Object QCdbus_type_int64, QCdbus_type_uint64;
  70 static Lisp_Object QCdbus_type_double, QCdbus_type_string;
  71 static Lisp_Object QCdbus_type_object_path, QCdbus_type_signature;
  72 #ifdef DBUS_TYPE_UNIX_FD
  73 static Lisp_Object QCdbus_type_unix_fd;
  74 #endif
  75 static Lisp_Object QCdbus_type_array, QCdbus_type_variant;
  76 static Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
  77
  78 /* Whether we are reading a D-Bus event.  */
  79 static int xd_in_read_queued_messages = 0;
  80
  81 \f
  82 /* We use "xd_" and "XD_" as prefix for all internal symbols, because
  83    we don't want to poison other namespaces with "dbus_".  */
  84
  85 /* Raise a signal.  If we are reading events, we cannot signal; we
  86    throw to xd_read_queued_messages then.  */
  87 #define XD_SIGNAL1(arg)                                                 \
  88   do {                                                                  \
  89     if (xd_in_read_queued_messages)                                     \
  90       Fthrow (Qdbus_error, Qnil);                                       \
  91     else                                                                \
  92       xsignal1 (Qdbus_error, arg);                                      \
  93   } while (0)
  94
  95 #define XD_SIGNAL2(arg1, arg2)                                          \
  96   do {                                                                  \
  97     if (xd_in_read_queued_messages)                                     \
  98       Fthrow (Qdbus_error, Qnil);                                       \
  99     else                                                                \
 100       xsignal2 (Qdbus_error, arg1, arg2);                               \
 101   } while (0)
 102
 103 #define XD_SIGNAL3(arg1, arg2, arg3)                                    \
 104   do {                                                                  \
 105     if (xd_in_read_queued_messages)                                     \
 106       Fthrow (Qdbus_error, Qnil);                                       \
 107     else                                                                \
 108       xsignal3 (Qdbus_error, arg1, arg2, arg3);                         \
 109   } while (0)
 110
 111 /* Raise a Lisp error from a D-Bus ERROR.  */
 112 #define XD_ERROR(error)                                                 \
 113   do {                                                                  \
 114     /* Remove the trailing newline.  */                                 \
 115     char const *mess = error.message;                                   \
 116     char const *nl = strchr (mess, '\n');                               \
 117     Lisp_Object err = make_string (mess, nl ? nl - mess : strlen (mess)); \
 118     dbus_error_free (&error);                                           \
 119     XD_SIGNAL1 (err);                                                   \
 120   } while (0)
 121
 122 /* Macros for debugging.  In order to enable them, build with
 123    "MYCPPFLAGS='-DDBUS_DEBUG -Wall' make".  */
 124 #ifdef DBUS_DEBUG
 125 #define XD_DEBUG_MESSAGE(...)           \
 126   do {                                  \
 127     char s[1024];                       \
 128     snprintf (s, sizeof s, __VA_ARGS__); \
 129     printf ("%s: %s\n", __func__, s);   \
 130     message ("%s: %s", __func__, s);    \
 131   } while (0)
 132 #define XD_DEBUG_VALID_LISP_OBJECT_P(object)                            \
 133   do {                                                                  \
 134     if (!valid_lisp_object_p (object))                                  \
 135       {                                                                 \
 136         XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__);            \
 137         XD_SIGNAL1 (build_string ("Assertion failure"));                \
 138       }                                                                 \
 139   } while (0)
 140
 141 #else /* !DBUS_DEBUG */
 142 #define XD_DEBUG_MESSAGE(...)                                           \
 143   do {                                                                  \
 144     if (!NILP (Vdbus_debug))                                            \
 145       {                                                                 \
 146         char s[1024];                                                   \
 147         snprintf (s, 1023, __VA_ARGS__);                                \
 148         message ("%s: %s", __func__, s);                                \
 149       }                                                                 \
 150   } while (0)
 151 #define XD_DEBUG_VALID_LISP_OBJECT_P(object)
 152 #endif
 153
 154 /* Check whether TYPE is a basic DBusType.  */
 155 #ifdef DBUS_TYPE_UNIX_FD
 156 #define XD_BASIC_DBUS_TYPE(type)                                        \
 157   ((type ==  DBUS_TYPE_BYTE)                                            \
 158    || (type ==  DBUS_TYPE_BOOLEAN)                                      \
 159    || (type ==  DBUS_TYPE_INT16)                                        \
 160    || (type ==  DBUS_TYPE_UINT16)                                       \
 161    || (type ==  DBUS_TYPE_INT32)                                        \
 162    || (type ==  DBUS_TYPE_UINT32)                                       \
 163    || (type ==  DBUS_TYPE_INT64)                                        \
 164    || (type ==  DBUS_TYPE_UINT64)                                       \
 165    || (type ==  DBUS_TYPE_DOUBLE)                                       \
 166    || (type ==  DBUS_TYPE_STRING)                                       \
 167    || (type ==  DBUS_TYPE_OBJECT_PATH)                                  \
 168    || (type ==  DBUS_TYPE_SIGNATURE)                                    \
 169    || (type ==  DBUS_TYPE_UNIX_FD))
 170 #else
 171 #define XD_BASIC_DBUS_TYPE(type)                                        \
 172   ((type ==  DBUS_TYPE_BYTE)                                            \
 173    || (type ==  DBUS_TYPE_BOOLEAN)                                      \
 174    || (type ==  DBUS_TYPE_INT16)                                        \
 175    || (type ==  DBUS_TYPE_UINT16)                                       \
 176    || (type ==  DBUS_TYPE_INT32)                                        \
 177    || (type ==  DBUS_TYPE_UINT32)                                       \
 178    || (type ==  DBUS_TYPE_INT64)                                        \
 179    || (type ==  DBUS_TYPE_UINT64)                                       \
 180    || (type ==  DBUS_TYPE_DOUBLE)                                       \
 181    || (type ==  DBUS_TYPE_STRING)                                       \
 182    || (type ==  DBUS_TYPE_OBJECT_PATH)                                  \
 183    || (type ==  DBUS_TYPE_SIGNATURE))
 184 #endif
 185
 186 /* This was a macro.  On Solaris 2.11 it was said to compile for
 187    hours, when optimization is enabled.  So we have transferred it into
 188    a function.  */
 189 /* Determine the DBusType of a given Lisp symbol.  OBJECT must be one
 190    of the predefined D-Bus type symbols.  */
 191 static int
 192 xd_symbol_to_dbus_type (Lisp_Object object)
 193 {
 194   return
 195     ((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE
 196      : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN
 197      : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16
 198      : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16
 199      : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32
 200      : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32
 201      : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64
 202      : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64
 203      : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE
 204      : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING
 205      : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH
 206      : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE
 207 #ifdef DBUS_TYPE_UNIX_FD
 208      : (EQ (object, QCdbus_type_unix_fd)) ? DBUS_TYPE_UNIX_FD
 209 #endif
 210      : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY
 211      : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT
 212      : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT
 213      : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY
 214      : DBUS_TYPE_INVALID);
 215 }
 216
 217 /* Check whether a Lisp symbol is a predefined D-Bus type symbol.  */
 218 #define XD_DBUS_TYPE_P(object)                                          \
 219   (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)))
 220
 221 /* Determine the DBusType of a given Lisp OBJECT.  It is used to
 222    convert Lisp objects, being arguments of `dbus-call-method' or
 223    `dbus-send-signal', into corresponding C values appended as
 224    arguments to a D-Bus message.  */
 225 #define XD_OBJECT_TO_DBUS_TYPE(object)                                  \
 226   ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN           \
 227    : (NATNUMP (object)) ? DBUS_TYPE_UINT32                              \
 228    : (INTEGERP (object)) ? DBUS_TYPE_INT32                              \
 229    : (FLOATP (object)) ? DBUS_TYPE_DOUBLE                               \
 230    : (STRINGP (object)) ? DBUS_TYPE_STRING                              \
 231    : (XD_DBUS_TYPE_P (object)) ? xd_symbol_to_dbus_type (object)        \
 232    : (CONSP (object))                                                   \
 233    ? ((XD_DBUS_TYPE_P (CAR_SAFE (object)))                              \
 234       ? ((XD_BASIC_DBUS_TYPE (xd_symbol_to_dbus_type (CAR_SAFE (object)))) \
 235          ? DBUS_TYPE_ARRAY                                              \
 236          : xd_symbol_to_dbus_type (CAR_SAFE (object)))                  \
 237       : DBUS_TYPE_ARRAY)                                                \
 238    : DBUS_TYPE_INVALID)
 239
 240 /* Return a list pointer which does not have a Lisp symbol as car.  */
 241 #define XD_NEXT_VALUE(object)                                           \
 242   ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
 243
 244 /* Check whether X is a valid dbus serial number.  If valid, set
 245    SERIAL to its value.  Otherwise, signal an error. */
 246 #define CHECK_DBUS_SERIAL_GET_SERIAL(x, serial)                         \
 247   do                                                                    \
 248     {                                                                   \
 249       dbus_uint32_t DBUS_SERIAL_MAX = -1;                               \
 250       if (NATNUMP (x) && XINT (x) <= DBUS_SERIAL_MAX)                   \
 251         serial = XINT (x);                                              \
 252       else if (MOST_POSITIVE_FIXNUM < DBUS_SERIAL_MAX                   \
 253                && FLOATP (x)                                            \
 254                && 0 <= XFLOAT_DATA (x)                                  \
 255                && XFLOAT_DATA (x) <= DBUS_SERIAL_MAX)                   \
 256         serial = XFLOAT_DATA (x);                                       \
 257       else                                                              \
 258         XD_SIGNAL2 (build_string ("Invalid dbus serial"), x);           \
 259     }                                                                   \
 260   while (0)
 261
 262 /* Append to SIGNATURE a copy of X, making sure SIGNATURE does
 263    not become too long.  */
 264 static void
 265 xd_signature_cat (char *signature, char const *x)
 266 {
 267   ptrdiff_t siglen = strlen (signature);
 268   ptrdiff_t xlen = strlen (x);
 269   if (DBUS_MAXIMUM_SIGNATURE_LENGTH - xlen <= siglen)
 270     string_overflow ();
 271   strcat (signature, x);
 272 }
 273
 274 /* Compute SIGNATURE of OBJECT.  It must have a form that it can be
 275    used in dbus_message_iter_open_container.  DTYPE is the DBusType
 276    the object is related to.  It is passed as argument, because it
 277    cannot be detected in basic type objects, when they are preceded by
 278    a type symbol.  PARENT_TYPE is the DBusType of a container this
 279    signature is embedded, or DBUS_TYPE_INVALID.  It is needed for the
 280    check that DBUS_TYPE_DICT_ENTRY occurs only as array element.  */
 281 static void
 282 xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lisp_Object object)
 283 {
 284   unsigned int subtype;
 285   Lisp_Object elt;
 286   char const *subsig;
 287   int subsiglen;
 288   char x[DBUS_MAXIMUM_SIGNATURE_LENGTH];
 289
 290   elt = object;
 291
 292   switch (dtype)
 293     {
 294     case DBUS_TYPE_BYTE:
 295     case DBUS_TYPE_UINT16:
 296     case DBUS_TYPE_UINT32:
 297     case DBUS_TYPE_UINT64:
 298 #ifdef DBUS_TYPE_UNIX_FD
 299     case DBUS_TYPE_UNIX_FD:
 300 #endif
 301       CHECK_NATNUM (object);
 302       sprintf (signature, "%c", dtype);
 303       break;
 304
 305     case DBUS_TYPE_BOOLEAN:
 306       if (!EQ (object, Qt) && !EQ (object, Qnil))
 307         wrong_type_argument (intern ("booleanp"), object);
 308       sprintf (signature, "%c", dtype);
 309       break;
 310
 311     case DBUS_TYPE_INT16:
 312     case DBUS_TYPE_INT32:
 313     case DBUS_TYPE_INT64:
 314       CHECK_NUMBER (object);
 315       sprintf (signature, "%c", dtype);
 316       break;
 317
 318     case DBUS_TYPE_DOUBLE:
 319       CHECK_FLOAT (object);
 320       sprintf (signature, "%c", dtype);
 321       break;
 322
 323     case DBUS_TYPE_STRING:
 324     case DBUS_TYPE_OBJECT_PATH:
 325     case DBUS_TYPE_SIGNATURE:
 326       CHECK_STRING (object);
 327       sprintf (signature, "%c", dtype);
 328       break;
 329
 330     case DBUS_TYPE_ARRAY:
 331       /* Check that all list elements have the same D-Bus type.  For
 332          complex element types, we just check the container type, not
 333          the whole element's signature.  */
 334       CHECK_CONS (object);
 335
 336       /* Type symbol is optional.  */
 337       if (EQ (QCdbus_type_array, CAR_SAFE (elt)))
 338         elt = XD_NEXT_VALUE (elt);
 339
 340       /* If the array is empty, DBUS_TYPE_STRING is the default
 341          element type.  */
 342       if (NILP (elt))
 343         {
 344           subtype = DBUS_TYPE_STRING;
 345           subsig = DBUS_TYPE_STRING_AS_STRING;
 346         }
 347       else
 348         {
 349           subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 350           xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 351           subsig = x;
 352         }
 353
 354       /* If the element type is DBUS_TYPE_SIGNATURE, and this is the
 355          only element, the value of this element is used as he array's
 356          element signature.  */
 357       if ((subtype == DBUS_TYPE_SIGNATURE)
 358           && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt)))
 359           && NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
 360         subsig = SSDATA (CAR_SAFE (XD_NEXT_VALUE (elt)));
 361
 362       while (!NILP (elt))
 363         {
 364           if (subtype != XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)))
 365             wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt));
 366           elt = CDR_SAFE (XD_NEXT_VALUE (elt));
 367         }
 368
 369       subsiglen = snprintf (signature, DBUS_MAXIMUM_SIGNATURE_LENGTH,
 370                             "%c%s", dtype, subsig);
 371       if (! (0 <= subsiglen && subsiglen < DBUS_MAXIMUM_SIGNATURE_LENGTH))
 372         string_overflow ();
 373       break;
 374
 375     case DBUS_TYPE_VARIANT:
 376       /* Check that there is exactly one list element.  */
 377       CHECK_CONS (object);
 378
 379       elt = XD_NEXT_VALUE (elt);
 380       subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 381       xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 382
 383       if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
 384         wrong_type_argument (intern ("D-Bus"),
 385                              CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
 386
 387       sprintf (signature, "%c", dtype);
 388       break;
 389
 390     case DBUS_TYPE_STRUCT:
 391       /* A struct list might contain any number of elements with
 392          different types.  No further check needed.  */
 393       CHECK_CONS (object);
 394
 395       elt = XD_NEXT_VALUE (elt);
 396
 397       /* Compose the signature from the elements.  It is enclosed by
 398          parentheses.  */
 399       sprintf (signature, "%c", DBUS_STRUCT_BEGIN_CHAR );
 400       while (!NILP (elt))
 401         {
 402           subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 403           xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 404           xd_signature_cat (signature, x);
 405           elt = CDR_SAFE (XD_NEXT_VALUE (elt));
 406         }
 407       xd_signature_cat (signature, DBUS_STRUCT_END_CHAR_AS_STRING);
 408       break;
 409
 410     case DBUS_TYPE_DICT_ENTRY:
 411       /* Check that there are exactly two list elements, and the first
 412          one is of basic type.  The dictionary entry itself must be an
 413          element of an array.  */
 414       CHECK_CONS (object);
 415
 416       /* Check the parent object type.  */
 417       if (parent_type != DBUS_TYPE_ARRAY)
 418         wrong_type_argument (intern ("D-Bus"), object);
 419
 420       /* Compose the signature from the elements.  It is enclosed by
 421          curly braces.  */
 422       sprintf (signature, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR);
 423
 424       /* First element.  */
 425       elt = XD_NEXT_VALUE (elt);
 426       subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 427       xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 428       xd_signature_cat (signature, x);
 429
 430       if (!XD_BASIC_DBUS_TYPE (subtype))
 431         wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt)));
 432
 433       /* Second element.  */
 434       elt = CDR_SAFE (XD_NEXT_VALUE (elt));
 435       subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 436       xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 437       xd_signature_cat (signature, x);
 438
 439       if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
 440         wrong_type_argument (intern ("D-Bus"),
 441                              CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
 442
 443       /* Closing signature.  */
 444       xd_signature_cat (signature, DBUS_DICT_ENTRY_END_CHAR_AS_STRING);
 445       break;
 446
 447     default:
 448       wrong_type_argument (intern ("D-Bus"), object);
 449     }
 450
 451   XD_DEBUG_MESSAGE ("%s", signature);
 452 }
 453
 454 /* Append C value, extracted from Lisp OBJECT, to iteration ITER.
 455    DTYPE must be a valid DBusType.  It is used to convert Lisp
 456    objects, being arguments of `dbus-call-method' or
 457    `dbus-send-signal', into corresponding C values appended as
 458    arguments to a D-Bus message.  */
 459 static void
 460 xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
 461 {
 462   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
 463   DBusMessageIter subiter;
 464
 465   if (XD_BASIC_DBUS_TYPE (dtype))
 466     switch (dtype)
 467       {
 468       case DBUS_TYPE_BYTE:
 469         CHECK_NATNUM (object);
 470         {
 471           unsigned char val = XFASTINT (object) & 0xFF;
 472           XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 473           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 474             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 475           return;
 476         }
 477
 478       case DBUS_TYPE_BOOLEAN:
 479         {
 480           dbus_bool_t val = (NILP (object)) ? FALSE : TRUE;
 481           XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
 482           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 483             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 484           return;
 485         }
 486
 487       case DBUS_TYPE_INT16:
 488         CHECK_NUMBER (object);
 489         {
 490           dbus_int16_t val = XINT (object);
 491           XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
 492           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 493             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 494           return;
 495         }
 496
 497       case DBUS_TYPE_UINT16:
 498         CHECK_NATNUM (object);
 499         {
 500           dbus_uint16_t val = XFASTINT (object);
 501           XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
 502           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 503             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 504           return;
 505         }
 506
 507       case DBUS_TYPE_INT32:
 508         CHECK_NUMBER (object);
 509         {
 510           dbus_int32_t val = XINT (object);
 511           XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 512           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 513             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 514           return;
 515         }
 516
 517       case DBUS_TYPE_UINT32:
 518 #ifdef DBUS_TYPE_UNIX_FD
 519       case DBUS_TYPE_UNIX_FD:
 520 #endif
 521         CHECK_NATNUM (object);
 522         {
 523           dbus_uint32_t val = XFASTINT (object);
 524           XD_DEBUG_MESSAGE ("%c %u", dtype, val);
 525           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 526             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 527           return;
 528         }
 529
 530       case DBUS_TYPE_INT64:
 531         CHECK_NUMBER (object);
 532         {
 533           dbus_int64_t val = XINT (object);
 534           XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
 535           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 536             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 537           return;
 538         }
 539
 540       case DBUS_TYPE_UINT64:
 541         CHECK_NATNUM (object);
 542         {
 543           dbus_uint64_t val = XFASTINT (object);
 544           XD_DEBUG_MESSAGE ("%c %"pI"d", dtype, XFASTINT (object));
 545           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 546             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 547           return;
 548         }
 549
 550       case DBUS_TYPE_DOUBLE:
 551         CHECK_FLOAT (object);
 552         {
 553           double val = XFLOAT_DATA (object);
 554           XD_DEBUG_MESSAGE ("%c %f", dtype, val);
 555           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 556             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 557           return;
 558         }
 559
 560       case DBUS_TYPE_STRING:
 561       case DBUS_TYPE_OBJECT_PATH:
 562       case DBUS_TYPE_SIGNATURE:
 563         CHECK_STRING (object);
 564         {
 565           /* We need to send a valid UTF-8 string.  We could encode `object'
 566              but by not encoding it, we guarantee it's valid utf-8, even if
 567              it contains eight-bit-bytes.  Of course, you can still send
 568              manually-crafted junk by passing a unibyte string.  */
 569           char *val = SSDATA (object);
 570           XD_DEBUG_MESSAGE ("%c %s", dtype, val);
 571           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 572             XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 573           return;
 574         }
 575       }
 576
 577   else /* Compound types.  */
 578     {
 579
 580       /* All compound types except array have a type symbol.  For
 581          array, it is optional.  Skip it.  */
 582       if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))))
 583         object = XD_NEXT_VALUE (object);
 584
 585       /* Open new subiteration.  */
 586       switch (dtype)
 587         {
 588         case DBUS_TYPE_ARRAY:
 589           /* An array has only elements of the same type.  So it is
 590              sufficient to check the first element's signature
 591              only.  */
 592
 593           if (NILP (object))
 594             /* If the array is empty, DBUS_TYPE_STRING is the default
 595                element type.  */
 596             strcpy (signature, DBUS_TYPE_STRING_AS_STRING);
 597
 598           else
 599             /* If the element type is DBUS_TYPE_SIGNATURE, and this is
 600                the only element, the value of this element is used as
 601                the array's element signature.  */
 602             if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))
 603                  == DBUS_TYPE_SIGNATURE)
 604                 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object)))
 605                 && NILP (CDR_SAFE (XD_NEXT_VALUE (object))))
 606               {
 607                 strcpy (signature, SSDATA (CAR_SAFE (XD_NEXT_VALUE (object))));
 608                 object = CDR_SAFE (XD_NEXT_VALUE (object));
 609               }
 610
 611             else
 612               xd_signature (signature,
 613                             XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
 614                             dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
 615
 616           XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
 617                             SDATA (format2 ("%s", object, Qnil)));
 618           if (!dbus_message_iter_open_container (iter, dtype,
 619                                                  signature, &subiter))
 620             XD_SIGNAL3 (build_string ("Cannot open container"),
 621                         make_number (dtype), build_string (signature));
 622           break;
 623
 624         case DBUS_TYPE_VARIANT:
 625           /* A variant has just one element.  */
 626           xd_signature (signature, XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
 627                         dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
 628
 629           XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
 630                             SDATA (format2 ("%s", object, Qnil)));
 631           if (!dbus_message_iter_open_container (iter, dtype,
 632                                                  signature, &subiter))
 633             XD_SIGNAL3 (build_string ("Cannot open container"),
 634                         make_number (dtype), build_string (signature));
 635           break;
 636
 637         case DBUS_TYPE_STRUCT:
 638         case DBUS_TYPE_DICT_ENTRY:
 639           /* These containers do not require a signature.  */
 640           XD_DEBUG_MESSAGE ("%c %s", dtype,
 641                             SDATA (format2 ("%s", object, Qnil)));
 642           if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
 643             XD_SIGNAL2 (build_string ("Cannot open container"),
 644                         make_number (dtype));
 645           break;
 646         }
 647
 648       /* Loop over list elements.  */
 649       while (!NILP (object))
 650         {
 651           dtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object));
 652           object = XD_NEXT_VALUE (object);
 653
 654           xd_append_arg (dtype, CAR_SAFE (object), &subiter);
 655
 656           object = CDR_SAFE (object);
 657         }
 658
 659       /* Close the subiteration.  */
 660       if (!dbus_message_iter_close_container (iter, &subiter))
 661         XD_SIGNAL2 (build_string ("Cannot close container"),
 662                     make_number (dtype));
 663     }
 664 }
 665
 666 /* Retrieve C value from a DBusMessageIter structure ITER, and return
 667    a converted Lisp object.  The type DTYPE of the argument of the
 668    D-Bus message must be a valid DBusType.  Compound D-Bus types
 669    result always in a Lisp list.  */
 670 static Lisp_Object
 671 xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
 672 {
 673
 674   switch (dtype)
 675     {
 676     case DBUS_TYPE_BYTE:
 677       {
 678         unsigned int val;
 679         dbus_message_iter_get_basic (iter, &val);
 680         val = val & 0xFF;
 681         XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 682         return make_number (val);
 683       }
 684
 685     case DBUS_TYPE_BOOLEAN:
 686       {
 687         dbus_bool_t val;
 688         dbus_message_iter_get_basic (iter, &val);
 689         XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
 690         return (val == FALSE) ? Qnil : Qt;
 691       }
 692
 693     case DBUS_TYPE_INT16:
 694       {
 695         dbus_int16_t val;
 696         dbus_message_iter_get_basic (iter, &val);
 697         XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 698         return make_number (val);
 699       }
 700
 701     case DBUS_TYPE_UINT16:
 702       {
 703         dbus_uint16_t val;
 704         dbus_message_iter_get_basic (iter, &val);
 705         XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 706         return make_number (val);
 707       }
 708
 709     case DBUS_TYPE_INT32:
 710       {
 711         dbus_int32_t val;
 712         dbus_message_iter_get_basic (iter, &val);
 713         XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 714         return make_fixnum_or_float (val);
 715       }
 716
 717     case DBUS_TYPE_UINT32:
 718 #ifdef DBUS_TYPE_UNIX_FD
 719     case DBUS_TYPE_UNIX_FD:
 720 #endif
 721       {
 722         dbus_uint32_t val;
 723         dbus_message_iter_get_basic (iter, &val);
 724         XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 725         return make_fixnum_or_float (val);
 726       }
 727
 728     case DBUS_TYPE_INT64:
 729       {
 730         dbus_int64_t val;
 731         dbus_message_iter_get_basic (iter, &val);
 732         XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
 733         return make_fixnum_or_float (val);
 734       }
 735
 736     case DBUS_TYPE_UINT64:
 737       {
 738         dbus_uint64_t val;
 739         dbus_message_iter_get_basic (iter, &val);
 740         XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
 741         return make_fixnum_or_float (val);
 742       }
 743
 744     case DBUS_TYPE_DOUBLE:
 745       {
 746         double val;
 747         dbus_message_iter_get_basic (iter, &val);
 748         XD_DEBUG_MESSAGE ("%c %f", dtype, val);
 749         return make_float (val);
 750       }
 751
 752     case DBUS_TYPE_STRING:
 753     case DBUS_TYPE_OBJECT_PATH:
 754     case DBUS_TYPE_SIGNATURE:
 755       {
 756         char *val;
 757         dbus_message_iter_get_basic (iter, &val);
 758         XD_DEBUG_MESSAGE ("%c %s", dtype, val);
 759         return build_string (val);
 760       }
 761
 762     case DBUS_TYPE_ARRAY:
 763     case DBUS_TYPE_VARIANT:
 764     case DBUS_TYPE_STRUCT:
 765     case DBUS_TYPE_DICT_ENTRY:
 766       {
 767         Lisp_Object result;
 768         struct gcpro gcpro1;
 769         DBusMessageIter subiter;
 770         int subtype;
 771         result = Qnil;
 772         GCPRO1 (result);
 773         dbus_message_iter_recurse (iter, &subiter);
 774         while ((subtype = dbus_message_iter_get_arg_type (&subiter))
 775                != DBUS_TYPE_INVALID)
 776           {
 777             result = Fcons (xd_retrieve_arg (subtype, &subiter), result);
 778             dbus_message_iter_next (&subiter);
 779           }
 780         XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (format2 ("%s", result, Qnil)));
 781         RETURN_UNGCPRO (Fnreverse (result));
 782       }
 783
 784     default:
 785       XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype);
 786       return Qnil;
 787     }
 788 }
 789
 790 /* Initialize D-Bus connection.  BUS is either a Lisp symbol, :system
 791    or :session, or a string denoting the bus address.  It tells which
 792    D-Bus to initialize.  If RAISE_ERROR is non-zero, signal an error
 793    when the connection cannot be initialized.  */
 794 static DBusConnection *
 795 xd_initialize (Lisp_Object bus, int raise_error)
 796 {
 797   DBusConnection *connection;
 798   DBusError derror;
 799
 800   /* Parameter check.  */
 801   if (!STRINGP (bus))
 802     {
 803       CHECK_SYMBOL (bus);
 804       if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus)))
 805         {
 806           if (raise_error)
 807             XD_SIGNAL2 (build_string ("Wrong bus name"), bus);
 808           else
 809             return NULL;
 810         }
 811
 812       /* We do not want to have an autolaunch for the session bus.  */
 813       if (EQ (bus, QCdbus_session_bus)
 814           && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL)
 815         {
 816           if (raise_error)
 817             XD_SIGNAL2 (build_string ("No connection to bus"), bus);
 818           else
 819             return NULL;
 820         }
 821     }
 822
 823   /* Open a connection to the bus.  */
 824   dbus_error_init (&derror);
 825
 826   if (STRINGP (bus))
 827       connection = dbus_connection_open (SSDATA (bus), &derror);
 828   else
 829     if (EQ (bus, QCdbus_system_bus))
 830       connection = dbus_bus_get (DBUS_BUS_SYSTEM, &derror);
 831     else
 832       connection = dbus_bus_get (DBUS_BUS_SESSION, &derror);
 833
 834   if (dbus_error_is_set (&derror))
 835     {
 836       if (raise_error)
 837         XD_ERROR (derror);
 838       else
 839         connection = NULL;
 840     }
 841
 842   /* If it is not the system or session bus, we must register
 843      ourselves.  Otherwise, we have called dbus_bus_get, which has
 844      configured us to exit if the connection closes - we undo this
 845      setting.  */
 846   if (connection != NULL)
 847     {
 848       if (STRINGP (bus))
 849         dbus_bus_register (connection, &derror);
 850       else
 851         dbus_connection_set_exit_on_disconnect (connection, FALSE);
 852     }
 853
 854   if (dbus_error_is_set (&derror))
 855     {
 856       if (raise_error)
 857         XD_ERROR (derror);
 858       else
 859         connection = NULL;
 860     }
 861
 862   if (connection == NULL && raise_error)
 863     XD_SIGNAL2 (build_string ("No connection to bus"), bus);
 864
 865   /* Cleanup.  */
 866   dbus_error_free (&derror);
 867
 868   /* Return the result.  */
 869   return connection;
 870 }
 871
 872 /* Return the file descriptor for WATCH, -1 if not found.  */
 873 static int
 874 xd_find_watch_fd (DBusWatch *watch)
 875 {
 876 #if HAVE_DBUS_WATCH_GET_UNIX_FD
 877   /* TODO: Reverse these on Win32, which prefers the opposite.  */
 878   int fd = dbus_watch_get_unix_fd (watch);
 879   if (fd == -1)
 880     fd = dbus_watch_get_socket (watch);
 881 #else
 882   int fd = dbus_watch_get_fd (watch);
 883 #endif
 884   return fd;
 885 }
 886
 887 /* Prototype.  */
 888 static void
 889 xd_read_queued_messages (int fd, void *data, int for_read);
 890
 891 /* Start monitoring WATCH for possible I/O.  */
 892 static dbus_bool_t
 893 xd_add_watch (DBusWatch *watch, void *data)
 894 {
 895   unsigned int flags = dbus_watch_get_flags (watch);
 896   int fd = xd_find_watch_fd (watch);
 897
 898   XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d",
 899                     fd, flags & DBUS_WATCH_WRITABLE,
 900                     dbus_watch_get_enabled (watch));
 901
 902   if (fd == -1)
 903     return FALSE;
 904
 905   if (dbus_watch_get_enabled (watch))
 906     {
 907       if (flags & DBUS_WATCH_WRITABLE)
 908         add_write_fd (fd, xd_read_queued_messages, data);
 909       if (flags & DBUS_WATCH_READABLE)
 910         add_read_fd (fd, xd_read_queued_messages, data);
 911     }
 912   return TRUE;
 913 }
 914
 915 /* Stop monitoring WATCH for possible I/O.
 916    DATA is the used bus, either a string or QCdbus_system_bus or
 917    QCdbus_session_bus.  */
 918 static void
 919 xd_remove_watch (DBusWatch *watch, void *data)
 920 {
 921   unsigned int flags = dbus_watch_get_flags (watch);
 922   int fd = xd_find_watch_fd (watch);
 923
 924   XD_DEBUG_MESSAGE ("fd %d", fd);
 925
 926   if (fd == -1)
 927     return;
 928
 929   /* Unset session environment.  */
 930   if (XSYMBOL (QCdbus_session_bus) == data)
 931     {
 932       XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
 933       unsetenv ("DBUS_SESSION_BUS_ADDRESS");
 934     }
 935
 936   if (flags & DBUS_WATCH_WRITABLE)
 937     delete_write_fd (fd);
 938   if (flags & DBUS_WATCH_READABLE)
 939     delete_read_fd (fd);
 940 }
 941
 942 /* Toggle monitoring WATCH for possible I/O.  */
 943 static void
 944 xd_toggle_watch (DBusWatch *watch, void *data)
 945 {
 946   if (dbus_watch_get_enabled (watch))
 947     xd_add_watch (watch, data);
 948   else
 949     xd_remove_watch (watch, data);
 950 }
 951
 952 DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 1, 0,
 953        doc: /* Initialize connection to D-Bus BUS.  */)
 954   (Lisp_Object bus)
 955 {
 956   DBusConnection *connection;
 957   void *busp;
 958
 959   /* Check parameter.  */
 960   if (SYMBOLP (bus))
 961     busp = XSYMBOL (bus);
 962   else if (STRINGP (bus))
 963     busp = XSTRING (bus);
 964   else
 965     wrong_type_argument (intern ("D-Bus"), bus);
 966
 967   /* Open a connection to the bus.  */
 968   connection = xd_initialize (bus, TRUE);
 969
 970   /* Add the watch functions.  We pass also the bus as data, in order
 971      to distinguish between the buses in xd_remove_watch.  */
 972   if (!dbus_connection_set_watch_functions (connection,
 973                                             xd_add_watch,
 974                                             xd_remove_watch,
 975                                             xd_toggle_watch,
 976                                             busp, NULL))
 977     XD_SIGNAL1 (build_string ("Cannot add watch functions"));
 978
 979   /* Add bus to list of registered buses.  */
 980   Vdbus_registered_buses =  Fcons (bus, Vdbus_registered_buses);
 981
 982   /* We do not want to abort.  */
 983   putenv ((char *) "DBUS_FATAL_WARNINGS=0");
 984
 985   /* Return.  */
 986   return Qnil;
 987 }
 988
 989 DEFUN ("dbus-close-bus", Fdbus_close_bus, Sdbus_close_bus, 1, 1, 0,
 990        doc: /* Close connection to D-Bus BUS.  */)
 991   (Lisp_Object bus)
 992 {
 993   DBusConnection *connection;
 994
 995   /* Open a connection to the bus.  */
 996   connection = xd_initialize (bus, TRUE);
 997
 998   /* Decrement reference count to the bus.  */
 999   dbus_connection_unref (connection);
1000
1001   /* Remove bus from list of registered buses.  */
1002   Vdbus_registered_buses = Fdelete (bus, Vdbus_registered_buses);
1003
1004   /* Return.  */
1005   return Qnil;
1006 }
1007
1008 DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
1009        1, 1, 0,
1010        doc: /* Return the unique name of Emacs registered at D-Bus BUS.  */)
1011   (Lisp_Object bus)
1012 {
1013   DBusConnection *connection;
1014   const char *name;
1015
1016   /* Open a connection to the bus.  */
1017   connection = xd_initialize (bus, TRUE);
1018
1019   /* Request the name.  */
1020   name = dbus_bus_get_unique_name (connection);
1021   if (name == NULL)
1022     XD_SIGNAL1 (build_string ("No unique name available"));
1023
1024   /* Return.  */
1025   return build_string (name);
1026 }
1027
1028 DEFUN ("dbus-call-method", Fdbus_call_method, Sdbus_call_method, 5, MANY, 0,
1029        doc: /* Call METHOD on the D-Bus BUS.
1030
1031 BUS is either a Lisp symbol, `:system' or `:session', or a string
1032 denoting the bus address.
1033
1034 SERVICE is the D-Bus service name to be used.  PATH is the D-Bus
1035 object path SERVICE is registered at.  INTERFACE is an interface
1036 offered by SERVICE.  It must provide METHOD.
1037
1038 If the parameter `:timeout' is given, the following integer TIMEOUT
1039 specifies the maximum number of milliseconds the method call must
1040 return.  The default value is 25,000.  If the method call doesn't
1041 return in time, a D-Bus error is raised.
1042
1043 All other arguments ARGS are passed to METHOD as arguments.  They are
1044 converted into D-Bus types via the following rules:
1045
1046   t and nil => DBUS_TYPE_BOOLEAN
1047   number    => DBUS_TYPE_UINT32
1048   integer   => DBUS_TYPE_INT32
1049   float     => DBUS_TYPE_DOUBLE
1050   string    => DBUS_TYPE_STRING
1051   list      => DBUS_TYPE_ARRAY
1052
1053 All arguments can be preceded by a type symbol.  For details about
1054 type symbols, see Info node `(dbus)Type Conversion'.
1055
1056 `dbus-call-method' returns the resulting values of METHOD as a list of
1057 Lisp objects.  The type conversion happens the other direction as for
1058 input arguments.  It follows the mapping rules:
1059
1060   DBUS_TYPE_BOOLEAN     => t or nil
1061   DBUS_TYPE_BYTE        => number
1062   DBUS_TYPE_UINT16      => number
1063   DBUS_TYPE_INT16       => integer
1064   DBUS_TYPE_UINT32      => number or float
1065   DBUS_TYPE_UNIX_FD     => number or float
1066   DBUS_TYPE_INT32       => integer or float
1067   DBUS_TYPE_UINT64      => number or float
1068   DBUS_TYPE_INT64       => integer or float
1069   DBUS_TYPE_DOUBLE      => float
1070   DBUS_TYPE_STRING      => string
1071   DBUS_TYPE_OBJECT_PATH => string
1072   DBUS_TYPE_SIGNATURE   => string
1073   DBUS_TYPE_ARRAY       => list
1074   DBUS_TYPE_VARIANT     => list
1075   DBUS_TYPE_STRUCT      => list
1076   DBUS_TYPE_DICT_ENTRY  => list
1077
1078 Example:
1079
1080 \(dbus-call-method
1081   :session "org.gnome.seahorse" "/org/gnome/seahorse/keys/openpgp"
1082   "org.gnome.seahorse.Keys" "GetKeyField"
1083   "openpgp:657984B8C7A966DD" "simple-name")
1084
1085   => (t ("Philip R. Zimmermann"))
1086
1087 If the result of the METHOD call is just one value, the converted Lisp
1088 object is returned instead of a list containing this single Lisp object.
1089
1090 \(dbus-call-method
1091   :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
1092   "org.freedesktop.Hal.Device" "GetPropertyString"
1093   "system.kernel.machine")
1094
1095   => "i686"
1096
1097 usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TIMEOUT &rest ARGS)  */)
1098   (ptrdiff_t nargs, Lisp_Object *args)
1099 {
1100   Lisp_Object bus, service, path, interface, method;
1101   Lisp_Object result;
1102   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
1103   DBusConnection *connection;
1104   DBusMessage *dmessage;
1105   DBusMessage *reply;
1106   DBusMessageIter iter;
1107   DBusError derror;
1108   unsigned int dtype;
1109   int timeout = -1;
1110   ptrdiff_t i = 5;
1111   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1112
1113   /* Check parameters.  */
1114   bus = args[0];
1115   service = args[1];
1116   path = args[2];
1117   interface = args[3];
1118   method = args[4];
1119
1120   CHECK_STRING (service);
1121   CHECK_STRING (path);
1122   CHECK_STRING (interface);
1123   CHECK_STRING (method);
1124   GCPRO5 (bus, service, path, interface, method);
1125
1126   XD_DEBUG_MESSAGE ("%s %s %s %s",
1127                     SDATA (service),
1128                     SDATA (path),
1129                     SDATA (interface),
1130                     SDATA (method));
1131
1132   /* Open a connection to the bus.  */
1133   connection = xd_initialize (bus, TRUE);
1134
1135   /* Create the message.  */
1136   dmessage = dbus_message_new_method_call (SSDATA (service),
1137                                            SSDATA (path),
1138                                            SSDATA (interface),
1139                                            SSDATA (method));
1140   UNGCPRO;
1141   if (dmessage == NULL)
1142     XD_SIGNAL1 (build_string ("Unable to create a new message"));
1143
1144   /* Check for timeout parameter.  */
1145   if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
1146     {
1147       CHECK_NATNUM (args[i+1]);
1148       timeout = XFASTINT (args[i+1]);
1149       i = i+2;
1150     }
1151
1152   /* Initialize parameter list of message.  */
1153   dbus_message_iter_init_append (dmessage, &iter);
1154
1155   /* Append parameters to the message.  */
1156   for (; i < nargs; ++i)
1157     {
1158       dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1159       if (XD_DBUS_TYPE_P (args[i]))
1160         {
1161           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1162           XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1163           XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4,
1164                             SDATA (format2 ("%s", args[i], Qnil)),
1165                             SDATA (format2 ("%s", args[i+1], Qnil)));
1166           ++i;
1167         }
1168       else
1169         {
1170           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1171           XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
1172                             SDATA (format2 ("%s", args[i], Qnil)));
1173         }
1174
1175       /* Check for valid signature.  We use DBUS_TYPE_INVALID as
1176          indication that there is no parent type.  */
1177       xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1178
1179       xd_append_arg (dtype, args[i], &iter);
1180     }
1181
1182   /* Send the message.  */
1183   dbus_error_init (&derror);
1184   reply = dbus_connection_send_with_reply_and_block (connection,
1185                                                      dmessage,
1186                                                      timeout,
1187                                                      &derror);
1188
1189   if (dbus_error_is_set (&derror))
1190     XD_ERROR (derror);
1191
1192   if (reply == NULL)
1193     XD_SIGNAL1 (build_string ("No reply"));
1194
1195   XD_DEBUG_MESSAGE ("Message sent");
1196
1197   /* Collect the results.  */
1198   result = Qnil;
1199   GCPRO1 (result);
1200
1201   if (dbus_message_iter_init (reply, &iter))
1202     {
1203       /* Loop over the parameters of the D-Bus reply message.  Construct a
1204          Lisp list, which is returned by `dbus-call-method'.  */
1205       while ((dtype = dbus_message_iter_get_arg_type (&iter))
1206              != DBUS_TYPE_INVALID)
1207         {
1208           result = Fcons (xd_retrieve_arg (dtype, &iter), result);
1209           dbus_message_iter_next (&iter);
1210         }
1211     }
1212   else
1213     {
1214       /* No arguments: just return nil.  */
1215     }
1216
1217   /* Cleanup.  */
1218   dbus_error_free (&derror);
1219   dbus_message_unref (dmessage);
1220   dbus_message_unref (reply);
1221
1222   /* Return the result.  If there is only one single Lisp object,
1223      return it as-it-is, otherwise return the reversed list.  */
1224   if (XFASTINT (Flength (result)) == 1)
1225     RETURN_UNGCPRO (CAR_SAFE (result));
1226   else
1227     RETURN_UNGCPRO (Fnreverse (result));
1228 }
1229
1230 DEFUN ("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously,
1231        Sdbus_call_method_asynchronously, 6, MANY, 0,
1232        doc: /* Call METHOD on the D-Bus BUS asynchronously.
1233
1234 BUS is either a Lisp symbol, `:system' or `:session', or a string
1235 denoting the bus address.
1236
1237 SERVICE is the D-Bus service name to be used.  PATH is the D-Bus
1238 object path SERVICE is registered at.  INTERFACE is an interface
1239 offered by SERVICE.  It must provide METHOD.
1240
1241 HANDLER is a Lisp function, which is called when the corresponding
1242 return message has arrived.  If HANDLER is nil, no return message will
1243 be expected.
1244
1245 If the parameter `:timeout' is given, the following integer TIMEOUT
1246 specifies the maximum number of milliseconds the method call must
1247 return.  The default value is 25,000.  If the method call doesn't
1248 return in time, a D-Bus error is raised.
1249
1250 All other arguments ARGS are passed to METHOD as arguments.  They are
1251 converted into D-Bus types via the following rules:
1252
1253   t and nil => DBUS_TYPE_BOOLEAN
1254   number    => DBUS_TYPE_UINT32
1255   integer   => DBUS_TYPE_INT32
1256   float     => DBUS_TYPE_DOUBLE
1257   string    => DBUS_TYPE_STRING
1258   list      => DBUS_TYPE_ARRAY
1259
1260 All arguments can be preceded by a type symbol.  For details about
1261 type symbols, see Info node `(dbus)Type Conversion'.
1262
1263 Unless HANDLER is nil, the function returns a key into the hash table
1264 `dbus-registered-objects-table'.  The corresponding entry in the hash
1265 table is removed, when the return message has been arrived, and
1266 HANDLER is called.
1267
1268 Example:
1269
1270 \(dbus-call-method-asynchronously
1271   :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
1272   "org.freedesktop.Hal.Device" "GetPropertyString" 'message
1273   "system.kernel.machine")
1274
1275   => (:system 2)
1276
1277   -| i686
1278
1279 usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLER &optional :timeout TIMEOUT &rest ARGS)  */)
1280   (ptrdiff_t nargs, Lisp_Object *args)
1281 {
1282   Lisp_Object bus, service, path, interface, method, handler;
1283   Lisp_Object result;
1284   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1285   DBusConnection *connection;
1286   DBusMessage *dmessage;
1287   DBusMessageIter iter;
1288   unsigned int dtype;
1289   dbus_uint32_t serial;
1290   int timeout = -1;
1291   ptrdiff_t i = 6;
1292   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1293
1294   /* Check parameters.  */
1295   bus = args[0];
1296   service = args[1];
1297   path = args[2];
1298   interface = args[3];
1299   method = args[4];
1300   handler = args[5];
1301
1302   CHECK_STRING (service);
1303   CHECK_STRING (path);
1304   CHECK_STRING (interface);
1305   CHECK_STRING (method);
1306   if (!NILP (handler) && !FUNCTIONP (handler))
1307     wrong_type_argument (Qinvalid_function, handler);
1308   GCPRO6 (bus, service, path, interface, method, handler);
1309
1310   XD_DEBUG_MESSAGE ("%s %s %s %s",
1311                     SDATA (service),
1312                     SDATA (path),
1313                     SDATA (interface),
1314                     SDATA (method));
1315
1316   /* Open a connection to the bus.  */
1317   connection = xd_initialize (bus, TRUE);
1318
1319   /* Create the message.  */
1320   dmessage = dbus_message_new_method_call (SSDATA (service),
1321                                            SSDATA (path),
1322                                            SSDATA (interface),
1323                                            SSDATA (method));
1324   if (dmessage == NULL)
1325     XD_SIGNAL1 (build_string ("Unable to create a new message"));
1326
1327   /* Check for timeout parameter.  */
1328   if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
1329     {
1330       CHECK_NATNUM (args[i+1]);
1331       timeout = XFASTINT (args[i+1]);
1332       i = i+2;
1333     }
1334
1335   /* Initialize parameter list of message.  */
1336   dbus_message_iter_init_append (dmessage, &iter);
1337
1338   /* Append parameters to the message.  */
1339   for (; i < nargs; ++i)
1340     {
1341       dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1342       if (XD_DBUS_TYPE_P (args[i]))
1343         {
1344           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1345           XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1346           XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4,
1347                             SDATA (format2 ("%s", args[i], Qnil)),
1348                             SDATA (format2 ("%s", args[i+1], Qnil)));
1349           ++i;
1350         }
1351       else
1352         {
1353           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1354           XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
1355                             SDATA (format2 ("%s", args[i], Qnil)));
1356         }
1357
1358       /* Check for valid signature.  We use DBUS_TYPE_INVALID as
1359          indication that there is no parent type.  */
1360       xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1361
1362       xd_append_arg (dtype, args[i], &iter);
1363     }
1364
1365   if (!NILP (handler))
1366     {
1367       /* Send the message.  The message is just added to the outgoing
1368          message queue.  */
1369       if (!dbus_connection_send_with_reply (connection, dmessage,
1370                                             NULL, timeout))
1371         XD_SIGNAL1 (build_string ("Cannot send message"));
1372
1373       /* The result is the key in Vdbus_registered_objects_table.  */
1374       serial = dbus_message_get_serial (dmessage);
1375       result = list2 (bus, make_fixnum_or_float (serial));
1376
1377       /* Create a hash table entry.  */
1378       Fputhash (result, handler, Vdbus_registered_objects_table);
1379     }
1380   else
1381     {
1382       /* Send the message.  The message is just added to the outgoing
1383          message queue.  */
1384       if (!dbus_connection_send (connection, dmessage, NULL))
1385         XD_SIGNAL1 (build_string ("Cannot send message"));
1386
1387       result = Qnil;
1388     }
1389
1390   XD_DEBUG_MESSAGE ("Message sent");
1391
1392   /* Cleanup.  */
1393   dbus_message_unref (dmessage);
1394
1395   /* Return the result.  */
1396   RETURN_UNGCPRO (result);
1397 }
1398
1399 DEFUN ("dbus-method-return-internal", Fdbus_method_return_internal,
1400        Sdbus_method_return_internal,
1401        3, MANY, 0,
1402        doc: /* Return for message SERIAL on the D-Bus BUS.
1403 This is an internal function, it shall not be used outside dbus.el.
1404
1405 usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS)  */)
1406   (ptrdiff_t nargs, Lisp_Object *args)
1407 {
1408   Lisp_Object bus, service;
1409   struct gcpro gcpro1, gcpro2;
1410   DBusConnection *connection;
1411   DBusMessage *dmessage;
1412   DBusMessageIter iter;
1413   dbus_uint32_t serial;
1414   unsigned int ui_serial, dtype;
1415   ptrdiff_t i;
1416   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1417
1418   /* Check parameters.  */
1419   bus = args[0];
1420   service = args[2];
1421
1422   CHECK_DBUS_SERIAL_GET_SERIAL (args[1], serial);
1423   CHECK_STRING (service);
1424   GCPRO2 (bus, service);
1425
1426   ui_serial = serial;
1427   XD_DEBUG_MESSAGE ("%u %s ", ui_serial, SSDATA (service));
1428
1429   /* Open a connection to the bus.  */
1430   connection = xd_initialize (bus, TRUE);
1431
1432   /* Create the message.  */
1433   dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_METHOD_RETURN);
1434   if ((dmessage == NULL)
1435       || (!dbus_message_set_reply_serial (dmessage, serial))
1436       || (!dbus_message_set_destination (dmessage, SSDATA (service))))
1437     {
1438       UNGCPRO;
1439       XD_SIGNAL1 (build_string ("Unable to create a return message"));
1440     }
1441
1442   UNGCPRO;
1443
1444   /* Initialize parameter list of message.  */
1445   dbus_message_iter_init_append (dmessage, &iter);
1446
1447   /* Append parameters to the message.  */
1448   for (i = 3; i < nargs; ++i)
1449     {
1450       dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1451       if (XD_DBUS_TYPE_P (args[i]))
1452         {
1453           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1454           XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1455           XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 2,
1456                             SDATA (format2 ("%s", args[i], Qnil)),
1457                             SDATA (format2 ("%s", args[i+1], Qnil)));
1458           ++i;
1459         }
1460       else
1461         {
1462           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1463           XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 2,
1464                             SDATA (format2 ("%s", args[i], Qnil)));
1465         }
1466
1467       /* Check for valid signature.  We use DBUS_TYPE_INVALID as
1468          indication that there is no parent type.  */
1469       xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1470
1471       xd_append_arg (dtype, args[i], &iter);
1472     }
1473
1474   /* Send the message.  The message is just added to the outgoing
1475      message queue.  */
1476   if (!dbus_connection_send (connection, dmessage, NULL))
1477     XD_SIGNAL1 (build_string ("Cannot send message"));
1478
1479   XD_DEBUG_MESSAGE ("Message sent");
1480
1481   /* Cleanup.  */
1482   dbus_message_unref (dmessage);
1483
1484   /* Return.  */
1485   return Qt;
1486 }
1487
1488 DEFUN ("dbus-method-error-internal", Fdbus_method_error_internal,
1489        Sdbus_method_error_internal,
1490        3, MANY, 0,
1491        doc: /* Return error message for message SERIAL on the D-Bus BUS.
1492 This is an internal function, it shall not be used outside dbus.el.
1493
1494 usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS)  */)
1495   (ptrdiff_t nargs, Lisp_Object *args)
1496 {
1497   Lisp_Object bus, service;
1498   struct gcpro gcpro1, gcpro2;
1499   DBusConnection *connection;
1500   DBusMessage *dmessage;
1501   DBusMessageIter iter;
1502   dbus_uint32_t serial;
1503   unsigned int ui_serial, dtype;
1504   ptrdiff_t i;
1505   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1506
1507   /* Check parameters.  */
1508   bus = args[0];
1509   service = args[2];
1510
1511   CHECK_DBUS_SERIAL_GET_SERIAL (args[1], serial);
1512   CHECK_STRING (service);
1513   GCPRO2 (bus, service);
1514
1515   ui_serial = serial;
1516   XD_DEBUG_MESSAGE ("%u %s ", ui_serial, SSDATA (service));
1517
1518   /* Open a connection to the bus.  */
1519   connection = xd_initialize (bus, TRUE);
1520
1521   /* Create the message.  */
1522   dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_ERROR);
1523   if ((dmessage == NULL)
1524       || (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED))
1525       || (!dbus_message_set_reply_serial (dmessage, serial))
1526       || (!dbus_message_set_destination (dmessage, SSDATA (service))))
1527     {
1528       UNGCPRO;
1529       XD_SIGNAL1 (build_string ("Unable to create a error message"));
1530     }
1531
1532   UNGCPRO;
1533
1534   /* Initialize parameter list of message.  */
1535   dbus_message_iter_init_append (dmessage, &iter);
1536
1537   /* Append parameters to the message.  */
1538   for (i = 3; i < nargs; ++i)
1539     {
1540       dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1541       if (XD_DBUS_TYPE_P (args[i]))
1542         {
1543           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1544           XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1545           XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 2,
1546                             SDATA (format2 ("%s", args[i], Qnil)),
1547                             SDATA (format2 ("%s", args[i+1], Qnil)));
1548           ++i;
1549         }
1550       else
1551         {
1552           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1553           XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 2,
1554                             SDATA (format2 ("%s", args[i], Qnil)));
1555         }
1556
1557       /* Check for valid signature.  We use DBUS_TYPE_INVALID as
1558          indication that there is no parent type.  */
1559       xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1560
1561       xd_append_arg (dtype, args[i], &iter);
1562     }
1563
1564   /* Send the message.  The message is just added to the outgoing
1565      message queue.  */
1566   if (!dbus_connection_send (connection, dmessage, NULL))
1567     XD_SIGNAL1 (build_string ("Cannot send message"));
1568
1569   XD_DEBUG_MESSAGE ("Message sent");
1570
1571   /* Cleanup.  */
1572   dbus_message_unref (dmessage);
1573
1574   /* Return.  */
1575   return Qt;
1576 }
1577
1578 DEFUN ("dbus-send-signal", Fdbus_send_signal, Sdbus_send_signal, 5, MANY, 0,
1579        doc: /* Send signal SIGNAL on the D-Bus BUS.
1580
1581 BUS is either a Lisp symbol, `:system' or `:session', or a string
1582 denoting the bus address.
1583
1584 SERVICE is the D-Bus service name SIGNAL is sent from.  PATH is the
1585 D-Bus object path SERVICE is registered at.  INTERFACE is an interface
1586 offered by SERVICE.  It must provide signal SIGNAL.
1587
1588 All other arguments ARGS are passed to SIGNAL as arguments.  They are
1589 converted into D-Bus types via the following rules:
1590
1591   t and nil => DBUS_TYPE_BOOLEAN
1592   number    => DBUS_TYPE_UINT32
1593   integer   => DBUS_TYPE_INT32
1594   float     => DBUS_TYPE_DOUBLE
1595   string    => DBUS_TYPE_STRING
1596   list      => DBUS_TYPE_ARRAY
1597
1598 All arguments can be preceded by a type symbol.  For details about
1599 type symbols, see Info node `(dbus)Type Conversion'.
1600
1601 Example:
1602
1603 \(dbus-send-signal
1604   :session "org.gnu.Emacs" "/org/gnu/Emacs"
1605   "org.gnu.Emacs.FileManager" "FileModified" "/home/albinus/.emacs")
1606
1607 usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)  */)
1608   (ptrdiff_t nargs, Lisp_Object *args)
1609 {
1610   Lisp_Object bus, service, path, interface, signal;
1611   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
1612   DBusConnection *connection;
1613   DBusMessage *dmessage;
1614   DBusMessageIter iter;
1615   unsigned int dtype;
1616   ptrdiff_t i;
1617   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1618
1619   /* Check parameters.  */
1620   bus = args[0];
1621   service = args[1];
1622   path = args[2];
1623   interface = args[3];
1624   signal = args[4];
1625
1626   CHECK_STRING (service);
1627   CHECK_STRING (path);
1628   CHECK_STRING (interface);
1629   CHECK_STRING (signal);
1630   GCPRO5 (bus, service, path, interface, signal);
1631
1632   XD_DEBUG_MESSAGE ("%s %s %s %s",
1633                     SDATA (service),
1634                     SDATA (path),
1635                     SDATA (interface),
1636                     SDATA (signal));
1637
1638   /* Open a connection to the bus.  */
1639   connection = xd_initialize (bus, TRUE);
1640
1641   /* Create the message.  */
1642   dmessage = dbus_message_new_signal (SSDATA (path),
1643                                       SSDATA (interface),
1644                                       SSDATA (signal));
1645   UNGCPRO;
1646   if (dmessage == NULL)
1647     XD_SIGNAL1 (build_string ("Unable to create a new message"));
1648
1649   /* Initialize parameter list of message.  */
1650   dbus_message_iter_init_append (dmessage, &iter);
1651
1652   /* Append parameters to the message.  */
1653   for (i = 5; i < nargs; ++i)
1654     {
1655       dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1656       if (XD_DBUS_TYPE_P (args[i]))
1657         {
1658           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1659           XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1660           XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", i - 4,
1661                             SDATA (format2 ("%s", args[i], Qnil)),
1662                             SDATA (format2 ("%s", args[i+1], Qnil)));
1663           ++i;
1664         }
1665       else
1666         {
1667           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1668           XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", i - 4,
1669                             SDATA (format2 ("%s", args[i], Qnil)));
1670         }
1671
1672       /* Check for valid signature.  We use DBUS_TYPE_INVALID as
1673          indication that there is no parent type.  */
1674       xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1675
1676       xd_append_arg (dtype, args[i], &iter);
1677     }
1678
1679   /* Send the message.  The message is just added to the outgoing
1680      message queue.  */
1681   if (!dbus_connection_send (connection, dmessage, NULL))
1682     XD_SIGNAL1 (build_string ("Cannot send message"));
1683
1684   XD_DEBUG_MESSAGE ("Signal sent");
1685
1686   /* Cleanup.  */
1687   dbus_message_unref (dmessage);
1688
1689   /* Return.  */
1690   return Qt;
1691 }
1692
1693 /* Read one queued incoming message of the D-Bus BUS.
1694    BUS is either a Lisp symbol, :system or :session, or a string denoting
1695    the bus address.  */
1696 static void
1697 xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
1698 {
1699   Lisp_Object args, key, value;
1700   struct gcpro gcpro1;
1701   struct input_event event;
1702   DBusMessage *dmessage;
1703   DBusMessageIter iter;
1704   unsigned int dtype;
1705   int mtype;
1706   dbus_uint32_t serial;
1707   unsigned int ui_serial;
1708   const char *uname, *path, *interface, *member;
1709
1710   dmessage = dbus_connection_pop_message (connection);
1711
1712   /* Return if there is no queued message.  */
1713   if (dmessage == NULL)
1714     return;
1715
1716   /* Collect the parameters.  */
1717   args = Qnil;
1718   GCPRO1 (args);
1719
1720   /* Loop over the resulting parameters.  Construct a list.  */
1721   if (dbus_message_iter_init (dmessage, &iter))
1722     {
1723       while ((dtype = dbus_message_iter_get_arg_type (&iter))
1724              != DBUS_TYPE_INVALID)
1725         {
1726           args = Fcons (xd_retrieve_arg (dtype, &iter), args);
1727           dbus_message_iter_next (&iter);
1728         }
1729       /* The arguments are stored in reverse order.  Reorder them.  */
1730       args = Fnreverse (args);
1731     }
1732
1733   /* Read message type, message serial, unique name, object path,
1734      interface and member from the message.  */
1735   mtype = dbus_message_get_type (dmessage);
1736   ui_serial = serial =
1737     ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1738      || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1739     ? dbus_message_get_reply_serial (dmessage)
1740     : dbus_message_get_serial (dmessage);
1741   uname = dbus_message_get_sender (dmessage);
1742   path = dbus_message_get_path (dmessage);
1743   interface = dbus_message_get_interface (dmessage);
1744   member = dbus_message_get_member (dmessage);
1745
1746   XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s",
1747                     (mtype == DBUS_MESSAGE_TYPE_INVALID)
1748                     ? "DBUS_MESSAGE_TYPE_INVALID"
1749                     : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1750                     ? "DBUS_MESSAGE_TYPE_METHOD_CALL"
1751                     : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1752                     ? "DBUS_MESSAGE_TYPE_METHOD_RETURN"
1753                     : (mtype == DBUS_MESSAGE_TYPE_ERROR)
1754                     ? "DBUS_MESSAGE_TYPE_ERROR"
1755                     : "DBUS_MESSAGE_TYPE_SIGNAL",
1756                     ui_serial, uname, path, interface, member,
1757                     SDATA (format2 ("%s", args, Qnil)));
1758
1759   if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1760       || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1761     {
1762       /* Search for a registered function of the message.  */
1763       key = list2 (bus, make_fixnum_or_float (serial));
1764       value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1765
1766       /* There shall be exactly one entry.  Construct an event.  */
1767       if (NILP (value))
1768         goto cleanup;
1769
1770       /* Remove the entry.  */
1771       Fremhash (key, Vdbus_registered_objects_table);
1772
1773       /* Construct an event.  */
1774       EVENT_INIT (event);
1775       event.kind = DBUS_EVENT;
1776       event.frame_or_window = Qnil;
1777       event.arg = Fcons (value, args);
1778     }
1779
1780   else /* (mtype != DBUS_MESSAGE_TYPE_METHOD_RETURN)  */
1781     {
1782       /* Vdbus_registered_objects_table requires non-nil interface and
1783          member.  */
1784       if ((interface == NULL) || (member == NULL))
1785         goto cleanup;
1786
1787       /* Search for a registered function of the message.  */
1788       key = list3 (bus, build_string (interface), build_string (member));
1789       value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
1790
1791       /* Loop over the registered functions.  Construct an event.  */
1792       while (!NILP (value))
1793         {
1794           key = CAR_SAFE (value);
1795           /* key has the structure (UNAME SERVICE PATH HANDLER).  */
1796           if (((uname == NULL)
1797                || (NILP (CAR_SAFE (key)))
1798                || (strcmp (uname, SSDATA (CAR_SAFE (key))) == 0))
1799               && ((path == NULL)
1800                   || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1801                   || (strcmp (path,
1802                               SSDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1803                       == 0))
1804               && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))))))
1805             {
1806               EVENT_INIT (event);
1807               event.kind = DBUS_EVENT;
1808               event.frame_or_window = Qnil;
1809               event.arg
1810                 = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))), args);
1811               break;
1812             }
1813           value = CDR_SAFE (value);
1814         }
1815
1816       if (NILP (value))
1817         goto cleanup;
1818     }
1819
1820   /* Add type, serial, uname, path, interface and member to the event.  */
1821   event.arg = Fcons ((member == NULL ? Qnil : build_string (member)),
1822                      event.arg);
1823   event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)),
1824                      event.arg);
1825   event.arg = Fcons ((path == NULL ? Qnil : build_string (path)),
1826                      event.arg);
1827   event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)),
1828                      event.arg);
1829   event.arg = Fcons (make_fixnum_or_float (serial), event.arg);
1830   event.arg = Fcons (make_number (mtype), event.arg);
1831
1832   /* Add the bus symbol to the event.  */
1833   event.arg = Fcons (bus, event.arg);
1834
1835   /* Store it into the input event queue.  */
1836   kbd_buffer_store_event (&event);
1837
1838   XD_DEBUG_MESSAGE ("Event stored: %s",
1839                     SDATA (format2 ("%s", event.arg, Qnil)));
1840
1841   /* Cleanup.  */
1842  cleanup:
1843   dbus_message_unref (dmessage);
1844
1845   UNGCPRO;
1846 }
1847
1848 /* Read queued incoming messages of the D-Bus BUS.
1849    BUS is either a Lisp symbol, :system or :session, or a string denoting
1850    the bus address.  */
1851 static Lisp_Object
1852 xd_read_message (Lisp_Object bus)
1853 {
1854   /* Open a connection to the bus.  */
1855   DBusConnection *connection = xd_initialize (bus, TRUE);
1856
1857   /* Non blocking read of the next available message.  */
1858   dbus_connection_read_write (connection, 0);
1859
1860   while (dbus_connection_get_dispatch_status (connection)
1861          != DBUS_DISPATCH_COMPLETE)
1862     xd_read_message_1 (connection, bus);
1863   return Qnil;
1864 }
1865
1866 /* Callback called when something is ready to read or write.  */
1867 static void
1868 xd_read_queued_messages (int fd, void *data, int for_read)
1869 {
1870   Lisp_Object busp = Vdbus_registered_buses;
1871   Lisp_Object bus = Qnil;
1872
1873   /* Find bus related to fd.  */
1874   if (data != NULL)
1875     while (!NILP (busp))
1876       {
1877         if ((SYMBOLP (CAR_SAFE (busp)) && XSYMBOL (CAR_SAFE (busp)) == data)
1878             || (STRINGP (CAR_SAFE (busp)) && XSTRING (CAR_SAFE (busp)) == data))
1879           bus = CAR_SAFE (busp);
1880         busp = CDR_SAFE (busp);
1881       }
1882
1883   if (NILP (bus))
1884     return;
1885
1886   /* We ignore all Lisp errors during the call.  */
1887   xd_in_read_queued_messages = 1;
1888   internal_catch (Qdbus_error, xd_read_message, bus);
1889   xd_in_read_queued_messages = 0;
1890 }
1891
1892 DEFUN ("dbus-register-service", Fdbus_register_service, Sdbus_register_service,
1893        2, MANY, 0,
1894        doc: /* Register known name SERVICE on the D-Bus BUS.
1895
1896 BUS is either a Lisp symbol, `:system' or `:session', or a string
1897 denoting the bus address.
1898
1899 SERVICE is the D-Bus service name that should be registered.  It must
1900 be a known name.
1901
1902 FLAGS are keywords, which control how the service name is registered.
1903 The following keywords are recognized:
1904
1905 `:allow-replacement': Allow another service to become the primary
1906 owner if requested.
1907
1908 `:replace-existing': Request to replace the current primary owner.
1909
1910 `:do-not-queue': If we can not become the primary owner do not place
1911 us in the queue.
1912
1913 The function returns a keyword, indicating the result of the
1914 operation.  One of the following keywords is returned:
1915
1916 `:primary-owner': Service has become the primary owner of the
1917 requested name.
1918
1919 `:in-queue': Service could not become the primary owner and has been
1920 placed in the queue.
1921
1922 `:exists': Service is already in the queue.
1923
1924 `:already-owner': Service is already the primary owner.
1925
1926 Example:
1927
1928 \(dbus-register-service :session dbus-service-emacs)
1929
1930   => :primary-owner.
1931
1932 \(dbus-register-service
1933   :session "org.freedesktop.TextEditor"
1934   dbus-service-allow-replacement dbus-service-replace-existing)
1935
1936   => :already-owner.
1937
1938 usage: (dbus-register-service BUS SERVICE &rest FLAGS)  */)
1939   (ptrdiff_t nargs, Lisp_Object *args)
1940 {
1941   Lisp_Object bus, service;
1942   DBusConnection *connection;
1943   ptrdiff_t i;
1944   unsigned int value;
1945   unsigned int flags = 0;
1946   int result;
1947   DBusError derror;
1948
1949   bus = args[0];
1950   service = args[1];
1951
1952   /* Check parameters.  */
1953   CHECK_STRING (service);
1954
1955   /* Process flags.  */
1956   for (i = 2; i < nargs; ++i) {
1957     value = ((EQ (args[i], QCdbus_request_name_replace_existing))
1958              ? DBUS_NAME_FLAG_REPLACE_EXISTING
1959              : (EQ (args[i], QCdbus_request_name_allow_replacement))
1960              ? DBUS_NAME_FLAG_ALLOW_REPLACEMENT
1961              : (EQ (args[i], QCdbus_request_name_do_not_queue))
1962              ? DBUS_NAME_FLAG_DO_NOT_QUEUE
1963              : -1);
1964     if (value == -1)
1965       XD_SIGNAL2 (build_string ("Unrecognized name request flag"), args[i]);
1966     flags |= value;
1967   }
1968
1969   /* Open a connection to the bus.  */
1970   connection = xd_initialize (bus, TRUE);
1971
1972   /* Request the known name from the bus.  */
1973   dbus_error_init (&derror);
1974   result = dbus_bus_request_name (connection, SSDATA (service), flags,
1975                                   &derror);
1976   if (dbus_error_is_set (&derror))
1977     XD_ERROR (derror);
1978
1979   /* Cleanup.  */
1980   dbus_error_free (&derror);
1981
1982   /* Return object.  */
1983   switch (result)
1984     {
1985     case DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER:
1986       return QCdbus_request_name_reply_primary_owner;
1987     case DBUS_REQUEST_NAME_REPLY_IN_QUEUE:
1988       return QCdbus_request_name_reply_in_queue;
1989     case DBUS_REQUEST_NAME_REPLY_EXISTS:
1990       return QCdbus_request_name_reply_exists;
1991     case DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER:
1992       return QCdbus_request_name_reply_already_owner;
1993     default:
1994       /* This should not happen.  */
1995       XD_SIGNAL2 (build_string ("Could not register service"), service);
1996     }
1997 }
1998
1999 DEFUN ("dbus-register-signal", Fdbus_register_signal, Sdbus_register_signal,
2000        6, MANY, 0,
2001        doc: /* Register for signal SIGNAL on the D-Bus BUS.
2002
2003 BUS is either a Lisp symbol, `:system' or `:session', or a string
2004 denoting the bus address.
2005
2006 SERVICE is the D-Bus service name used by the sending D-Bus object.
2007 It can be either a known name or the unique name of the D-Bus object
2008 sending the signal.  When SERVICE is nil, related signals from all
2009 D-Bus objects shall be accepted.
2010
2011 PATH is the D-Bus object path SERVICE is registered.  It can also be
2012 nil if the path name of incoming signals shall not be checked.
2013
2014 INTERFACE is an interface offered by SERVICE.  It must provide SIGNAL.
2015 HANDLER is a Lisp function to be called when the signal is received.
2016 It must accept as arguments the values SIGNAL is sending.
2017
2018 All other arguments ARGS, if specified, must be strings.  They stand
2019 for the respective arguments of the signal in their order, and are
2020 used for filtering as well.  A nil argument might be used to preserve
2021 the order.
2022
2023 INTERFACE, SIGNAL and HANDLER must not be nil.  Example:
2024
2025 \(defun my-signal-handler (device)
2026   (message "Device %s added" device))
2027
2028 \(dbus-register-signal
2029   :system "org.freedesktop.Hal" "/org/freedesktop/Hal/Manager"
2030   "org.freedesktop.Hal.Manager" "DeviceAdded" 'my-signal-handler)
2031
2032   => ((:system "org.freedesktop.Hal.Manager" "DeviceAdded")
2033       ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager" my-signal-handler))
2034
2035 `dbus-register-signal' returns an object, which can be used in
2036 `dbus-unregister-object' for removing the registration.
2037
2038 usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARGS) */)
2039   (ptrdiff_t nargs, Lisp_Object *args)
2040 {
2041   Lisp_Object bus, service, path, interface, signal, handler;
2042   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
2043   Lisp_Object uname, key, key1, value;
2044   DBusConnection *connection;
2045   ptrdiff_t i;
2046   char rule[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
2047   int rulelen;
2048   DBusError derror;
2049
2050   /* Check parameters.  */
2051   bus = args[0];
2052   service = args[1];
2053   path = args[2];
2054   interface = args[3];
2055   signal = args[4];
2056   handler = args[5];
2057
2058   if (!NILP (service)) CHECK_STRING (service);
2059   if (!NILP (path)) CHECK_STRING (path);
2060   CHECK_STRING (interface);
2061   CHECK_STRING (signal);
2062   if (!FUNCTIONP (handler))
2063     wrong_type_argument (Qinvalid_function, handler);
2064   GCPRO6 (bus, service, path, interface, signal, handler);
2065
2066   /* Retrieve unique name of service.  If service is a known name, we
2067      will register for the corresponding unique name, if any.  Signals
2068      are sent always with the unique name as sender.  Note: the unique
2069      name of "org.freedesktop.DBus" is that string itself.  */
2070   if ((STRINGP (service))
2071       && (SBYTES (service) > 0)
2072       && (strcmp (SSDATA (service), DBUS_SERVICE_DBUS) != 0)
2073       && (strncmp (SSDATA (service), ":", 1) != 0))
2074     uname = call2 (intern ("dbus-get-name-owner"), bus, service);
2075   else
2076     uname = service;
2077
2078   /* Create a matching rule if the unique name exists (when no
2079      wildcard).  */
2080   if (NILP (uname) || (SBYTES (uname) > 0))
2081     {
2082       /* Open a connection to the bus.  */
2083       connection = xd_initialize (bus, TRUE);
2084
2085       /* Create a rule to receive related signals.  */
2086       rulelen = snprintf (rule, sizeof rule,
2087                           "type='signal',interface='%s',member='%s'",
2088                           SDATA (interface),
2089                           SDATA (signal));
2090       if (! (0 <= rulelen && rulelen < sizeof rule))
2091         string_overflow ();
2092
2093       /* Add unique name and path to the rule if they are non-nil.  */
2094       if (!NILP (uname))
2095         {
2096           int len = snprintf (rule + rulelen, sizeof rule - rulelen,
2097                               ",sender='%s'", SDATA (uname));
2098           if (! (0 <= len && len < sizeof rule - rulelen))
2099             string_overflow ();
2100           rulelen += len;
2101         }
2102
2103       if (!NILP (path))
2104         {
2105           int len = snprintf (rule + rulelen, sizeof rule - rulelen,
2106                               ",path='%s'", SDATA (path));
2107           if (! (0 <= len && len < sizeof rule - rulelen))
2108             string_overflow ();
2109           rulelen += len;
2110         }
2111
2112       /* Add arguments to the rule if they are non-nil.  */
2113       for (i = 6; i < nargs; ++i)
2114         if (!NILP (args[i]))
2115           {
2116             int len;
2117             CHECK_STRING (args[i]);
2118             len = snprintf (rule + rulelen, sizeof rule - rulelen,
2119                             ",arg%"pD"d='%s'", i - 6, SDATA (args[i]));
2120             if (! (0 <= len && len < sizeof rule - rulelen))
2121               string_overflow ();
2122             rulelen += len;
2123           }
2124
2125       /* Add the rule to the bus.  */
2126       dbus_error_init (&derror);
2127       dbus_bus_add_match (connection, rule, &derror);
2128       if (dbus_error_is_set (&derror))
2129         {
2130           UNGCPRO;
2131           XD_ERROR (derror);
2132         }
2133
2134       /* Cleanup.  */
2135       dbus_error_free (&derror);
2136
2137       XD_DEBUG_MESSAGE ("Matching rule \"%s\" created", rule);
2138     }
2139
2140   /* Create a hash table entry.  */
2141   key = list3 (bus, interface, signal);
2142   key1 = list5 (uname, service, path, handler, build_string (rule));
2143   value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
2144
2145   if (NILP (Fmember (key1, value)))
2146     Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
2147
2148   /* Return object.  */
2149   RETURN_UNGCPRO (list2 (key, list3 (service, path, handler)));
2150 }
2151
2152 DEFUN ("dbus-register-method", Fdbus_register_method, Sdbus_register_method,
2153        6, 7, 0,
2154        doc: /* Register for method METHOD on the D-Bus BUS.
2155
2156 BUS is either a Lisp symbol, `:system' or `:session', or a string
2157 denoting the bus address.
2158
2159 SERVICE is the D-Bus service name of the D-Bus object METHOD is
2160 registered for.  It must be a known name (See discussion of
2161 DONT-REGISTER-SERVICE below).
2162
2163 PATH is the D-Bus object path SERVICE is registered (See discussion of
2164 DONT-REGISTER-SERVICE below).  INTERFACE is the interface offered by
2165 SERVICE.  It must provide METHOD.  HANDLER is a Lisp function to be
2166 called when a method call is received.  It must accept the input
2167 arguments of METHOD.  The return value of HANDLER is used for
2168 composing the returning D-Bus message.
2169
2170 When DONT-REGISTER-SERVICE is non-nil, the known name SERVICE is not
2171 registered.  This means that other D-Bus clients have no way of
2172 noticing the newly registered method.  When interfaces are constructed
2173 incrementally by adding single methods or properties at a time,
2174 DONT-REGISTER-SERVICE can be used to prevent other clients from
2175 discovering the still incomplete interface.*/)
2176   (Lisp_Object bus, Lisp_Object service, Lisp_Object path,
2177    Lisp_Object interface, Lisp_Object method, Lisp_Object handler,
2178    Lisp_Object dont_register_service)
2179 {
2180   Lisp_Object key, key1, value;
2181   Lisp_Object args[2] = { bus, service };
2182
2183   /* Check parameters.  */
2184   CHECK_STRING (service);
2185   CHECK_STRING (path);
2186   CHECK_STRING (interface);
2187   CHECK_STRING (method);
2188   if (!FUNCTIONP (handler))
2189     wrong_type_argument (Qinvalid_function, handler);
2190   /* TODO: We must check for a valid service name, otherwise there is
2191      a segmentation fault.  */
2192
2193   /* Request the name.  */
2194   if (NILP (dont_register_service))
2195     Fdbus_register_service (2, args);
2196
2197   /* Create a hash table entry.  We use nil for the unique name,
2198      because the method might be called from anybody.  */
2199   key = list3 (bus, interface, method);
2200   key1 = list4 (Qnil, service, path, handler);
2201   value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
2202
2203   if (NILP (Fmember (key1, value)))
2204     Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
2205
2206   /* Return object.  */
2207   return list2 (key, list3 (service, path, handler));
2208 }
2209
2210 \f
2211 void
2212 syms_of_dbusbind (void)
2213 {
2214
2215   DEFSYM (Qdbus_init_bus, "dbus-init-bus");
2216   defsubr (&Sdbus_init_bus);
2217
2218   DEFSYM (Qdbus_close_bus, "dbus-close-bus");
2219   defsubr (&Sdbus_close_bus);
2220
2221   DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name");
2222   defsubr (&Sdbus_get_unique_name);
2223
2224   DEFSYM (Qdbus_call_method, "dbus-call-method");
2225   defsubr (&Sdbus_call_method);
2226
2227   DEFSYM (Qdbus_call_method_asynchronously, "dbus-call-method-asynchronously");
2228   defsubr (&Sdbus_call_method_asynchronously);
2229
2230   DEFSYM (Qdbus_method_return_internal, "dbus-method-return-internal");
2231   defsubr (&Sdbus_method_return_internal);
2232
2233   DEFSYM (Qdbus_method_error_internal, "dbus-method-error-internal");
2234   defsubr (&Sdbus_method_error_internal);
2235
2236   DEFSYM (Qdbus_send_signal, "dbus-send-signal");
2237   defsubr (&Sdbus_send_signal);
2238
2239   DEFSYM (Qdbus_register_service, "dbus-register-service");
2240   defsubr (&Sdbus_register_service);
2241
2242   DEFSYM (Qdbus_register_signal, "dbus-register-signal");
2243   defsubr (&Sdbus_register_signal);
2244
2245   DEFSYM (Qdbus_register_method, "dbus-register-method");
2246   defsubr (&Sdbus_register_method);
2247
2248   DEFSYM (Qdbus_error, "dbus-error");
2249   Fput (Qdbus_error, Qerror_conditions,
2250         list2 (Qdbus_error, Qerror));
2251   Fput (Qdbus_error, Qerror_message,
2252         make_pure_c_string ("D-Bus error"));
2253
2254   DEFSYM (QCdbus_system_bus, ":system");
2255   DEFSYM (QCdbus_session_bus, ":session");
2256   DEFSYM (QCdbus_request_name_allow_replacement, ":allow-replacement");
2257   DEFSYM (QCdbus_request_name_replace_existing, ":replace-existing");
2258   DEFSYM (QCdbus_request_name_do_not_queue, ":do-not-queue");
2259   DEFSYM (QCdbus_request_name_reply_primary_owner, ":primary-owner");
2260   DEFSYM (QCdbus_request_name_reply_exists, ":exists");
2261   DEFSYM (QCdbus_request_name_reply_in_queue, ":in-queue");
2262   DEFSYM (QCdbus_request_name_reply_already_owner, ":already-owner");
2263   DEFSYM (QCdbus_timeout, ":timeout");
2264   DEFSYM (QCdbus_type_byte, ":byte");
2265   DEFSYM (QCdbus_type_boolean, ":boolean");
2266   DEFSYM (QCdbus_type_int16, ":int16");
2267   DEFSYM (QCdbus_type_uint16, ":uint16");
2268   DEFSYM (QCdbus_type_int32, ":int32");
2269   DEFSYM (QCdbus_type_uint32, ":uint32");
2270   DEFSYM (QCdbus_type_int64, ":int64");
2271   DEFSYM (QCdbus_type_uint64, ":uint64");
2272   DEFSYM (QCdbus_type_double, ":double");
2273   DEFSYM (QCdbus_type_string, ":string");
2274   DEFSYM (QCdbus_type_object_path, ":object-path");
2275   DEFSYM (QCdbus_type_signature, ":signature");
2276
2277 #ifdef DBUS_TYPE_UNIX_FD
2278   DEFSYM (QCdbus_type_unix_fd, ":unix-fd");
2279 #endif
2280
2281   DEFSYM (QCdbus_type_array, ":array");
2282   DEFSYM (QCdbus_type_variant, ":variant");
2283   DEFSYM (QCdbus_type_struct, ":struct");
2284   DEFSYM (QCdbus_type_dict_entry, ":dict-entry");
2285
2286   DEFVAR_LISP ("dbus-registered-buses",
2287                Vdbus_registered_buses,
2288     doc: /* List of D-Bus buses we are polling for messages.  */);
2289   Vdbus_registered_buses = Qnil;
2290
2291   DEFVAR_LISP ("dbus-registered-objects-table",
2292                Vdbus_registered_objects_table,
2293     doc: /* Hash table of registered functions for D-Bus.
2294
2295 There are two different uses of the hash table: for accessing
2296 registered interfaces properties, targeted by signals or method calls,
2297 and for calling handlers in case of non-blocking method call returns.
2298
2299 In the first case, the key in the hash table is the list (BUS
2300 INTERFACE MEMBER).  BUS is either a Lisp symbol, `:system' or
2301 `:session', or a string denoting the bus address.  INTERFACE is a
2302 string which denotes a D-Bus interface, and MEMBER, also a string, is
2303 either a method, a signal or a property INTERFACE is offering.  All
2304 arguments but BUS must not be nil.
2305
2306 The value in the hash table is a list of quadruple lists
2307 \((UNAME SERVICE PATH OBJECT) (UNAME SERVICE PATH OBJECT) ...).
2308 SERVICE is the service name as registered, UNAME is the corresponding
2309 unique name.  In case of registered methods and properties, UNAME is
2310 nil.  PATH is the object path of the sending object.  All of them can
2311 be nil, which means a wildcard then.  OBJECT is either the handler to
2312 be called when a D-Bus message, which matches the key criteria,
2313 arrives (methods and signals), or a cons cell containing the value of
2314 the property.
2315
2316 For signals, there is also a fifth element RULE, which keeps the match
2317 string the signal is registered with.
2318
2319 In the second case, the key in the hash table is the list (BUS
2320 SERIAL).  BUS is either a Lisp symbol, `:system' or `:session', or a
2321 string denoting the bus address.  SERIAL is the serial number of the
2322 non-blocking method call, a reply is expected.  Both arguments must
2323 not be nil.  The value in the hash table is HANDLER, the function to
2324 be called when the D-Bus reply message arrives.  */);
2325   {
2326     Lisp_Object args[2];
2327     args[0] = QCtest;
2328     args[1] = Qequal;
2329     Vdbus_registered_objects_table = Fmake_hash_table (2, args);
2330   }
2331
2332   DEFVAR_LISP ("dbus-debug", Vdbus_debug,
2333     doc: /* If non-nil, debug messages of D-Bus bindings are raised.  */);
2334 #ifdef DBUS_DEBUG
2335   Vdbus_debug = Qt;
2336   /* We can also set environment variable DBUS_VERBOSE=1 in order to
2337      see more traces.  This requires libdbus-1 to be configured with
2338      --enable-verbose-mode.  */
2339 #else
2340   Vdbus_debug = Qnil;
2341 #endif
2342
2343   Fprovide (intern_c_string ("dbusbind"), Qnil);
2344
2345 }
2346
2347 #endif /* HAVE_DBUS */