src/dbusbind.c

   1 /* Elisp bindings for D-Bus.
   2    Copyright (C) 2007, 2008 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 <stdlib.h>
  23 #include <stdio.h>
  24 #include <dbus/dbus.h>
  25 #include "lisp.h"
  26 #include "frame.h"
  27 #include "termhooks.h"
  28 #include "keyboard.h"
  29
  30 \f
  31 /* Subroutines.  */
  32 Lisp_Object Qdbus_get_unique_name;
  33 Lisp_Object Qdbus_call_method;
  34 Lisp_Object Qdbus_call_method_asynchronously;
  35 Lisp_Object Qdbus_method_return_internal;
  36 Lisp_Object Qdbus_method_error_internal;
  37 Lisp_Object Qdbus_send_signal;
  38 Lisp_Object Qdbus_register_signal;
  39 Lisp_Object Qdbus_register_method;
  40
  41 /* D-Bus error symbol.  */
  42 Lisp_Object Qdbus_error;
  43
  44 /* Lisp symbols of the system and session buses.  */
  45 Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
  46
  47 /* Lisp symbol for method call timeout.  */
  48 Lisp_Object QCdbus_timeout;
  49
  50 /* Lisp symbols of D-Bus types.  */
  51 Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
  52 Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
  53 Lisp_Object QCdbus_type_int32, QCdbus_type_uint32;
  54 Lisp_Object QCdbus_type_int64, QCdbus_type_uint64;
  55 Lisp_Object QCdbus_type_double, QCdbus_type_string;
  56 Lisp_Object QCdbus_type_object_path, QCdbus_type_signature;
  57 Lisp_Object QCdbus_type_array, QCdbus_type_variant;
  58 Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
  59
  60 /* Hash table which keeps function definitions.  */
  61 Lisp_Object Vdbus_registered_functions_table;
  62
  63 /* Whether to debug D-Bus.  */
  64 Lisp_Object Vdbus_debug;
  65
  66 \f
  67 /* We use "xd_" and "XD_" as prefix for all internal symbols, because
  68    we don't want to poison other namespaces with "dbus_".  */
  69
  70 /* Raise a Lisp error from a D-Bus ERROR.  */
  71 #define XD_ERROR(error)                                                 \
  72   do {                                                                  \
  73     char s[1024];                                                       \
  74     strncpy (s, error.message, 1023);                                   \
  75     dbus_error_free (&error);                                           \
  76     /* Remove the trailing newline.  */                                 \
  77     if (strchr (s, '\n') != NULL)                                       \
  78       s[strlen (s) - 1] = '\0';                                         \
  79     xsignal1 (Qdbus_error, build_string (s));                           \
  80   } while (0)
  81
  82 /* Macros for debugging.  In order to enable them, build with
  83    "make MYCPPFLAGS='-DDBUS_DEBUG -Wall'".  */
  84 #ifdef DBUS_DEBUG
  85 #define XD_DEBUG_MESSAGE(...)           \
  86   do {                                  \
  87     char s[1024];                       \
  88     snprintf (s, 1023, __VA_ARGS__);    \
  89     printf ("%s: %s\n", __func__, s);   \
  90     message ("%s: %s", __func__, s);    \
  91   } while (0)
  92 #define XD_DEBUG_VALID_LISP_OBJECT_P(object)                            \
  93   do {                                                                  \
  94     if (!valid_lisp_object_p (object))                                  \
  95       {                                                                 \
  96         XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__);            \
  97         xsignal1 (Qdbus_error, build_string ("Assertion failure"));     \
  98       }                                                                 \
  99   } while (0)
 100
 101 #else /* !DBUS_DEBUG */
 102 #define XD_DEBUG_MESSAGE(...)                                           \
 103   do {                                                                  \
 104     if (!NILP (Vdbus_debug))                                            \
 105       {                                                                 \
 106         char s[1024];                                                   \
 107         snprintf (s, 1023, __VA_ARGS__);                                \
 108         message ("%s: %s", __func__, s);                                \
 109       }                                                                 \
 110   } while (0)
 111 #define XD_DEBUG_VALID_LISP_OBJECT_P(object)
 112 #endif
 113
 114 /* Check whether TYPE is a basic DBusType.  */
 115 #define XD_BASIC_DBUS_TYPE(type)                                        \
 116   ((type ==  DBUS_TYPE_BYTE)                                            \
 117    || (type ==  DBUS_TYPE_BOOLEAN)                                      \
 118    || (type ==  DBUS_TYPE_INT16)                                        \
 119    || (type ==  DBUS_TYPE_UINT16)                                       \
 120    || (type ==  DBUS_TYPE_INT32)                                        \
 121    || (type ==  DBUS_TYPE_UINT32)                                       \
 122    || (type ==  DBUS_TYPE_INT64)                                        \
 123    || (type ==  DBUS_TYPE_UINT64)                                       \
 124    || (type ==  DBUS_TYPE_DOUBLE)                                       \
 125    || (type ==  DBUS_TYPE_STRING)                                       \
 126    || (type ==  DBUS_TYPE_OBJECT_PATH)                                  \
 127    || (type ==  DBUS_TYPE_SIGNATURE))
 128
 129 /* Determine the DBusType of a given Lisp symbol.  OBJECT must be one
 130    of the predefined D-Bus type symbols.  */
 131 #define XD_SYMBOL_TO_DBUS_TYPE(object)                                  \
 132   ((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE                     \
 133    : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN             \
 134    : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16                 \
 135    : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16               \
 136    : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32                 \
 137    : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32               \
 138    : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64                 \
 139    : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64               \
 140    : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE               \
 141    : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING               \
 142    : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH     \
 143    : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE         \
 144    : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY                 \
 145    : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT             \
 146    : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT               \
 147    : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY       \
 148    : DBUS_TYPE_INVALID)
 149
 150 /* Check whether a Lisp symbol is a predefined D-Bus type symbol.  */
 151 #define XD_DBUS_TYPE_P(object)                                          \
 152   (SYMBOLP (object) && ((XD_SYMBOL_TO_DBUS_TYPE (object) != DBUS_TYPE_INVALID)))
 153
 154 /* Determine the DBusType of a given Lisp OBJECT.  It is used to
 155    convert Lisp objects, being arguments of `dbus-call-method' or
 156    `dbus-send-signal', into corresponding C values appended as
 157    arguments to a D-Bus message.  */
 158 #define XD_OBJECT_TO_DBUS_TYPE(object)                                  \
 159   ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN           \
 160    : (NATNUMP (object)) ? DBUS_TYPE_UINT32                              \
 161    : (INTEGERP (object)) ? DBUS_TYPE_INT32                              \
 162    : (FLOATP (object)) ? DBUS_TYPE_DOUBLE                               \
 163    : (STRINGP (object)) ? DBUS_TYPE_STRING                              \
 164    : (XD_DBUS_TYPE_P (object)) ? XD_SYMBOL_TO_DBUS_TYPE (object)        \
 165    : (CONSP (object)) ? ((XD_DBUS_TYPE_P (CAR_SAFE (object)))           \
 166                          ? XD_SYMBOL_TO_DBUS_TYPE (CAR_SAFE (object))   \
 167                          : DBUS_TYPE_ARRAY)                             \
 168    : DBUS_TYPE_INVALID)
 169
 170 /* Return a list pointer which does not have a Lisp symbol as car.  */
 171 #define XD_NEXT_VALUE(object)                                           \
 172   ((XD_DBUS_TYPE_P (CAR_SAFE (object))) ? CDR_SAFE (object) : object)
 173
 174 /* Compute SIGNATURE of OBJECT.  It must have a form that it can be
 175    used in dbus_message_iter_open_container.  DTYPE is the DBusType
 176    the object is related to.  It is passed as argument, because it
 177    cannot be detected in basic type objects, when they are preceded by
 178    a type symbol.  PARENT_TYPE is the DBusType of a container this
 179    signature is embedded, or DBUS_TYPE_INVALID.  It is needed for the
 180    check that DBUS_TYPE_DICT_ENTRY occurs only as array element.  */
 181 void
 182 xd_signature (signature, dtype, parent_type, object)
 183      char *signature;
 184      unsigned int dtype, parent_type;
 185      Lisp_Object object;
 186 {
 187   unsigned int subtype;
 188   Lisp_Object elt;
 189   char x[DBUS_MAXIMUM_SIGNATURE_LENGTH];
 190
 191   elt = object;
 192
 193   switch (dtype)
 194     {
 195     case DBUS_TYPE_BYTE:
 196     case DBUS_TYPE_UINT16:
 197     case DBUS_TYPE_UINT32:
 198     case DBUS_TYPE_UINT64:
 199       CHECK_NATNUM (object);
 200       sprintf (signature, "%c", dtype);
 201       break;
 202
 203     case DBUS_TYPE_BOOLEAN:
 204       if (!EQ (object, Qt) && !EQ (object, Qnil))
 205         wrong_type_argument (intern ("booleanp"), object);
 206       sprintf (signature, "%c", dtype);
 207       break;
 208
 209     case DBUS_TYPE_INT16:
 210     case DBUS_TYPE_INT32:
 211     case DBUS_TYPE_INT64:
 212       CHECK_NUMBER (object);
 213       sprintf (signature, "%c", dtype);
 214       break;
 215
 216     case DBUS_TYPE_DOUBLE:
 217       CHECK_FLOAT (object);
 218       sprintf (signature, "%c", dtype);
 219       break;
 220
 221     case DBUS_TYPE_STRING:
 222     case DBUS_TYPE_OBJECT_PATH:
 223     case DBUS_TYPE_SIGNATURE:
 224       CHECK_STRING (object);
 225       sprintf (signature, "%c", dtype);
 226       break;
 227
 228     case DBUS_TYPE_ARRAY:
 229       /* Check that all list elements have the same D-Bus type.  For
 230          complex element types, we just check the container type, not
 231          the whole element's signature.  */
 232       CHECK_CONS (object);
 233
 234       /* Type symbol is optional.  */
 235       if (EQ (QCdbus_type_array, CAR_SAFE (elt)))
 236         elt = XD_NEXT_VALUE (elt);
 237
 238       /* If the array is empty, DBUS_TYPE_STRING is the default
 239          element type.  */
 240       if (NILP (elt))
 241         {
 242           subtype = DBUS_TYPE_STRING;
 243           strcpy (x, DBUS_TYPE_STRING_AS_STRING);
 244         }
 245       else
 246         {
 247           subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 248           xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 249         }
 250
 251       /* If the element type is DBUS_TYPE_SIGNATURE, and this is the
 252          only element, the value of this element is used as he array's
 253          element signature.  */
 254       if ((subtype == DBUS_TYPE_SIGNATURE)
 255           && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt)))
 256           && NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
 257         strcpy (x, SDATA (CAR_SAFE (XD_NEXT_VALUE (elt))));
 258
 259       while (!NILP (elt))
 260         {
 261           if (subtype != XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)))
 262             wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt));
 263           elt = CDR_SAFE (XD_NEXT_VALUE (elt));
 264         }
 265
 266       sprintf (signature, "%c%s", dtype, x);
 267       break;
 268
 269     case DBUS_TYPE_VARIANT:
 270       /* Check that there is exactly one list element.  */
 271       CHECK_CONS (object);
 272
 273       elt = XD_NEXT_VALUE (elt);
 274       subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 275       xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 276
 277       if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
 278         wrong_type_argument (intern ("D-Bus"),
 279                              CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
 280
 281       sprintf (signature, "%c", dtype);
 282       break;
 283
 284     case DBUS_TYPE_STRUCT:
 285       /* A struct list might contain any number of elements with
 286          different types.  No further check needed.  */
 287       CHECK_CONS (object);
 288
 289       elt = XD_NEXT_VALUE (elt);
 290
 291       /* Compose the signature from the elements.  It is enclosed by
 292          parentheses.  */
 293       sprintf (signature, "%c", DBUS_STRUCT_BEGIN_CHAR );
 294       while (!NILP (elt))
 295         {
 296           subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 297           xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 298           strcat (signature, x);
 299           elt = CDR_SAFE (XD_NEXT_VALUE (elt));
 300         }
 301       strcat (signature, DBUS_STRUCT_END_CHAR_AS_STRING);
 302       break;
 303
 304     case DBUS_TYPE_DICT_ENTRY:
 305       /* Check that there are exactly two list elements, and the first
 306          one is of basic type.  The dictionary entry itself must be an
 307          element of an array.  */
 308       CHECK_CONS (object);
 309
 310       /* Check the parent object type.  */
 311       if (parent_type != DBUS_TYPE_ARRAY)
 312         wrong_type_argument (intern ("D-Bus"), object);
 313
 314       /* Compose the signature from the elements.  It is enclosed by
 315          curly braces.  */
 316       sprintf (signature, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR);
 317
 318       /* First element.  */
 319       elt = XD_NEXT_VALUE (elt);
 320       subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 321       xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 322       strcat (signature, x);
 323
 324       if (!XD_BASIC_DBUS_TYPE (subtype))
 325         wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt)));
 326
 327       /* Second element.  */
 328       elt = CDR_SAFE (XD_NEXT_VALUE (elt));
 329       subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 330       xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 331       strcat (signature, x);
 332
 333       if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
 334         wrong_type_argument (intern ("D-Bus"),
 335                              CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
 336
 337       /* Closing signature.  */
 338       strcat (signature, DBUS_DICT_ENTRY_END_CHAR_AS_STRING);
 339       break;
 340
 341     default:
 342       wrong_type_argument (intern ("D-Bus"), object);
 343     }
 344
 345   XD_DEBUG_MESSAGE ("%s", signature);
 346 }
 347
 348 /* Append C value, extracted from Lisp OBJECT, to iteration ITER.
 349    DTYPE must be a valid DBusType.  It is used to convert Lisp
 350    objects, being arguments of `dbus-call-method' or
 351    `dbus-send-signal', into corresponding C values appended as
 352    arguments to a D-Bus message.  */
 353 void
 354 xd_append_arg (dtype, object, iter)
 355      unsigned int dtype;
 356      Lisp_Object object;
 357      DBusMessageIter *iter;
 358 {
 359   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
 360   DBusMessageIter subiter;
 361
 362   if (XD_BASIC_DBUS_TYPE (dtype))
 363     switch (dtype)
 364       {
 365       case DBUS_TYPE_BYTE:
 366         {
 367           unsigned char val = XUINT (object) & 0xFF;
 368           XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 369           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 370             xsignal2 (Qdbus_error,
 371                       build_string ("Unable to append argument"), object);
 372           return;
 373         }
 374
 375       case DBUS_TYPE_BOOLEAN:
 376         {
 377           dbus_bool_t val = (NILP (object)) ? FALSE : TRUE;
 378           XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
 379           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 380             xsignal2 (Qdbus_error,
 381                       build_string ("Unable to append argument"), object);
 382           return;
 383         }
 384
 385       case DBUS_TYPE_INT16:
 386         {
 387           dbus_int16_t val = XINT (object);
 388           XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
 389           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 390             xsignal2 (Qdbus_error,
 391                       build_string ("Unable to append argument"), object);
 392           return;
 393         }
 394
 395       case DBUS_TYPE_UINT16:
 396         {
 397           dbus_uint16_t val = XUINT (object);
 398           XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
 399           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 400             xsignal2 (Qdbus_error,
 401                       build_string ("Unable to append argument"), object);
 402           return;
 403         }
 404
 405       case DBUS_TYPE_INT32:
 406         {
 407           dbus_int32_t val = XINT (object);
 408           XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 409           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 410             xsignal2 (Qdbus_error,
 411                       build_string ("Unable to append argument"), object);
 412           return;
 413         }
 414
 415       case DBUS_TYPE_UINT32:
 416         {
 417           dbus_uint32_t val = XUINT (object);
 418           XD_DEBUG_MESSAGE ("%c %u", dtype, val);
 419           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 420             xsignal2 (Qdbus_error,
 421                       build_string ("Unable to append argument"), object);
 422           return;
 423         }
 424
 425       case DBUS_TYPE_INT64:
 426         {
 427           dbus_int64_t val = XINT (object);
 428           XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
 429           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 430             xsignal2 (Qdbus_error,
 431                       build_string ("Unable to append argument"), object);
 432           return;
 433         }
 434
 435       case DBUS_TYPE_UINT64:
 436         {
 437           dbus_uint64_t val = XUINT (object);
 438           XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
 439           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 440             xsignal2 (Qdbus_error,
 441                       build_string ("Unable to append argument"), object);
 442           return;
 443         }
 444
 445       case DBUS_TYPE_DOUBLE:
 446         XD_DEBUG_MESSAGE ("%c %f", dtype, XFLOAT_DATA (object));
 447         if (!dbus_message_iter_append_basic (iter, dtype,
 448                                              &XFLOAT_DATA (object)))
 449           xsignal2 (Qdbus_error,
 450                     build_string ("Unable to append argument"), object);
 451         return;
 452
 453       case DBUS_TYPE_STRING:
 454       case DBUS_TYPE_OBJECT_PATH:
 455       case DBUS_TYPE_SIGNATURE:
 456         {
 457           char *val = SDATA (Fstring_make_unibyte (object));
 458           XD_DEBUG_MESSAGE ("%c %s", dtype, val);
 459           if (!dbus_message_iter_append_basic (iter, dtype, &val))
 460             xsignal2 (Qdbus_error,
 461                       build_string ("Unable to append argument"), object);
 462           return;
 463         }
 464       }
 465
 466   else /* Compound types.  */
 467     {
 468
 469       /* All compound types except array have a type symbol.  For
 470          array, it is optional.  Skip it.  */
 471       if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))))
 472         object = XD_NEXT_VALUE (object);
 473
 474       /* Open new subiteration.  */
 475       switch (dtype)
 476         {
 477         case DBUS_TYPE_ARRAY:
 478           /* An array has only elements of the same type.  So it is
 479              sufficient to check the first element's signature
 480              only.  */
 481
 482           if (NILP (object))
 483             /* If the array is empty, DBUS_TYPE_STRING is the default
 484                element type.  */
 485             strcpy (signature, DBUS_TYPE_STRING_AS_STRING);
 486
 487           else
 488             /* If the element type is DBUS_TYPE_SIGNATURE, and this is
 489                the only element, the value of this element is used as
 490                the array's element signature.  */
 491             if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))
 492                  == DBUS_TYPE_SIGNATURE)
 493                 && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object)))
 494                 && NILP (CDR_SAFE (XD_NEXT_VALUE (object))))
 495               {
 496                 strcpy (signature, SDATA (CAR_SAFE (XD_NEXT_VALUE (object))));
 497                 object = CDR_SAFE (XD_NEXT_VALUE (object));
 498               }
 499
 500             else
 501               xd_signature (signature,
 502                             XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
 503                             dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
 504
 505           XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
 506                             SDATA (format2 ("%s", object, Qnil)));
 507           if (!dbus_message_iter_open_container (iter, dtype,
 508                                                  signature, &subiter))
 509             xsignal3 (Qdbus_error,
 510                       build_string ("Cannot open container"),
 511                       make_number (dtype), build_string (signature));
 512           break;
 513
 514         case DBUS_TYPE_VARIANT:
 515           /* A variant has just one element.  */
 516           xd_signature (signature, XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
 517                         dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
 518
 519           XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
 520                             SDATA (format2 ("%s", object, Qnil)));
 521           if (!dbus_message_iter_open_container (iter, dtype,
 522                                                  signature, &subiter))
 523             xsignal3 (Qdbus_error,
 524                       build_string ("Cannot open container"),
 525                       make_number (dtype), build_string (signature));
 526           break;
 527
 528         case DBUS_TYPE_STRUCT:
 529         case DBUS_TYPE_DICT_ENTRY:
 530           /* These containers do not require a signature.  */
 531           XD_DEBUG_MESSAGE ("%c %s", dtype,
 532                             SDATA (format2 ("%s", object, Qnil)));
 533           if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
 534             xsignal2 (Qdbus_error,
 535                       build_string ("Cannot open container"),
 536                       make_number (dtype));
 537           break;
 538         }
 539
 540       /* Loop over list elements.  */
 541       while (!NILP (object))
 542         {
 543           dtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object));
 544           object = XD_NEXT_VALUE (object);
 545
 546           xd_append_arg (dtype, CAR_SAFE (object), &subiter);
 547
 548           object = CDR_SAFE (object);
 549         }
 550
 551       /* Close the subiteration.  */
 552       if (!dbus_message_iter_close_container (iter, &subiter))
 553         xsignal2 (Qdbus_error,
 554                   build_string ("Cannot close container"),
 555                   make_number (dtype));
 556     }
 557 }
 558
 559 /* Retrieve C value from a DBusMessageIter structure ITER, and return
 560    a converted Lisp object.  The type DTYPE of the argument of the
 561    D-Bus message must be a valid DBusType.  Compound D-Bus types
 562    result always in a Lisp list.  */
 563 Lisp_Object
 564 xd_retrieve_arg (dtype, iter)
 565      unsigned int dtype;
 566      DBusMessageIter *iter;
 567 {
 568
 569   switch (dtype)
 570     {
 571     case DBUS_TYPE_BYTE:
 572       {
 573         unsigned int val;
 574         dbus_message_iter_get_basic (iter, &val);
 575         val = val & 0xFF;
 576         XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 577         return make_number (val);
 578       }
 579
 580     case DBUS_TYPE_BOOLEAN:
 581       {
 582         dbus_bool_t val;
 583         dbus_message_iter_get_basic (iter, &val);
 584         XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
 585         return (val == FALSE) ? Qnil : Qt;
 586       }
 587
 588     case DBUS_TYPE_INT16:
 589     case DBUS_TYPE_UINT16:
 590       {
 591         dbus_uint16_t val;
 592         dbus_message_iter_get_basic (iter, &val);
 593         XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 594         return make_number (val);
 595       }
 596
 597     case DBUS_TYPE_INT32:
 598     case DBUS_TYPE_UINT32:
 599       {
 600         /* Assignment to EMACS_INT stops GCC whining about limited
 601            range of data type.  */
 602         dbus_uint32_t val;
 603         EMACS_INT val1;
 604         dbus_message_iter_get_basic (iter, &val);
 605         XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 606         val1 = val;
 607         return make_fixnum_or_float (val1);
 608       }
 609
 610     case DBUS_TYPE_INT64:
 611     case DBUS_TYPE_UINT64:
 612       {
 613         dbus_uint64_t val;
 614         dbus_message_iter_get_basic (iter, &val);
 615         XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
 616         return make_fixnum_or_float (val);
 617       }
 618
 619     case DBUS_TYPE_DOUBLE:
 620       {
 621         double val;
 622         dbus_message_iter_get_basic (iter, &val);
 623         XD_DEBUG_MESSAGE ("%c %f", dtype, val);
 624         return make_float (val);
 625       }
 626
 627     case DBUS_TYPE_STRING:
 628     case DBUS_TYPE_OBJECT_PATH:
 629     case DBUS_TYPE_SIGNATURE:
 630       {
 631         char *val;
 632         dbus_message_iter_get_basic (iter, &val);
 633         XD_DEBUG_MESSAGE ("%c %s", dtype, val);
 634         return build_string (val);
 635       }
 636
 637     case DBUS_TYPE_ARRAY:
 638     case DBUS_TYPE_VARIANT:
 639     case DBUS_TYPE_STRUCT:
 640     case DBUS_TYPE_DICT_ENTRY:
 641       {
 642         Lisp_Object result;
 643         struct gcpro gcpro1;
 644         result = Qnil;
 645         GCPRO1 (result);
 646         DBusMessageIter subiter;
 647         int subtype;
 648         dbus_message_iter_recurse (iter, &subiter);
 649         while ((subtype = dbus_message_iter_get_arg_type (&subiter))
 650                != DBUS_TYPE_INVALID)
 651           {
 652             result = Fcons (xd_retrieve_arg (subtype, &subiter), result);
 653             dbus_message_iter_next (&subiter);
 654           }
 655         XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (format2 ("%s", result, Qnil)));
 656         RETURN_UNGCPRO (Fnreverse (result));
 657       }
 658
 659     default:
 660       XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype);
 661       return Qnil;
 662     }
 663 }
 664
 665 /* Initialize D-Bus connection.  BUS is a Lisp symbol, either :system
 666    or :session.  It tells which D-Bus to be initialized.  */
 667 DBusConnection *
 668 xd_initialize (bus)
 669      Lisp_Object bus;
 670 {
 671   DBusConnection *connection;
 672   DBusError derror;
 673
 674   /* Parameter check.  */
 675   CHECK_SYMBOL (bus);
 676   if (!((EQ (bus, QCdbus_system_bus)) || (EQ (bus, QCdbus_session_bus))))
 677     xsignal2 (Qdbus_error, build_string ("Wrong bus name"), bus);
 678
 679   /* Open a connection to the bus.  */
 680   dbus_error_init (&derror);
 681
 682   if (EQ (bus, QCdbus_system_bus))
 683     connection = dbus_bus_get (DBUS_BUS_SYSTEM, &derror);
 684   else
 685     connection = dbus_bus_get (DBUS_BUS_SESSION, &derror);
 686
 687   if (dbus_error_is_set (&derror))
 688     XD_ERROR (derror);
 689
 690   if (connection == NULL)
 691     xsignal2 (Qdbus_error, build_string ("No connection"), bus);
 692
 693   /* Return the result.  */
 694   return connection;
 695 }
 696
 697 DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
 698        1, 1, 0,
 699        doc: /* Return the unique name of Emacs registered at D-Bus BUS.  */)
 700      (bus)
 701      Lisp_Object bus;
 702 {
 703   DBusConnection *connection;
 704   const char *name;
 705
 706   /* Check parameters.  */
 707   CHECK_SYMBOL (bus);
 708
 709   /* Open a connection to the bus.  */
 710   connection = xd_initialize (bus);
 711
 712   /* Request the name.  */
 713   name = dbus_bus_get_unique_name (connection);
 714   if (name == NULL)
 715     xsignal1 (Qdbus_error, build_string ("No unique name available"));
 716
 717   /* Return.  */
 718   return build_string (name);
 719 }
 720
 721 DEFUN ("dbus-call-method", Fdbus_call_method, Sdbus_call_method, 5, MANY, 0,
 722        doc: /* Call METHOD on the D-Bus BUS.
 723
 724 BUS is either the symbol `:system' or the symbol `:session'.
 725
 726 SERVICE is the D-Bus service name to be used.  PATH is the D-Bus
 727 object path SERVICE is registered at.  INTERFACE is an interface
 728 offered by SERVICE.  It must provide METHOD.
 729
 730 If the parameter `:timeout' is given, the following integer TIMEOUT
 731 specifies the maximun number of milliseconds the method call must
 732 return.  The default value is 25.000.  If the method call doesn't
 733 return in time, a D-Bus error is raised.
 734
 735 All other arguments ARGS are passed to METHOD as arguments.  They are
 736 converted into D-Bus types via the following rules:
 737
 738   t and nil => DBUS_TYPE_BOOLEAN
 739   number    => DBUS_TYPE_UINT32
 740   integer   => DBUS_TYPE_INT32
 741   float     => DBUS_TYPE_DOUBLE
 742   string    => DBUS_TYPE_STRING
 743   list      => DBUS_TYPE_ARRAY
 744
 745 All arguments can be preceded by a type symbol.  For details about
 746 type symbols, see Info node `(dbus)Type Conversion'.
 747
 748 `dbus-call-method' returns the resulting values of METHOD as a list of
 749 Lisp objects.  The type conversion happens the other direction as for
 750 input arguments.  It follows the mapping rules:
 751
 752   DBUS_TYPE_BOOLEAN     => t or nil
 753   DBUS_TYPE_BYTE        => number
 754   DBUS_TYPE_UINT16      => number
 755   DBUS_TYPE_INT16       => integer
 756   DBUS_TYPE_UINT32      => number or float
 757   DBUS_TYPE_INT32       => integer or float
 758   DBUS_TYPE_UINT64      => number or float
 759   DBUS_TYPE_INT64       => integer or float
 760   DBUS_TYPE_DOUBLE      => float
 761   DBUS_TYPE_STRING      => string
 762   DBUS_TYPE_OBJECT_PATH => string
 763   DBUS_TYPE_SIGNATURE   => string
 764   DBUS_TYPE_ARRAY       => list
 765   DBUS_TYPE_VARIANT     => list
 766   DBUS_TYPE_STRUCT      => list
 767   DBUS_TYPE_DICT_ENTRY  => list
 768
 769 Example:
 770
 771 \(dbus-call-method
 772   :session "org.gnome.seahorse" "/org/gnome/seahorse/keys/openpgp"
 773   "org.gnome.seahorse.Keys" "GetKeyField"
 774   "openpgp:657984B8C7A966DD" "simple-name")
 775
 776   => (t ("Philip R. Zimmermann"))
 777
 778 If the result of the METHOD call is just one value, the converted Lisp
 779 object is returned instead of a list containing this single Lisp object.
 780
 781 \(dbus-call-method
 782   :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
 783   "org.freedesktop.Hal.Device" "GetPropertyString"
 784   "system.kernel.machine")
 785
 786   => "i686"
 787
 788 usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TIMEOUT &rest ARGS)  */)
 789      (nargs, args)
 790      int nargs;
 791      register Lisp_Object *args;
 792 {
 793   Lisp_Object bus, service, path, interface, method;
 794   Lisp_Object result;
 795   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
 796   DBusConnection *connection;
 797   DBusMessage *dmessage;
 798   DBusMessage *reply;
 799   DBusMessageIter iter;
 800   DBusError derror;
 801   unsigned int dtype;
 802   int timeout = -1;
 803   int i = 5;
 804   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
 805
 806   /* Check parameters.  */
 807   bus = args[0];
 808   service = args[1];
 809   path = args[2];
 810   interface = args[3];
 811   method = args[4];
 812
 813   CHECK_SYMBOL (bus);
 814   CHECK_STRING (service);
 815   CHECK_STRING (path);
 816   CHECK_STRING (interface);
 817   CHECK_STRING (method);
 818   GCPRO5 (bus, service, path, interface, method);
 819
 820   XD_DEBUG_MESSAGE ("%s %s %s %s",
 821                     SDATA (service),
 822                     SDATA (path),
 823                     SDATA (interface),
 824                     SDATA (method));
 825
 826   /* Open a connection to the bus.  */
 827   connection = xd_initialize (bus);
 828
 829   /* Create the message.  */
 830   dmessage = dbus_message_new_method_call (SDATA (service),
 831                                            SDATA (path),
 832                                            SDATA (interface),
 833                                            SDATA (method));
 834   UNGCPRO;
 835   if (dmessage == NULL)
 836     xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
 837
 838   /* Check for timeout parameter.  */
 839   if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
 840     {
 841       CHECK_NATNUM (args[i+1]);
 842       timeout = XUINT (args[i+1]);
 843       i = i+2;
 844     }
 845
 846   /* Initialize parameter list of message.  */
 847   dbus_message_iter_init_append (dmessage, &iter);
 848
 849   /* Append parameters to the message.  */
 850   for (; i < nargs; ++i)
 851     {
 852       dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
 853       if (XD_DBUS_TYPE_P (args[i]))
 854         {
 855           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
 856           XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
 857           XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4,
 858                             SDATA (format2 ("%s", args[i], Qnil)),
 859                             SDATA (format2 ("%s", args[i+1], Qnil)));
 860           ++i;
 861         }
 862       else
 863         {
 864           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
 865           XD_DEBUG_MESSAGE ("Parameter%d %s", i-4,
 866                             SDATA (format2 ("%s", args[i], Qnil)));
 867         }
 868
 869       /* Check for valid signature.  We use DBUS_TYPE_INVALID as
 870          indication that there is no parent type.  */
 871       xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
 872
 873       xd_append_arg (dtype, args[i], &iter);
 874     }
 875
 876   /* Send the message.  */
 877   dbus_error_init (&derror);
 878   reply = dbus_connection_send_with_reply_and_block (connection,
 879                                                      dmessage,
 880                                                      timeout,
 881                                                      &derror);
 882
 883   if (dbus_error_is_set (&derror))
 884     XD_ERROR (derror);
 885
 886   if (reply == NULL)
 887     xsignal1 (Qdbus_error, build_string ("No reply"));
 888
 889   XD_DEBUG_MESSAGE ("Message sent");
 890
 891   /* Collect the results.  */
 892   result = Qnil;
 893   GCPRO1 (result);
 894
 895   if (dbus_message_iter_init (reply, &iter))
 896     {
 897       /* Loop over the parameters of the D-Bus reply message.  Construct a
 898          Lisp list, which is returned by `dbus-call-method'.  */
 899       while ((dtype = dbus_message_iter_get_arg_type (&iter))
 900              != DBUS_TYPE_INVALID)
 901         {
 902           result = Fcons (xd_retrieve_arg (dtype, &iter), result);
 903           dbus_message_iter_next (&iter);
 904         }
 905     }
 906   else
 907     {
 908       /* No arguments: just return nil.  */
 909     }
 910
 911   /* Cleanup.  */
 912   dbus_message_unref (dmessage);
 913   dbus_message_unref (reply);
 914
 915   /* Return the result.  If there is only one single Lisp object,
 916      return it as-it-is, otherwise return the reversed list.  */
 917   if (XUINT (Flength (result)) == 1)
 918     RETURN_UNGCPRO (CAR_SAFE (result));
 919   else
 920     RETURN_UNGCPRO (Fnreverse (result));
 921 }
 922
 923 DEFUN ("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously,
 924        Sdbus_call_method_asynchronously, 6, MANY, 0,
 925        doc: /* Call METHOD on the D-Bus BUS asynchronously.
 926
 927 BUS is either the symbol `:system' or the symbol `:session'.
 928
 929 SERVICE is the D-Bus service name to be used.  PATH is the D-Bus
 930 object path SERVICE is registered at.  INTERFACE is an interface
 931 offered by SERVICE.  It must provide METHOD.
 932
 933 HANDLER is a Lisp function, which is called when the corresponding
 934 return message has arrived.
 935
 936 If the parameter `:timeout' is given, the following integer TIMEOUT
 937 specifies the maximun number of milliseconds the method call must
 938 return.  The default value is 25.000.  If the method call doesn't
 939 return in time, a D-Bus error is raised.
 940
 941 All other arguments ARGS are passed to METHOD as arguments.  They are
 942 converted into D-Bus types via the following rules:
 943
 944   t and nil => DBUS_TYPE_BOOLEAN
 945   number    => DBUS_TYPE_UINT32
 946   integer   => DBUS_TYPE_INT32
 947   float     => DBUS_TYPE_DOUBLE
 948   string    => DBUS_TYPE_STRING
 949   list      => DBUS_TYPE_ARRAY
 950
 951 All arguments can be preceded by a type symbol.  For details about
 952 type symbols, see Info node `(dbus)Type Conversion'.
 953
 954 The function returns a key into the hash table
 955 `dbus-registered-functions-table'.  The corresponding entry in the
 956 hash table is removed, when the return message has been arrived, and
 957 HANDLER is called.
 958
 959 Example:
 960
 961 \(dbus-call-method-asynchronously
 962   :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
 963   "org.freedesktop.Hal.Device" "GetPropertyString" 'message
 964   "system.kernel.machine")
 965
 966   => (:system 2)
 967
 968   -| i686
 969
 970 usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLER &optional :timeout TIMEOUT &rest ARGS)  */)
 971      (nargs, args)
 972      int nargs;
 973      register Lisp_Object *args;
 974 {
 975   Lisp_Object bus, service, path, interface, method, handler;
 976   Lisp_Object result;
 977   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
 978   DBusConnection *connection;
 979   DBusMessage *dmessage;
 980   DBusMessageIter iter;
 981   unsigned int dtype;
 982   int timeout = -1;
 983   int i = 6;
 984   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
 985
 986   /* Check parameters.  */
 987   bus = args[0];
 988   service = args[1];
 989   path = args[2];
 990   interface = args[3];
 991   method = args[4];
 992   handler = args[5];
 993
 994   CHECK_SYMBOL (bus);
 995   CHECK_STRING (service);
 996   CHECK_STRING (path);
 997   CHECK_STRING (interface);
 998   CHECK_STRING (method);
 999   if (!FUNCTIONP (handler))
1000     wrong_type_argument (intern ("functionp"), handler);
1001   GCPRO6 (bus, service, path, interface, method, handler);
1002
1003   XD_DEBUG_MESSAGE ("%s %s %s %s",
1004                     SDATA (service),
1005                     SDATA (path),
1006                     SDATA (interface),
1007                     SDATA (method));
1008
1009   /* Open a connection to the bus.  */
1010   connection = xd_initialize (bus);
1011
1012   /* Create the message.  */
1013   dmessage = dbus_message_new_method_call (SDATA (service),
1014                                            SDATA (path),
1015                                            SDATA (interface),
1016                                            SDATA (method));
1017   if (dmessage == NULL)
1018     xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
1019
1020   /* Check for timeout parameter.  */
1021   if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
1022     {
1023       CHECK_NATNUM (args[i+1]);
1024       timeout = XUINT (args[i+1]);
1025       i = i+2;
1026     }
1027
1028   /* Initialize parameter list of message.  */
1029   dbus_message_iter_init_append (dmessage, &iter);
1030
1031   /* Append parameters to the message.  */
1032   for (; i < nargs; ++i)
1033     {
1034       dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1035       if (XD_DBUS_TYPE_P (args[i]))
1036         {
1037           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1038           XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1039           XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4,
1040                             SDATA (format2 ("%s", args[i], Qnil)),
1041                             SDATA (format2 ("%s", args[i+1], Qnil)));
1042           ++i;
1043         }
1044       else
1045         {
1046           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1047           XD_DEBUG_MESSAGE ("Parameter%d %s", i-4,
1048                             SDATA (format2 ("%s", args[i], Qnil)));
1049         }
1050
1051       /* Check for valid signature.  We use DBUS_TYPE_INVALID as
1052          indication that there is no parent type.  */
1053       xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1054
1055       xd_append_arg (dtype, args[i], &iter);
1056     }
1057
1058   /* Send the message.  The message is just added to the outgoing
1059      message queue.  */
1060   if (!dbus_connection_send_with_reply (connection, dmessage, NULL, timeout))
1061     xsignal1 (Qdbus_error, build_string ("Cannot send message"));
1062
1063   XD_DEBUG_MESSAGE ("Message sent");
1064
1065   /* The result is the key in Vdbus_registered_functions_table.  */
1066   result = (list2 (bus, make_number (dbus_message_get_serial (dmessage))));
1067
1068   /* Create a hash table entry.  */
1069   Fputhash (result, handler, Vdbus_registered_functions_table);
1070
1071   /* Cleanup.  */
1072   dbus_message_unref (dmessage);
1073
1074   /* Return the result.  */
1075   RETURN_UNGCPRO (result);
1076 }
1077
1078 DEFUN ("dbus-method-return-internal", Fdbus_method_return_internal,
1079        Sdbus_method_return_internal,
1080        3, MANY, 0,
1081        doc: /* Return for message SERIAL on the D-Bus BUS.
1082 This is an internal function, it shall not be used outside dbus.el.
1083
1084 usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS)  */)
1085      (nargs, args)
1086      int nargs;
1087      register Lisp_Object *args;
1088 {
1089   Lisp_Object bus, serial, service;
1090   struct gcpro gcpro1, gcpro2, gcpro3;
1091   DBusConnection *connection;
1092   DBusMessage *dmessage;
1093   DBusMessageIter iter;
1094   unsigned int dtype;
1095   int i;
1096   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1097
1098   /* Check parameters.  */
1099   bus = args[0];
1100   serial = args[1];
1101   service = args[2];
1102
1103   CHECK_SYMBOL (bus);
1104   CHECK_NUMBER (serial);
1105   CHECK_STRING (service);
1106   GCPRO3 (bus, serial, service);
1107
1108   XD_DEBUG_MESSAGE ("%d %s ", XUINT (serial), SDATA (service));
1109
1110   /* Open a connection to the bus.  */
1111   connection = xd_initialize (bus);
1112
1113   /* Create the message.  */
1114   dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_METHOD_RETURN);
1115   if ((dmessage == NULL)
1116       || (!dbus_message_set_reply_serial (dmessage, XUINT (serial)))
1117       || (!dbus_message_set_destination (dmessage, SDATA (service))))
1118     {
1119       UNGCPRO;
1120       xsignal1 (Qdbus_error,
1121                 build_string ("Unable to create a return message"));
1122     }
1123
1124   UNGCPRO;
1125
1126   /* Initialize parameter list of message.  */
1127   dbus_message_iter_init_append (dmessage, &iter);
1128
1129   /* Append parameters to the message.  */
1130   for (i = 3; i < nargs; ++i)
1131     {
1132       dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1133       if (XD_DBUS_TYPE_P (args[i]))
1134         {
1135           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1136           XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1137           XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-2,
1138                             SDATA (format2 ("%s", args[i], Qnil)),
1139                             SDATA (format2 ("%s", args[i+1], Qnil)));
1140           ++i;
1141         }
1142       else
1143         {
1144           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1145           XD_DEBUG_MESSAGE ("Parameter%d %s", i-2,
1146                             SDATA (format2 ("%s", args[i], Qnil)));
1147         }
1148
1149       /* Check for valid signature.  We use DBUS_TYPE_INVALID as
1150          indication that there is no parent type.  */
1151       xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1152
1153       xd_append_arg (dtype, args[i], &iter);
1154     }
1155
1156   /* Send the message.  The message is just added to the outgoing
1157      message queue.  */
1158   if (!dbus_connection_send (connection, dmessage, NULL))
1159     xsignal1 (Qdbus_error, build_string ("Cannot send message"));
1160
1161   /* Flush connection to ensure the message is handled.  */
1162   dbus_connection_flush (connection);
1163
1164   XD_DEBUG_MESSAGE ("Message sent");
1165
1166   /* Cleanup.  */
1167   dbus_message_unref (dmessage);
1168
1169   /* Return.  */
1170   return Qt;
1171 }
1172
1173 DEFUN ("dbus-method-error-internal", Fdbus_method_error_internal,
1174        Sdbus_method_error_internal,
1175        3, MANY, 0,
1176        doc: /* Return error message for message SERIAL on the D-Bus BUS.
1177 This is an internal function, it shall not be used outside dbus.el.
1178
1179 usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS)  */)
1180      (nargs, args)
1181      int nargs;
1182      register Lisp_Object *args;
1183 {
1184   Lisp_Object bus, serial, service;
1185   struct gcpro gcpro1, gcpro2, gcpro3;
1186   DBusConnection *connection;
1187   DBusMessage *dmessage;
1188   DBusMessageIter iter;
1189   unsigned int dtype;
1190   int i;
1191   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1192
1193   /* Check parameters.  */
1194   bus = args[0];
1195   serial = args[1];
1196   service = args[2];
1197
1198   CHECK_SYMBOL (bus);
1199   CHECK_NUMBER (serial);
1200   CHECK_STRING (service);
1201   GCPRO3 (bus, serial, service);
1202
1203   XD_DEBUG_MESSAGE ("%d %s ", XUINT (serial), SDATA (service));
1204
1205   /* Open a connection to the bus.  */
1206   connection = xd_initialize (bus);
1207
1208   /* Create the message.  */
1209   dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_ERROR);
1210   if ((dmessage == NULL)
1211       || (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED))
1212       || (!dbus_message_set_reply_serial (dmessage, XUINT (serial)))
1213       || (!dbus_message_set_destination (dmessage, SDATA (service))))
1214     {
1215       UNGCPRO;
1216       xsignal1 (Qdbus_error,
1217                 build_string ("Unable to create a error message"));
1218     }
1219
1220   UNGCPRO;
1221
1222   /* Initialize parameter list of message.  */
1223   dbus_message_iter_init_append (dmessage, &iter);
1224
1225   /* Append parameters to the message.  */
1226   for (i = 3; i < nargs; ++i)
1227     {
1228       dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1229       if (XD_DBUS_TYPE_P (args[i]))
1230         {
1231           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1232           XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1233           XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-2,
1234                             SDATA (format2 ("%s", args[i], Qnil)),
1235                             SDATA (format2 ("%s", args[i+1], Qnil)));
1236           ++i;
1237         }
1238       else
1239         {
1240           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1241           XD_DEBUG_MESSAGE ("Parameter%d %s", i-2,
1242                             SDATA (format2 ("%s", args[i], Qnil)));
1243         }
1244
1245       /* Check for valid signature.  We use DBUS_TYPE_INVALID as
1246          indication that there is no parent type.  */
1247       xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1248
1249       xd_append_arg (dtype, args[i], &iter);
1250     }
1251
1252   /* Send the message.  The message is just added to the outgoing
1253      message queue.  */
1254   if (!dbus_connection_send (connection, dmessage, NULL))
1255     xsignal1 (Qdbus_error, build_string ("Cannot send message"));
1256
1257   /* Flush connection to ensure the message is handled.  */
1258   dbus_connection_flush (connection);
1259
1260   XD_DEBUG_MESSAGE ("Message sent");
1261
1262   /* Cleanup.  */
1263   dbus_message_unref (dmessage);
1264
1265   /* Return.  */
1266   return Qt;
1267 }
1268
1269 DEFUN ("dbus-send-signal", Fdbus_send_signal, Sdbus_send_signal, 5, MANY, 0,
1270        doc: /* Send signal SIGNAL on the D-Bus BUS.
1271
1272 BUS is either the symbol `:system' or the symbol `:session'.
1273
1274 SERVICE is the D-Bus service name SIGNAL is sent from.  PATH is the
1275 D-Bus object path SERVICE is registered at.  INTERFACE is an interface
1276 offered by SERVICE.  It must provide signal SIGNAL.
1277
1278 All other arguments ARGS are passed to SIGNAL as arguments.  They are
1279 converted into D-Bus types via the following rules:
1280
1281   t and nil => DBUS_TYPE_BOOLEAN
1282   number    => DBUS_TYPE_UINT32
1283   integer   => DBUS_TYPE_INT32
1284   float     => DBUS_TYPE_DOUBLE
1285   string    => DBUS_TYPE_STRING
1286   list      => DBUS_TYPE_ARRAY
1287
1288 All arguments can be preceded by a type symbol.  For details about
1289 type symbols, see Info node `(dbus)Type Conversion'.
1290
1291 Example:
1292
1293 \(dbus-send-signal
1294   :session "org.gnu.Emacs" "/org/gnu/Emacs"
1295   "org.gnu.Emacs.FileManager" "FileModified" "/home/albinus/.emacs")
1296
1297 usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)  */)
1298      (nargs, args)
1299      int nargs;
1300      register Lisp_Object *args;
1301 {
1302   Lisp_Object bus, service, path, interface, signal;
1303   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
1304   DBusConnection *connection;
1305   DBusMessage *dmessage;
1306   DBusMessageIter iter;
1307   unsigned int dtype;
1308   int i;
1309   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1310
1311   /* Check parameters.  */
1312   bus = args[0];
1313   service = args[1];
1314   path = args[2];
1315   interface = args[3];
1316   signal = args[4];
1317
1318   CHECK_SYMBOL (bus);
1319   CHECK_STRING (service);
1320   CHECK_STRING (path);
1321   CHECK_STRING (interface);
1322   CHECK_STRING (signal);
1323   GCPRO5 (bus, service, path, interface, signal);
1324
1325   XD_DEBUG_MESSAGE ("%s %s %s %s",
1326                     SDATA (service),
1327                     SDATA (path),
1328                     SDATA (interface),
1329                     SDATA (signal));
1330
1331   /* Open a connection to the bus.  */
1332   connection = xd_initialize (bus);
1333
1334   /* Create the message.  */
1335   dmessage = dbus_message_new_signal (SDATA (path),
1336                                       SDATA (interface),
1337                                       SDATA (signal));
1338   UNGCPRO;
1339   if (dmessage == NULL)
1340     xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
1341
1342   /* Initialize parameter list of message.  */
1343   dbus_message_iter_init_append (dmessage, &iter);
1344
1345   /* Append parameters to the message.  */
1346   for (i = 5; i < nargs; ++i)
1347     {
1348       dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1349       if (XD_DBUS_TYPE_P (args[i]))
1350         {
1351           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1352           XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1353           XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4,
1354                             SDATA (format2 ("%s", args[i], Qnil)),
1355                             SDATA (format2 ("%s", args[i+1], Qnil)));
1356           ++i;
1357         }
1358       else
1359         {
1360           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1361           XD_DEBUG_MESSAGE ("Parameter%d %s", i-4,
1362                             SDATA (format2 ("%s", args[i], Qnil)));
1363         }
1364
1365       /* Check for valid signature.  We use DBUS_TYPE_INVALID as
1366          indication that there is no parent type.  */
1367       xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1368
1369       xd_append_arg (dtype, args[i], &iter);
1370     }
1371
1372   /* Send the message.  The message is just added to the outgoing
1373      message queue.  */
1374   if (!dbus_connection_send (connection, dmessage, NULL))
1375     xsignal1 (Qdbus_error, build_string ("Cannot send message"));
1376
1377   /* Flush connection to ensure the message is handled.  */
1378   dbus_connection_flush (connection);
1379
1380   XD_DEBUG_MESSAGE ("Signal sent");
1381
1382   /* Cleanup.  */
1383   dbus_message_unref (dmessage);
1384
1385   /* Return.  */
1386   return Qt;
1387 }
1388
1389 /* Read queued incoming message of the D-Bus BUS.  BUS is a Lisp
1390    symbol, either :system or :session.  */
1391 Lisp_Object
1392 xd_read_message (bus)
1393      Lisp_Object bus;
1394 {
1395   Lisp_Object args, key, value;
1396   struct gcpro gcpro1;
1397   struct input_event event;
1398   DBusConnection *connection;
1399   DBusMessage *dmessage;
1400   DBusMessageIter iter;
1401   unsigned int dtype;
1402   int mtype, serial;
1403   const char *uname, *path, *interface, *member;
1404
1405   /* Open a connection to the bus.  */
1406   connection = xd_initialize (bus);
1407
1408   /* Non blocking read of the next available message.  */
1409   dbus_connection_read_write (connection, 0);
1410   dmessage = dbus_connection_pop_message (connection);
1411
1412   /* Return if there is no queued message.  */
1413   if (dmessage == NULL)
1414     return Qnil;
1415
1416   /* Collect the parameters.  */
1417   args = Qnil;
1418   GCPRO1 (args);
1419
1420   /* Loop over the resulting parameters.  Construct a list.  */
1421   if (dbus_message_iter_init (dmessage, &iter))
1422     {
1423       while ((dtype = dbus_message_iter_get_arg_type (&iter))
1424              != DBUS_TYPE_INVALID)
1425         {
1426           args = Fcons (xd_retrieve_arg (dtype, &iter), args);
1427           dbus_message_iter_next (&iter);
1428         }
1429       /* The arguments are stored in reverse order.  Reorder them.  */
1430       args = Fnreverse (args);
1431     }
1432
1433   /* Read message type, message serial, unique name, object path,
1434      interface and member from the message.  */
1435   mtype = dbus_message_get_type (dmessage);
1436   serial =
1437     ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1438      || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1439     ? dbus_message_get_reply_serial (dmessage)
1440     : dbus_message_get_serial (dmessage);
1441   uname = dbus_message_get_sender (dmessage);
1442   path = dbus_message_get_path (dmessage);
1443   interface = dbus_message_get_interface (dmessage);
1444   member = dbus_message_get_member (dmessage);
1445
1446   XD_DEBUG_MESSAGE ("Event received: %s %d %s %s %s %s %s",
1447                     (mtype == DBUS_MESSAGE_TYPE_INVALID)
1448                     ? "DBUS_MESSAGE_TYPE_INVALID"
1449                     : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1450                     ? "DBUS_MESSAGE_TYPE_METHOD_CALL"
1451                     : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1452                     ? "DBUS_MESSAGE_TYPE_METHOD_RETURN"
1453                     : (mtype == DBUS_MESSAGE_TYPE_ERROR)
1454                     ? "DBUS_MESSAGE_TYPE_ERROR"
1455                     : "DBUS_MESSAGE_TYPE_SIGNAL",
1456                     serial, uname, path, interface, member,
1457                     SDATA (format2 ("%s", args, Qnil)));
1458
1459   if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1460       || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1461     {
1462       /* Search for a registered function of the message.  */
1463       key = list2 (bus, make_number (serial));
1464       value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
1465
1466       /* There shall be exactly one entry.  Construct an event.  */
1467       if (NILP (value))
1468         goto cleanup;
1469
1470       /* Remove the entry.  */
1471       Fremhash (key, Vdbus_registered_functions_table);
1472
1473       /* Construct an event.  */
1474       EVENT_INIT (event);
1475       event.kind = DBUS_EVENT;
1476       event.frame_or_window = Qnil;
1477       event.arg = Fcons (value, args);
1478     }
1479
1480   else /* (mtype != DBUS_MESSAGE_TYPE_METHOD_RETURN)  */
1481     {
1482       /* Vdbus_registered_functions_table requires non-nil interface
1483          and member.  */
1484       if ((interface == NULL) || (member == NULL))
1485         goto cleanup;
1486
1487       /* Search for a registered function of the message.  */
1488       key = list3 (bus, build_string (interface), build_string (member));
1489       value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
1490
1491       /* Loop over the registered functions.  Construct an event.  */
1492       while (!NILP (value))
1493         {
1494           key = CAR_SAFE (value);
1495           /* key has the structure (UNAME SERVICE PATH HANDLER).  */
1496           if (((uname == NULL)
1497                || (NILP (CAR_SAFE (key)))
1498                || (strcmp (uname, SDATA (CAR_SAFE (key))) == 0))
1499               && ((path == NULL)
1500                   || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1501                   || (strcmp (path,
1502                               SDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1503                       == 0))
1504               && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))))))
1505             {
1506               EVENT_INIT (event);
1507               event.kind = DBUS_EVENT;
1508               event.frame_or_window = Qnil;
1509               event.arg = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))),
1510                                  args);
1511               break;
1512             }
1513           value = CDR_SAFE (value);
1514         }
1515
1516       if (NILP (value))
1517         goto cleanup;
1518     }
1519
1520   /* Add type, serial, uname, path, interface and member to the event.  */
1521   event.arg = Fcons ((member == NULL ? Qnil : build_string (member)),
1522                      event.arg);
1523   event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)),
1524                      event.arg);
1525   event.arg = Fcons ((path == NULL ? Qnil : build_string (path)),
1526                      event.arg);
1527   event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)),
1528                      event.arg);
1529   event.arg = Fcons (make_number (serial), event.arg);
1530   event.arg = Fcons (make_number (mtype), event.arg);
1531
1532   /* Add the bus symbol to the event.  */
1533   event.arg = Fcons (bus, event.arg);
1534
1535   /* Store it into the input event queue.  */
1536   kbd_buffer_store_event (&event);
1537
1538   XD_DEBUG_MESSAGE ("Event stored: %s",
1539                     SDATA (format2 ("%s", event.arg, Qnil)));
1540
1541  cleanup:
1542   dbus_message_unref (dmessage);
1543   RETURN_UNGCPRO (Qnil);
1544 }
1545
1546 /* Read queued incoming messages from the system and session buses.  */
1547 void
1548 xd_read_queued_messages ()
1549 {
1550
1551   /* Vdbus_registered_functions_table will be initialized as hash
1552      table in dbus.el.  When this package isn't loaded yet, it doesn't
1553      make sense to handle D-Bus messages.  Furthermore, we ignore all
1554      Lisp errors during the call.  */
1555   if (HASH_TABLE_P (Vdbus_registered_functions_table))
1556     {
1557       internal_condition_case_1 (xd_read_message, QCdbus_system_bus,
1558                                  Qerror, Fidentity);
1559       internal_condition_case_1 (xd_read_message, QCdbus_session_bus,
1560                                  Qerror, Fidentity);
1561     }
1562 }
1563
1564 DEFUN ("dbus-register-signal", Fdbus_register_signal, Sdbus_register_signal,
1565        6, MANY, 0,
1566        doc: /* Register for signal SIGNAL on the D-Bus BUS.
1567
1568 BUS is either the symbol `:system' or the symbol `:session'.
1569
1570 SERVICE is the D-Bus service name used by the sending D-Bus object.
1571 It can be either a known name or the unique name of the D-Bus object
1572 sending the signal.  When SERVICE is nil, related signals from all
1573 D-Bus objects shall be accepted.
1574
1575 PATH is the D-Bus object path SERVICE is registered.  It can also be
1576 nil if the path name of incoming signals shall not be checked.
1577
1578 INTERFACE is an interface offered by SERVICE.  It must provide SIGNAL.
1579 HANDLER is a Lisp function to be called when the signal is received.
1580 It must accept as arguments the values SIGNAL is sending.
1581
1582 All other arguments ARGS, if specified, must be strings.  They stand
1583 for the respective arguments of the signal in their order, and are
1584 used for filtering as well.  A nil argument might be used to preserve
1585 the order.
1586
1587 INTERFACE, SIGNAL and HANDLER must not be nil.  Example:
1588
1589 \(defun my-signal-handler (device)
1590   (message "Device %s added" device))
1591
1592 \(dbus-register-signal
1593   :system "org.freedesktop.Hal" "/org/freedesktop/Hal/Manager"
1594   "org.freedesktop.Hal.Manager" "DeviceAdded" 'my-signal-handler)
1595
1596   => ((:system "org.freedesktop.Hal.Manager" "DeviceAdded")
1597       ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager" my-signal-handler))
1598
1599 `dbus-register-signal' returns an object, which can be used in
1600 `dbus-unregister-object' for removing the registration.
1601
1602 usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARGS) */)
1603      (nargs, args)
1604      int nargs;
1605      register Lisp_Object *args;
1606 {
1607   Lisp_Object bus, service, path, interface, signal, handler;
1608   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1609   Lisp_Object uname, key, key1, value;
1610   DBusConnection *connection;
1611   int i;
1612   char rule[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
1613   char x[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
1614   DBusError derror;
1615
1616   /* Check parameters.  */
1617   bus = args[0];
1618   service = args[1];
1619   path = args[2];
1620   interface = args[3];
1621   signal = args[4];
1622   handler = args[5];
1623
1624   CHECK_SYMBOL (bus);
1625   if (!NILP (service)) CHECK_STRING (service);
1626   if (!NILP (path)) CHECK_STRING (path);
1627   CHECK_STRING (interface);
1628   CHECK_STRING (signal);
1629   if (!FUNCTIONP (handler))
1630     wrong_type_argument (intern ("functionp"), handler);
1631   GCPRO6 (bus, service, path, interface, signal, handler);
1632
1633   /* Retrieve unique name of service.  If service is a known name, we
1634      will register for the corresponding unique name, if any.  Signals
1635      are sent always with the unique name as sender.  Note: the unique
1636      name of "org.freedesktop.DBus" is that string itself.  */
1637   if ((STRINGP (service))
1638       && (SBYTES (service) > 0)
1639       && (strcmp (SDATA (service), DBUS_SERVICE_DBUS) != 0)
1640       && (strncmp (SDATA (service), ":", 1) != 0))
1641     {
1642       uname = call2 (intern ("dbus-get-name-owner"), bus, service);
1643       /* When there is no unique name, we mark it with an empty
1644          string.  */
1645       if (NILP (uname))
1646         uname = build_string ("");
1647     }
1648   else
1649     uname = service;
1650
1651   /* Create a matching rule if the unique name exists (when no
1652      wildcard).  */
1653   if (NILP (uname) || (SBYTES (uname) > 0))
1654     {
1655       /* Open a connection to the bus.  */
1656       connection = xd_initialize (bus);
1657
1658       /* Create a rule to receive related signals.  */
1659       sprintf (rule,
1660                "type='signal',interface='%s',member='%s'",
1661                SDATA (interface),
1662                SDATA (signal));
1663
1664       /* Add unique name and path to the rule if they are non-nil.  */
1665       if (!NILP (uname))
1666         {
1667           sprintf (x, ",sender='%s'", SDATA (uname));
1668           strcat (rule, x);
1669         }
1670
1671       if (!NILP (path))
1672         {
1673           sprintf (x, ",path='%s'", SDATA (path));
1674           strcat (rule, x);
1675         }
1676
1677       /* Add arguments to the rule if they are non-nil.  */
1678       for (i = 6; i < nargs; ++i)
1679         if (!NILP (args[i]))
1680           {
1681             CHECK_STRING (args[i]);
1682             sprintf (x, ",arg%d='%s'", i-6, SDATA (args[i]));
1683             strcat (rule, x);
1684           }
1685
1686       /* Add the rule to the bus.  */
1687       dbus_error_init (&derror);
1688       dbus_bus_add_match (connection, rule, &derror);
1689       if (dbus_error_is_set (&derror))
1690         {
1691           UNGCPRO;
1692           XD_ERROR (derror);
1693         }
1694
1695       XD_DEBUG_MESSAGE ("Matching rule \"%s\" created", rule);
1696     }
1697
1698   /* Create a hash table entry.  */
1699   key = list3 (bus, interface, signal);
1700   key1 = list4 (uname, service, path, handler);
1701   value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
1702
1703   if (NILP (Fmember (key1, value)))
1704     Fputhash (key, Fcons (key1, value), Vdbus_registered_functions_table);
1705
1706   /* Return object.  */
1707   RETURN_UNGCPRO (list2 (key, list3 (service, path, handler)));
1708 }
1709
1710 DEFUN ("dbus-register-method", Fdbus_register_method, Sdbus_register_method,
1711        6, 6, 0,
1712        doc: /* Register for method METHOD on the D-Bus BUS.
1713
1714 BUS is either the symbol `:system' or the symbol `:session'.
1715
1716 SERVICE is the D-Bus service name of the D-Bus object METHOD is
1717 registered for.  It must be a known name.
1718
1719 PATH is the D-Bus object path SERVICE is registered.  INTERFACE is the
1720 interface offered by SERVICE.  It must provide METHOD.  HANDLER is a
1721 Lisp function to be called when a method call is received.  It must
1722 accept the input arguments of METHOD.  The return value of HANDLER is
1723 used for composing the returning D-Bus message.  */)
1724      (bus, service, path, interface, method, handler)
1725      Lisp_Object bus, service, path, interface, method, handler;
1726 {
1727   Lisp_Object key, key1, value;
1728   DBusConnection *connection;
1729   int result;
1730   DBusError derror;
1731
1732   /* Check parameters.  */
1733   CHECK_SYMBOL (bus);
1734   CHECK_STRING (service);
1735   CHECK_STRING (path);
1736   CHECK_STRING (interface);
1737   CHECK_STRING (method);
1738   if (!FUNCTIONP (handler))
1739     wrong_type_argument (intern ("functionp"), handler);
1740   /* TODO: We must check for a valid service name, otherwise there is
1741      a segmentation fault.  */
1742
1743   /* Open a connection to the bus.  */
1744   connection = xd_initialize (bus);
1745
1746   /* Request the known name from the bus.  We can ignore the result,
1747      it is set to -1 if there is an error - kind of redundancy.  */
1748   dbus_error_init (&derror);
1749   result = dbus_bus_request_name (connection, SDATA (service), 0, &derror);
1750   if (dbus_error_is_set (&derror))
1751     XD_ERROR (derror);
1752
1753   /* Create a hash table entry.  */
1754   key = list3 (bus, interface, method);
1755   key1 = list4 (Qnil, service, path, handler);
1756   value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
1757
1758   /* We use nil for the unique name, because the method might be
1759      called from everybody.  */
1760   if (NILP (Fmember (key1, value)))
1761     Fputhash (key, Fcons (key1, value), Vdbus_registered_functions_table);
1762
1763   /* Return object.  */
1764   return list2 (key, list3 (service, path, handler));
1765 }
1766
1767 \f
1768 void
1769 syms_of_dbusbind ()
1770 {
1771
1772   Qdbus_get_unique_name = intern ("dbus-get-unique-name");
1773   staticpro (&Qdbus_get_unique_name);
1774   defsubr (&Sdbus_get_unique_name);
1775
1776   Qdbus_call_method = intern ("dbus-call-method");
1777   staticpro (&Qdbus_call_method);
1778   defsubr (&Sdbus_call_method);
1779
1780   Qdbus_call_method_asynchronously = intern ("dbus-call-method-asynchronously");
1781   staticpro (&Qdbus_call_method_asynchronously);
1782   defsubr (&Sdbus_call_method_asynchronously);
1783
1784   Qdbus_method_return_internal = intern ("dbus-method-return-internal");
1785   staticpro (&Qdbus_method_return_internal);
1786   defsubr (&Sdbus_method_return_internal);
1787
1788   Qdbus_method_error_internal = intern ("dbus-method-error-internal");
1789   staticpro (&Qdbus_method_error_internal);
1790   defsubr (&Sdbus_method_error_internal);
1791
1792   Qdbus_send_signal = intern ("dbus-send-signal");
1793   staticpro (&Qdbus_send_signal);
1794   defsubr (&Sdbus_send_signal);
1795
1796   Qdbus_register_signal = intern ("dbus-register-signal");
1797   staticpro (&Qdbus_register_signal);
1798   defsubr (&Sdbus_register_signal);
1799
1800   Qdbus_register_method = intern ("dbus-register-method");
1801   staticpro (&Qdbus_register_method);
1802   defsubr (&Sdbus_register_method);
1803
1804   Qdbus_error = intern ("dbus-error");
1805   staticpro (&Qdbus_error);
1806   Fput (Qdbus_error, Qerror_conditions,
1807         list2 (Qdbus_error, Qerror));
1808   Fput (Qdbus_error, Qerror_message,
1809         build_string ("D-Bus error"));
1810
1811   QCdbus_system_bus = intern (":system");
1812   staticpro (&QCdbus_system_bus);
1813
1814   QCdbus_session_bus = intern (":session");
1815   staticpro (&QCdbus_session_bus);
1816
1817   QCdbus_timeout = intern (":timeout");
1818   staticpro (&QCdbus_timeout);
1819
1820   QCdbus_type_byte = intern (":byte");
1821   staticpro (&QCdbus_type_byte);
1822
1823   QCdbus_type_boolean = intern (":boolean");
1824   staticpro (&QCdbus_type_boolean);
1825
1826   QCdbus_type_int16 = intern (":int16");
1827   staticpro (&QCdbus_type_int16);
1828
1829   QCdbus_type_uint16 = intern (":uint16");
1830   staticpro (&QCdbus_type_uint16);
1831
1832   QCdbus_type_int32 = intern (":int32");
1833   staticpro (&QCdbus_type_int32);
1834
1835   QCdbus_type_uint32 = intern (":uint32");
1836   staticpro (&QCdbus_type_uint32);
1837
1838   QCdbus_type_int64 = intern (":int64");
1839   staticpro (&QCdbus_type_int64);
1840
1841   QCdbus_type_uint64 = intern (":uint64");
1842   staticpro (&QCdbus_type_uint64);
1843
1844   QCdbus_type_double = intern (":double");
1845   staticpro (&QCdbus_type_double);
1846
1847   QCdbus_type_string = intern (":string");
1848   staticpro (&QCdbus_type_string);
1849
1850   QCdbus_type_object_path = intern (":object-path");
1851   staticpro (&QCdbus_type_object_path);
1852
1853   QCdbus_type_signature = intern (":signature");
1854   staticpro (&QCdbus_type_signature);
1855
1856   QCdbus_type_array = intern (":array");
1857   staticpro (&QCdbus_type_array);
1858
1859   QCdbus_type_variant = intern (":variant");
1860   staticpro (&QCdbus_type_variant);
1861
1862   QCdbus_type_struct = intern (":struct");
1863   staticpro (&QCdbus_type_struct);
1864
1865   QCdbus_type_dict_entry = intern (":dict-entry");
1866   staticpro (&QCdbus_type_dict_entry);
1867
1868   DEFVAR_LISP ("dbus-registered-functions-table",
1869                &Vdbus_registered_functions_table,
1870     doc: /* Hash table of registered functions for D-Bus.
1871 There are two different uses of the hash table: for calling registered
1872 functions, targeted by signals or method calls, and for calling
1873 handlers in case of non-blocking method call returns.
1874
1875 In the first case, the key in the hash table is the list (BUS
1876 INTERFACE MEMBER).  BUS is either the symbol `:system' or the symbol
1877 `:session'.  INTERFACE is a string which denotes a D-Bus interface,
1878 and MEMBER, also a string, is either a method or a signal INTERFACE is
1879 offering.  All arguments but BUS must not be nil.
1880
1881 The value in the hash table is a list of quadruple lists
1882 \((UNAME SERVICE PATH HANDLER) (UNAME SERVICE PATH HANDLER) ...).
1883 SERVICE is the service name as registered, UNAME is the corresponding
1884 unique name.  PATH is the object path of the sending object.  All of
1885 them can be nil, which means a wildcard then.  HANDLER is the function
1886 to be called when a D-Bus message, which matches the key criteria,
1887 arrives.
1888
1889 In the second case, the key in the hash table is the list (BUS SERIAL).
1890 BUS is either the symbol `:system' or the symbol `:session'.  SERIAL
1891 is the serial number of the non-blocking method call, a reply is
1892 expected.  Both arguments must not be nil.  The value in the hash
1893 table is HANDLER, the function to be called when the D-Bus reply
1894 message arrives.  */);
1895   /* We initialize Vdbus_registered_functions_table in dbus.el,
1896      because we need to define a hash table function first.  */
1897   Vdbus_registered_functions_table = Qnil;
1898
1899   DEFVAR_LISP ("dbus-debug", &Vdbus_debug,
1900     doc: /* If non-nil, debug messages of D-Bus bindings are raised.  */);
1901 #ifdef DBUS_DEBUG
1902   Vdbus_debug = Qt;
1903 #else
1904   Vdbus_debug = Qnil;
1905 #endif
1906
1907   Fprovide (intern ("dbusbind"), Qnil);
1908
1909 }
1910
1911 #endif /* HAVE_DBUS */
1912
1913 /* arch-tag: 0e828477-b571-4fe4-b559-5c9211bc14b8
1914    (do not change this comment) */