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       sprintf (signature, "%s%c", signature, DBUS_STRUCT_END_CHAR);
 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       sprintf (signature, "%s%c", signature, DBUS_DICT_ENTRY_END_CHAR);
 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
 789          BUS SERVICE PATH INTERFACE METHOD
 790          &optional :timeout TIMEOUT &rest ARGS)  */)
 791      (nargs, args)
 792      int nargs;
 793      register Lisp_Object *args;
 794 {
 795   Lisp_Object bus, service, path, interface, method;
 796   Lisp_Object result;
 797   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
 798   DBusConnection *connection;
 799   DBusMessage *dmessage;
 800   DBusMessage *reply;
 801   DBusMessageIter iter;
 802   DBusError derror;
 803   unsigned int dtype;
 804   int timeout = -1;
 805   int i = 5;
 806   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
 807
 808   /* Check parameters.  */
 809   bus = args[0];
 810   service = args[1];
 811   path = args[2];
 812   interface = args[3];
 813   method = args[4];
 814
 815   CHECK_SYMBOL (bus);
 816   CHECK_STRING (service);
 817   CHECK_STRING (path);
 818   CHECK_STRING (interface);
 819   CHECK_STRING (method);
 820   GCPRO5 (bus, service, path, interface, method);
 821
 822   XD_DEBUG_MESSAGE ("%s %s %s %s",
 823                     SDATA (service),
 824                     SDATA (path),
 825                     SDATA (interface),
 826                     SDATA (method));
 827
 828   /* Open a connection to the bus.  */
 829   connection = xd_initialize (bus);
 830
 831   /* Create the message.  */
 832   dmessage = dbus_message_new_method_call (SDATA (service),
 833                                            SDATA (path),
 834                                            SDATA (interface),
 835                                            SDATA (method));
 836   UNGCPRO;
 837   if (dmessage == NULL)
 838     xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
 839
 840   /* Check for timeout parameter.  */
 841   if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
 842     {
 843       CHECK_NATNUM (args[i+1]);
 844       timeout = XUINT (args[i+1]);
 845       i = i+2;
 846     }
 847
 848   /* Initialize parameter list of message.  */
 849   dbus_message_iter_init_append (dmessage, &iter);
 850
 851   /* Append parameters to the message.  */
 852   for (; i < nargs; ++i)
 853     {
 854       dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
 855       if (XD_DBUS_TYPE_P (args[i]))
 856         {
 857           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
 858           XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
 859           XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4,
 860                             SDATA (format2 ("%s", args[i], Qnil)),
 861                             SDATA (format2 ("%s", args[i+1], Qnil)));
 862           ++i;
 863         }
 864       else
 865         {
 866           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
 867           XD_DEBUG_MESSAGE ("Parameter%d %s", i-4,
 868                             SDATA (format2 ("%s", args[i], Qnil)));
 869         }
 870
 871       /* Check for valid signature.  We use DBUS_TYPE_INVALID as
 872          indication that there is no parent type.  */
 873       xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
 874
 875       xd_append_arg (dtype, args[i], &iter);
 876     }
 877
 878   /* Send the message.  */
 879   dbus_error_init (&derror);
 880   reply = dbus_connection_send_with_reply_and_block (connection,
 881                                                      dmessage,
 882                                                      timeout,
 883                                                      &derror);
 884
 885   if (dbus_error_is_set (&derror))
 886     XD_ERROR (derror);
 887
 888   if (reply == NULL)
 889     xsignal1 (Qdbus_error, build_string ("No reply"));
 890
 891   XD_DEBUG_MESSAGE ("Message sent");
 892
 893   /* Collect the results.  */
 894   result = Qnil;
 895   GCPRO1 (result);
 896
 897   if (dbus_message_iter_init (reply, &iter))
 898     {
 899       /* Loop over the parameters of the D-Bus reply message.  Construct a
 900          Lisp list, which is returned by `dbus-call-method'.  */
 901       while ((dtype = dbus_message_iter_get_arg_type (&iter))
 902              != DBUS_TYPE_INVALID)
 903         {
 904           result = Fcons (xd_retrieve_arg (dtype, &iter), result);
 905           dbus_message_iter_next (&iter);
 906         }
 907     }
 908   else
 909     {
 910       /* No arguments: just return nil.  */
 911     }
 912
 913   /* Cleanup.  */
 914   dbus_message_unref (dmessage);
 915   dbus_message_unref (reply);
 916
 917   /* Return the result.  If there is only one single Lisp object,
 918      return it as-it-is, otherwise return the reversed list.  */
 919   if (XUINT (Flength (result)) == 1)
 920     RETURN_UNGCPRO (CAR_SAFE (result));
 921   else
 922     RETURN_UNGCPRO (Fnreverse (result));
 923 }
 924
 925 DEFUN ("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously,
 926        Sdbus_call_method_asynchronously, 6, MANY, 0,
 927        doc: /* Call METHOD on the D-Bus BUS asynchronously.
 928
 929 BUS is either the symbol `:system' or the symbol `:session'.
 930
 931 SERVICE is the D-Bus service name to be used.  PATH is the D-Bus
 932 object path SERVICE is registered at.  INTERFACE is an interface
 933 offered by SERVICE.  It must provide METHOD.
 934
 935 HANDLER is a Lisp function, which is called when the corresponding
 936 return message has arrived.
 937
 938 If the parameter `:timeout' is given, the following integer TIMEOUT
 939 specifies the maximun number of milliseconds the method call must
 940 return.  The default value is 25.000.  If the method call doesn't
 941 return in time, a D-Bus error is raised.
 942
 943 All other arguments ARGS are passed to METHOD as arguments.  They are
 944 converted into D-Bus types via the following rules:
 945
 946   t and nil => DBUS_TYPE_BOOLEAN
 947   number    => DBUS_TYPE_UINT32
 948   integer   => DBUS_TYPE_INT32
 949   float     => DBUS_TYPE_DOUBLE
 950   string    => DBUS_TYPE_STRING
 951   list      => DBUS_TYPE_ARRAY
 952
 953 All arguments can be preceded by a type symbol.  For details about
 954 type symbols, see Info node `(dbus)Type Conversion'.
 955
 956 The function returns a key into the hash table
 957 `dbus-registered-functions-table'.  The corresponding entry in the
 958 hash table is removed, when the return message has been arrived, and
 959 HANDLER is called.
 960
 961 Example:
 962
 963 \(dbus-call-method-asynchronously
 964   :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
 965   "org.freedesktop.Hal.Device" "GetPropertyString" 'message
 966   "system.kernel.machine")
 967
 968   => (:system 2)
 969
 970   -| i686
 971
 972 usage: (dbus-call-method-asynchronously
 973          BUS SERVICE PATH INTERFACE METHOD HANDLER
 974          &optional :timeout TIMEOUT &rest ARGS)  */)
 975      (nargs, args)
 976      int nargs;
 977      register Lisp_Object *args;
 978 {
 979   Lisp_Object bus, service, path, interface, method, handler;
 980   Lisp_Object result;
 981   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
 982   DBusConnection *connection;
 983   DBusMessage *dmessage;
 984   DBusMessageIter iter;
 985   unsigned int dtype;
 986   int timeout = -1;
 987   int i = 6;
 988   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
 989
 990   /* Check parameters.  */
 991   bus = args[0];
 992   service = args[1];
 993   path = args[2];
 994   interface = args[3];
 995   method = args[4];
 996   handler = args[5];
 997
 998   CHECK_SYMBOL (bus);
 999   CHECK_STRING (service);
1000   CHECK_STRING (path);
1001   CHECK_STRING (interface);
1002   CHECK_STRING (method);
1003   if (!FUNCTIONP (handler))
1004     wrong_type_argument (intern ("functionp"), handler);
1005   GCPRO6 (bus, service, path, interface, method, handler);
1006
1007   XD_DEBUG_MESSAGE ("%s %s %s %s",
1008                     SDATA (service),
1009                     SDATA (path),
1010                     SDATA (interface),
1011                     SDATA (method));
1012
1013   /* Open a connection to the bus.  */
1014   connection = xd_initialize (bus);
1015
1016   /* Create the message.  */
1017   dmessage = dbus_message_new_method_call (SDATA (service),
1018                                            SDATA (path),
1019                                            SDATA (interface),
1020                                            SDATA (method));
1021   if (dmessage == NULL)
1022     xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
1023
1024   /* Check for timeout parameter.  */
1025   if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
1026     {
1027       CHECK_NATNUM (args[i+1]);
1028       timeout = XUINT (args[i+1]);
1029       i = i+2;
1030     }
1031
1032   /* Initialize parameter list of message.  */
1033   dbus_message_iter_init_append (dmessage, &iter);
1034
1035   /* Append parameters to the message.  */
1036   for (; i < nargs; ++i)
1037     {
1038       dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1039       if (XD_DBUS_TYPE_P (args[i]))
1040         {
1041           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1042           XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1043           XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4,
1044                             SDATA (format2 ("%s", args[i], Qnil)),
1045                             SDATA (format2 ("%s", args[i+1], Qnil)));
1046           ++i;
1047         }
1048       else
1049         {
1050           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1051           XD_DEBUG_MESSAGE ("Parameter%d %s", i-4,
1052                             SDATA (format2 ("%s", args[i], Qnil)));
1053         }
1054
1055       /* Check for valid signature.  We use DBUS_TYPE_INVALID as
1056          indication that there is no parent type.  */
1057       xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1058
1059       xd_append_arg (dtype, args[i], &iter);
1060     }
1061
1062   /* Send the message.  The message is just added to the outgoing
1063      message queue.  */
1064   if (!dbus_connection_send_with_reply (connection, dmessage, NULL, timeout))
1065     xsignal1 (Qdbus_error, build_string ("Cannot send message"));
1066
1067   XD_DEBUG_MESSAGE ("Message sent");
1068
1069   /* The result is the key in Vdbus_registered_functions_table.  */
1070   result = (list2 (bus, make_number (dbus_message_get_serial (dmessage))));
1071
1072   /* Create a hash table entry.  */
1073   Fputhash (result, handler, Vdbus_registered_functions_table);
1074
1075   /* Cleanup.  */
1076   dbus_message_unref (dmessage);
1077
1078   /* Return the result.  */
1079   RETURN_UNGCPRO (result);
1080 }
1081
1082 DEFUN ("dbus-method-return-internal", Fdbus_method_return_internal,
1083        Sdbus_method_return_internal,
1084        3, MANY, 0,
1085        doc: /* Return for message SERIAL on the D-Bus BUS.
1086 This is an internal function, it shall not be used outside dbus.el.
1087
1088 usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS)  */)
1089      (nargs, args)
1090      int nargs;
1091      register Lisp_Object *args;
1092 {
1093   Lisp_Object bus, serial, service;
1094   struct gcpro gcpro1, gcpro2, gcpro3;
1095   DBusConnection *connection;
1096   DBusMessage *dmessage;
1097   DBusMessageIter iter;
1098   unsigned int dtype;
1099   int i;
1100   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1101
1102   /* Check parameters.  */
1103   bus = args[0];
1104   serial = args[1];
1105   service = args[2];
1106
1107   CHECK_SYMBOL (bus);
1108   CHECK_NUMBER (serial);
1109   CHECK_STRING (service);
1110   GCPRO3 (bus, serial, service);
1111
1112   XD_DEBUG_MESSAGE ("%d %s ", XUINT (serial), SDATA (service));
1113
1114   /* Open a connection to the bus.  */
1115   connection = xd_initialize (bus);
1116
1117   /* Create the message.  */
1118   dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_METHOD_RETURN);
1119   if ((dmessage == NULL)
1120       || (!dbus_message_set_reply_serial (dmessage, XUINT (serial)))
1121       || (!dbus_message_set_destination (dmessage, SDATA (service))))
1122     {
1123       UNGCPRO;
1124       xsignal1 (Qdbus_error,
1125                 build_string ("Unable to create a return message"));
1126     }
1127
1128   UNGCPRO;
1129
1130   /* Initialize parameter list of message.  */
1131   dbus_message_iter_init_append (dmessage, &iter);
1132
1133   /* Append parameters to the message.  */
1134   for (i = 3; i < nargs; ++i)
1135     {
1136       dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1137       if (XD_DBUS_TYPE_P (args[i]))
1138         {
1139           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1140           XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1141           XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-2,
1142                             SDATA (format2 ("%s", args[i], Qnil)),
1143                             SDATA (format2 ("%s", args[i+1], Qnil)));
1144           ++i;
1145         }
1146       else
1147         {
1148           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1149           XD_DEBUG_MESSAGE ("Parameter%d %s", i-2,
1150                             SDATA (format2 ("%s", args[i], Qnil)));
1151         }
1152
1153       /* Check for valid signature.  We use DBUS_TYPE_INVALID as
1154          indication that there is no parent type.  */
1155       xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1156
1157       xd_append_arg (dtype, args[i], &iter);
1158     }
1159
1160   /* Send the message.  The message is just added to the outgoing
1161      message queue.  */
1162   if (!dbus_connection_send (connection, dmessage, NULL))
1163     xsignal1 (Qdbus_error, build_string ("Cannot send message"));
1164
1165   /* Flush connection to ensure the message is handled.  */
1166   dbus_connection_flush (connection);
1167
1168   XD_DEBUG_MESSAGE ("Message sent");
1169
1170   /* Cleanup.  */
1171   dbus_message_unref (dmessage);
1172
1173   /* Return.  */
1174   return Qt;
1175 }
1176
1177 DEFUN ("dbus-method-error-internal", Fdbus_method_error_internal,
1178        Sdbus_method_error_internal,
1179        3, MANY, 0,
1180        doc: /* Return error message for message SERIAL on the D-Bus BUS.
1181 This is an internal function, it shall not be used outside dbus.el.
1182
1183 usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS)  */)
1184      (nargs, args)
1185      int nargs;
1186      register Lisp_Object *args;
1187 {
1188   Lisp_Object bus, serial, service;
1189   struct gcpro gcpro1, gcpro2, gcpro3;
1190   DBusConnection *connection;
1191   DBusMessage *dmessage;
1192   DBusMessageIter iter;
1193   unsigned int dtype;
1194   int i;
1195   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1196
1197   /* Check parameters.  */
1198   bus = args[0];
1199   serial = args[1];
1200   service = args[2];
1201
1202   CHECK_SYMBOL (bus);
1203   CHECK_NUMBER (serial);
1204   CHECK_STRING (service);
1205   GCPRO3 (bus, serial, service);
1206
1207   XD_DEBUG_MESSAGE ("%d %s ", XUINT (serial), SDATA (service));
1208
1209   /* Open a connection to the bus.  */
1210   connection = xd_initialize (bus);
1211
1212   /* Create the message.  */
1213   dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_ERROR);
1214   if ((dmessage == NULL)
1215       || (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED))
1216       || (!dbus_message_set_reply_serial (dmessage, XUINT (serial)))
1217       || (!dbus_message_set_destination (dmessage, SDATA (service))))
1218     {
1219       UNGCPRO;
1220       xsignal1 (Qdbus_error,
1221                 build_string ("Unable to create a error message"));
1222     }
1223
1224   UNGCPRO;
1225
1226   /* Initialize parameter list of message.  */
1227   dbus_message_iter_init_append (dmessage, &iter);
1228
1229   /* Append parameters to the message.  */
1230   for (i = 3; i < nargs; ++i)
1231     {
1232       dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1233       if (XD_DBUS_TYPE_P (args[i]))
1234         {
1235           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1236           XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1237           XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-2,
1238                             SDATA (format2 ("%s", args[i], Qnil)),
1239                             SDATA (format2 ("%s", args[i+1], Qnil)));
1240           ++i;
1241         }
1242       else
1243         {
1244           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1245           XD_DEBUG_MESSAGE ("Parameter%d %s", i-2,
1246                             SDATA (format2 ("%s", args[i], Qnil)));
1247         }
1248
1249       /* Check for valid signature.  We use DBUS_TYPE_INVALID as
1250          indication that there is no parent type.  */
1251       xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1252
1253       xd_append_arg (dtype, args[i], &iter);
1254     }
1255
1256   /* Send the message.  The message is just added to the outgoing
1257      message queue.  */
1258   if (!dbus_connection_send (connection, dmessage, NULL))
1259     xsignal1 (Qdbus_error, build_string ("Cannot send message"));
1260
1261   /* Flush connection to ensure the message is handled.  */
1262   dbus_connection_flush (connection);
1263
1264   XD_DEBUG_MESSAGE ("Message sent");
1265
1266   /* Cleanup.  */
1267   dbus_message_unref (dmessage);
1268
1269   /* Return.  */
1270   return Qt;
1271 }
1272
1273 DEFUN ("dbus-send-signal", Fdbus_send_signal, Sdbus_send_signal, 5, MANY, 0,
1274        doc: /* Send signal SIGNAL on the D-Bus BUS.
1275
1276 BUS is either the symbol `:system' or the symbol `:session'.
1277
1278 SERVICE is the D-Bus service name SIGNAL is sent from.  PATH is the
1279 D-Bus object path SERVICE is registered at.  INTERFACE is an interface
1280 offered by SERVICE.  It must provide signal SIGNAL.
1281
1282 All other arguments ARGS are passed to SIGNAL as arguments.  They are
1283 converted into D-Bus types via the following rules:
1284
1285   t and nil => DBUS_TYPE_BOOLEAN
1286   number    => DBUS_TYPE_UINT32
1287   integer   => DBUS_TYPE_INT32
1288   float     => DBUS_TYPE_DOUBLE
1289   string    => DBUS_TYPE_STRING
1290   list      => DBUS_TYPE_ARRAY
1291
1292 All arguments can be preceded by a type symbol.  For details about
1293 type symbols, see Info node `(dbus)Type Conversion'.
1294
1295 Example:
1296
1297 \(dbus-send-signal
1298   :session "org.gnu.Emacs" "/org/gnu/Emacs"
1299   "org.gnu.Emacs.FileManager" "FileModified" "/home/albinus/.emacs")
1300
1301 usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)  */)
1302      (nargs, args)
1303      int nargs;
1304      register Lisp_Object *args;
1305 {
1306   Lisp_Object bus, service, path, interface, signal;
1307   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
1308   DBusConnection *connection;
1309   DBusMessage *dmessage;
1310   DBusMessageIter iter;
1311   unsigned int dtype;
1312   int i;
1313   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
1314
1315   /* Check parameters.  */
1316   bus = args[0];
1317   service = args[1];
1318   path = args[2];
1319   interface = args[3];
1320   signal = args[4];
1321
1322   CHECK_SYMBOL (bus);
1323   CHECK_STRING (service);
1324   CHECK_STRING (path);
1325   CHECK_STRING (interface);
1326   CHECK_STRING (signal);
1327   GCPRO5 (bus, service, path, interface, signal);
1328
1329   XD_DEBUG_MESSAGE ("%s %s %s %s",
1330                     SDATA (service),
1331                     SDATA (path),
1332                     SDATA (interface),
1333                     SDATA (signal));
1334
1335   /* Open a connection to the bus.  */
1336   connection = xd_initialize (bus);
1337
1338   /* Create the message.  */
1339   dmessage = dbus_message_new_signal (SDATA (path),
1340                                       SDATA (interface),
1341                                       SDATA (signal));
1342   UNGCPRO;
1343   if (dmessage == NULL)
1344     xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
1345
1346   /* Initialize parameter list of message.  */
1347   dbus_message_iter_init_append (dmessage, &iter);
1348
1349   /* Append parameters to the message.  */
1350   for (i = 5; i < nargs; ++i)
1351     {
1352       dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
1353       if (XD_DBUS_TYPE_P (args[i]))
1354         {
1355           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1356           XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
1357           XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4,
1358                             SDATA (format2 ("%s", args[i], Qnil)),
1359                             SDATA (format2 ("%s", args[i+1], Qnil)));
1360           ++i;
1361         }
1362       else
1363         {
1364           XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
1365           XD_DEBUG_MESSAGE ("Parameter%d %s", i-4,
1366                             SDATA (format2 ("%s", args[i], Qnil)));
1367         }
1368
1369       /* Check for valid signature.  We use DBUS_TYPE_INVALID as
1370          indication that there is no parent type.  */
1371       xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
1372
1373       xd_append_arg (dtype, args[i], &iter);
1374     }
1375
1376   /* Send the message.  The message is just added to the outgoing
1377      message queue.  */
1378   if (!dbus_connection_send (connection, dmessage, NULL))
1379     xsignal1 (Qdbus_error, build_string ("Cannot send message"));
1380
1381   /* Flush connection to ensure the message is handled.  */
1382   dbus_connection_flush (connection);
1383
1384   XD_DEBUG_MESSAGE ("Signal sent");
1385
1386   /* Cleanup.  */
1387   dbus_message_unref (dmessage);
1388
1389   /* Return.  */
1390   return Qt;
1391 }
1392
1393 /* Read queued incoming message of the D-Bus BUS.  BUS is a Lisp
1394    symbol, either :system or :session.  */
1395 Lisp_Object
1396 xd_read_message (bus)
1397      Lisp_Object bus;
1398 {
1399   Lisp_Object args, key, value;
1400   struct gcpro gcpro1;
1401   struct input_event event;
1402   DBusConnection *connection;
1403   DBusMessage *dmessage;
1404   DBusMessageIter iter;
1405   unsigned int dtype;
1406   int mtype, serial;
1407   const char *uname, *path, *interface, *member;
1408
1409   /* Open a connection to the bus.  */
1410   connection = xd_initialize (bus);
1411
1412   /* Non blocking read of the next available message.  */
1413   dbus_connection_read_write (connection, 0);
1414   dmessage = dbus_connection_pop_message (connection);
1415
1416   /* Return if there is no queued message.  */
1417   if (dmessage == NULL)
1418     return Qnil;
1419
1420   /* Collect the parameters.  */
1421   args = Qnil;
1422   GCPRO1 (args);
1423
1424   /* Loop over the resulting parameters.  Construct a list.  */
1425   if (dbus_message_iter_init (dmessage, &iter))
1426     {
1427       while ((dtype = dbus_message_iter_get_arg_type (&iter))
1428              != DBUS_TYPE_INVALID)
1429         {
1430           args = Fcons (xd_retrieve_arg (dtype, &iter), args);
1431           dbus_message_iter_next (&iter);
1432         }
1433       /* The arguments are stored in reverse order.  Reorder them.  */
1434       args = Fnreverse (args);
1435     }
1436
1437   /* Read message type, message serial, unique name, object path,
1438      interface and member from the message.  */
1439   mtype = dbus_message_get_type (dmessage);
1440   serial =
1441     ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1442      || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1443     ? dbus_message_get_reply_serial (dmessage)
1444     : dbus_message_get_serial (dmessage);
1445   uname = dbus_message_get_sender (dmessage);
1446   path = dbus_message_get_path (dmessage);
1447   interface = dbus_message_get_interface (dmessage);
1448   member = dbus_message_get_member (dmessage);
1449
1450   XD_DEBUG_MESSAGE ("Event received: %s %d %s %s %s %s %s",
1451                     (mtype == DBUS_MESSAGE_TYPE_INVALID)
1452                     ? "DBUS_MESSAGE_TYPE_INVALID"
1453                     : (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
1454                     ? "DBUS_MESSAGE_TYPE_METHOD_CALL"
1455                     : (mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1456                     ? "DBUS_MESSAGE_TYPE_METHOD_RETURN"
1457                     : (mtype == DBUS_MESSAGE_TYPE_ERROR)
1458                     ? "DBUS_MESSAGE_TYPE_ERROR"
1459                     : "DBUS_MESSAGE_TYPE_SIGNAL",
1460                     serial, uname, path, interface, member,
1461                     SDATA (format2 ("%s", args, Qnil)));
1462
1463   if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN)
1464       || (mtype == DBUS_MESSAGE_TYPE_ERROR))
1465     {
1466       /* Search for a registered function of the message.  */
1467       key = list2 (bus, make_number (serial));
1468       value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
1469
1470       /* There shall be exactly one entry.  Construct an event.  */
1471       if (NILP (value))
1472         goto cleanup;
1473
1474       /* Remove the entry.  */
1475       Fremhash (key, Vdbus_registered_functions_table);
1476
1477       /* Construct an event.  */
1478       EVENT_INIT (event);
1479       event.kind = DBUS_EVENT;
1480       event.frame_or_window = Qnil;
1481       event.arg = Fcons (value, args);
1482     }
1483
1484   else /* (mtype != DBUS_MESSAGE_TYPE_METHOD_RETURN)  */
1485     {
1486       /* Vdbus_registered_functions_table requires non-nil interface
1487          and member.  */
1488       if ((interface == NULL) || (member == NULL))
1489         goto cleanup;
1490
1491       /* Search for a registered function of the message.  */
1492       key = list3 (bus, build_string (interface), build_string (member));
1493       value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
1494
1495       /* Loop over the registered functions.  Construct an event.  */
1496       while (!NILP (value))
1497         {
1498           key = CAR_SAFE (value);
1499           /* key has the structure (UNAME SERVICE PATH HANDLER).  */
1500           if (((uname == NULL)
1501                || (NILP (CAR_SAFE (key)))
1502                || (strcmp (uname, SDATA (CAR_SAFE (key))) == 0))
1503               && ((path == NULL)
1504                   || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1505                   || (strcmp (path,
1506                               SDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key)))))
1507                       == 0))
1508               && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))))))
1509             {
1510               EVENT_INIT (event);
1511               event.kind = DBUS_EVENT;
1512               event.frame_or_window = Qnil;
1513               event.arg = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))),
1514                                  args);
1515               break;
1516             }
1517           value = CDR_SAFE (value);
1518         }
1519
1520       if (NILP (value))
1521         goto cleanup;
1522     }
1523
1524   /* Add type, serial, uname, path, interface and member to the event.  */
1525   event.arg = Fcons ((member == NULL ? Qnil : build_string (member)),
1526                      event.arg);
1527   event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)),
1528                      event.arg);
1529   event.arg = Fcons ((path == NULL ? Qnil : build_string (path)),
1530                      event.arg);
1531   event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)),
1532                      event.arg);
1533   event.arg = Fcons (make_number (serial), event.arg);
1534   event.arg = Fcons (make_number (mtype), event.arg);
1535
1536   /* Add the bus symbol to the event.  */
1537   event.arg = Fcons (bus, event.arg);
1538
1539   /* Store it into the input event queue.  */
1540   kbd_buffer_store_event (&event);
1541
1542   XD_DEBUG_MESSAGE ("Event stored: %s",
1543                     SDATA (format2 ("%s", event.arg, Qnil)));
1544
1545  cleanup:
1546   dbus_message_unref (dmessage);
1547   RETURN_UNGCPRO (Qnil);
1548 }
1549
1550 /* Read queued incoming messages from the system and session buses.  */
1551 void
1552 xd_read_queued_messages ()
1553 {
1554
1555   /* Vdbus_registered_functions_table will be initialized as hash
1556      table in dbus.el.  When this package isn't loaded yet, it doesn't
1557      make sense to handle D-Bus messages.  Furthermore, we ignore all
1558      Lisp errors during the call.  */
1559   if (HASH_TABLE_P (Vdbus_registered_functions_table))
1560     {
1561       internal_condition_case_1 (xd_read_message, QCdbus_system_bus,
1562                                  Qerror, Fidentity);
1563       internal_condition_case_1 (xd_read_message, QCdbus_session_bus,
1564                                  Qerror, Fidentity);
1565     }
1566 }
1567
1568 DEFUN ("dbus-register-signal", Fdbus_register_signal, Sdbus_register_signal,
1569        6, MANY, 0,
1570        doc: /* Register for signal SIGNAL on the D-Bus BUS.
1571
1572 BUS is either the symbol `:system' or the symbol `:session'.
1573
1574 SERVICE is the D-Bus service name used by the sending D-Bus object.
1575 It can be either a known name or the unique name of the D-Bus object
1576 sending the signal.  When SERVICE is nil, related signals from all
1577 D-Bus objects shall be accepted.
1578
1579 PATH is the D-Bus object path SERVICE is registered.  It can also be
1580 nil if the path name of incoming signals shall not be checked.
1581
1582 INTERFACE is an interface offered by SERVICE.  It must provide SIGNAL.
1583 HANDLER is a Lisp function to be called when the signal is received.
1584 It must accept as arguments the values SIGNAL is sending.
1585
1586 All other arguments ARGS, if specified, must be strings.  They stand
1587 for the respective arguments of the signal in their order, and are
1588 used for filtering as well.  A nil argument might be used to preserve
1589 the order.
1590
1591 INTERFACE, SIGNAL and HANDLER must not be nil.  Example:
1592
1593 \(defun my-signal-handler (device)
1594   (message "Device %s added" device))
1595
1596 \(dbus-register-signal
1597   :system "org.freedesktop.Hal" "/org/freedesktop/Hal/Manager"
1598   "org.freedesktop.Hal.Manager" "DeviceAdded" 'my-signal-handler)
1599
1600   => ((:system "org.freedesktop.Hal.Manager" "DeviceAdded")
1601       ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager" my-signal-handler))
1602
1603 `dbus-register-signal' returns an object, which can be used in
1604 `dbus-unregister-object' for removing the registration.
1605
1606 usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARGS) */)
1607      (nargs, args)
1608      int nargs;
1609      register Lisp_Object *args;
1610 {
1611   Lisp_Object bus, service, path, interface, signal, handler;
1612   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1613   Lisp_Object uname, key, key1, value;
1614   DBusConnection *connection;
1615   int i;
1616   char rule[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
1617   char x[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
1618   DBusError derror;
1619
1620   /* Check parameters.  */
1621   bus = args[0];
1622   service = args[1];
1623   path = args[2];
1624   interface = args[3];
1625   signal = args[4];
1626   handler = args[5];
1627
1628   CHECK_SYMBOL (bus);
1629   if (!NILP (service)) CHECK_STRING (service);
1630   if (!NILP (path)) CHECK_STRING (path);
1631   CHECK_STRING (interface);
1632   CHECK_STRING (signal);
1633   if (!FUNCTIONP (handler))
1634     wrong_type_argument (intern ("functionp"), handler);
1635   GCPRO6 (bus, service, path, interface, signal, handler);
1636
1637   /* Retrieve unique name of service.  If service is a known name, we
1638      will register for the corresponding unique name, if any.  Signals
1639      are sent always with the unique name as sender.  Note: the unique
1640      name of "org.freedesktop.DBus" is that string itself.  */
1641   if ((STRINGP (service))
1642       && (SBYTES (service) > 0)
1643       && (strcmp (SDATA (service), DBUS_SERVICE_DBUS) != 0)
1644       && (strncmp (SDATA (service), ":", 1) != 0))
1645     {
1646       uname = call2 (intern ("dbus-get-name-owner"), bus, service);
1647       /* When there is no unique name, we mark it with an empty
1648          string.  */
1649       if (NILP (uname))
1650         uname = build_string ("");
1651     }
1652   else
1653     uname = service;
1654
1655   /* Create a matching rule if the unique name exists (when no
1656      wildcard).  */
1657   if (NILP (uname) || (SBYTES (uname) > 0))
1658     {
1659       /* Open a connection to the bus.  */
1660       connection = xd_initialize (bus);
1661
1662       /* Create a rule to receive related signals.  */
1663       sprintf (rule,
1664                "type='signal',interface='%s',member='%s'",
1665                SDATA (interface),
1666                SDATA (signal));
1667
1668       /* Add unique name and path to the rule if they are non-nil.  */
1669       if (!NILP (uname))
1670         {
1671           sprintf (x, ",sender='%s'", SDATA (uname));
1672           strcat (rule, x);
1673         }
1674
1675       if (!NILP (path))
1676         {
1677           sprintf (x, ",path='%s'", SDATA (path));
1678           strcat (rule, x);
1679         }
1680
1681       /* Add arguments to the rule if they are non-nil.  */
1682       for (i = 6; i < nargs; ++i)
1683         if (!NILP (args[i]))
1684           {
1685             CHECK_STRING (args[i]);
1686             sprintf (x, ",arg%d='%s'", i-6, SDATA (args[i]));
1687             strcat (rule, x);
1688           }
1689
1690       /* Add the rule to the bus.  */
1691       dbus_error_init (&derror);
1692       dbus_bus_add_match (connection, rule, &derror);
1693       if (dbus_error_is_set (&derror))
1694         {
1695           UNGCPRO;
1696           XD_ERROR (derror);
1697         }
1698
1699       XD_DEBUG_MESSAGE ("Matching rule \"%s\" created", rule);
1700     }
1701
1702   /* Create a hash table entry.  */
1703   key = list3 (bus, interface, signal);
1704   key1 = list4 (uname, service, path, handler);
1705   value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
1706
1707   if (NILP (Fmember (key1, value)))
1708     Fputhash (key, Fcons (key1, value), Vdbus_registered_functions_table);
1709
1710   /* Return object.  */
1711   RETURN_UNGCPRO (list2 (key, list3 (service, path, handler)));
1712 }
1713
1714 DEFUN ("dbus-register-method", Fdbus_register_method, Sdbus_register_method,
1715        6, 6, 0,
1716        doc: /* Register for method METHOD on the D-Bus BUS.
1717
1718 BUS is either the symbol `:system' or the symbol `:session'.
1719
1720 SERVICE is the D-Bus service name of the D-Bus object METHOD is
1721 registered for.  It must be a known name.
1722
1723 PATH is the D-Bus object path SERVICE is registered.  INTERFACE is the
1724 interface offered by SERVICE.  It must provide METHOD.  HANDLER is a
1725 Lisp function to be called when a method call is received.  It must
1726 accept the input arguments of METHOD.  The return value of HANDLER is
1727 used for composing the returning D-Bus message.  */)
1728      (bus, service, path, interface, method, handler)
1729      Lisp_Object bus, service, path, interface, method, handler;
1730 {
1731   Lisp_Object key, key1, value;
1732   DBusConnection *connection;
1733   int result;
1734   DBusError derror;
1735
1736   /* Check parameters.  */
1737   CHECK_SYMBOL (bus);
1738   CHECK_STRING (service);
1739   CHECK_STRING (path);
1740   CHECK_STRING (interface);
1741   CHECK_STRING (method);
1742   if (!FUNCTIONP (handler))
1743     wrong_type_argument (intern ("functionp"), handler);
1744   /* TODO: We must check for a valid service name, otherwise there is
1745      a segmentation fault.  */
1746
1747   /* Open a connection to the bus.  */
1748   connection = xd_initialize (bus);
1749
1750   /* Request the known name from the bus.  We can ignore the result,
1751      it is set to -1 if there is an error - kind of redundancy.  */
1752   dbus_error_init (&derror);
1753   result = dbus_bus_request_name (connection, SDATA (service), 0, &derror);
1754   if (dbus_error_is_set (&derror))
1755     XD_ERROR (derror);
1756
1757   /* Create a hash table entry.  */
1758   key = list3 (bus, interface, method);
1759   key1 = list4 (Qnil, service, path, handler);
1760   value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
1761
1762   /* We use nil for the unique name, because the method might be
1763      called from everybody.  */
1764   if (NILP (Fmember (key1, value)))
1765     Fputhash (key, Fcons (key1, value), Vdbus_registered_functions_table);
1766
1767   /* Return object.  */
1768   return list2 (key, list3 (service, path, handler));
1769 }
1770
1771 \f
1772 void
1773 syms_of_dbusbind ()
1774 {
1775
1776   Qdbus_get_unique_name = intern ("dbus-get-unique-name");
1777   staticpro (&Qdbus_get_unique_name);
1778   defsubr (&Sdbus_get_unique_name);
1779
1780   Qdbus_call_method = intern ("dbus-call-method");
1781   staticpro (&Qdbus_call_method);
1782   defsubr (&Sdbus_call_method);
1783
1784   Qdbus_call_method_asynchronously = intern ("dbus-call-method-asynchronously");
1785   staticpro (&Qdbus_call_method_asynchronously);
1786   defsubr (&Sdbus_call_method_asynchronously);
1787
1788   Qdbus_method_return_internal = intern ("dbus-method-return-internal");
1789   staticpro (&Qdbus_method_return_internal);
1790   defsubr (&Sdbus_method_return_internal);
1791
1792   Qdbus_method_error_internal = intern ("dbus-method-error-internal");
1793   staticpro (&Qdbus_method_error_internal);
1794   defsubr (&Sdbus_method_error_internal);
1795
1796   Qdbus_send_signal = intern ("dbus-send-signal");
1797   staticpro (&Qdbus_send_signal);
1798   defsubr (&Sdbus_send_signal);
1799
1800   Qdbus_register_signal = intern ("dbus-register-signal");
1801   staticpro (&Qdbus_register_signal);
1802   defsubr (&Sdbus_register_signal);
1803
1804   Qdbus_register_method = intern ("dbus-register-method");
1805   staticpro (&Qdbus_register_method);
1806   defsubr (&Sdbus_register_method);
1807
1808   Qdbus_error = intern ("dbus-error");
1809   staticpro (&Qdbus_error);
1810   Fput (Qdbus_error, Qerror_conditions,
1811         list2 (Qdbus_error, Qerror));
1812   Fput (Qdbus_error, Qerror_message,
1813         build_string ("D-Bus error"));
1814
1815   QCdbus_system_bus = intern (":system");
1816   staticpro (&QCdbus_system_bus);
1817
1818   QCdbus_session_bus = intern (":session");
1819   staticpro (&QCdbus_session_bus);
1820
1821   QCdbus_timeout = intern (":timeout");
1822   staticpro (&QCdbus_timeout);
1823
1824   QCdbus_type_byte = intern (":byte");
1825   staticpro (&QCdbus_type_byte);
1826
1827   QCdbus_type_boolean = intern (":boolean");
1828   staticpro (&QCdbus_type_boolean);
1829
1830   QCdbus_type_int16 = intern (":int16");
1831   staticpro (&QCdbus_type_int16);
1832
1833   QCdbus_type_uint16 = intern (":uint16");
1834   staticpro (&QCdbus_type_uint16);
1835
1836   QCdbus_type_int32 = intern (":int32");
1837   staticpro (&QCdbus_type_int32);
1838
1839   QCdbus_type_uint32 = intern (":uint32");
1840   staticpro (&QCdbus_type_uint32);
1841
1842   QCdbus_type_int64 = intern (":int64");
1843   staticpro (&QCdbus_type_int64);
1844
1845   QCdbus_type_uint64 = intern (":uint64");
1846   staticpro (&QCdbus_type_uint64);
1847
1848   QCdbus_type_double = intern (":double");
1849   staticpro (&QCdbus_type_double);
1850
1851   QCdbus_type_string = intern (":string");
1852   staticpro (&QCdbus_type_string);
1853
1854   QCdbus_type_object_path = intern (":object-path");
1855   staticpro (&QCdbus_type_object_path);
1856
1857   QCdbus_type_signature = intern (":signature");
1858   staticpro (&QCdbus_type_signature);
1859
1860   QCdbus_type_array = intern (":array");
1861   staticpro (&QCdbus_type_array);
1862
1863   QCdbus_type_variant = intern (":variant");
1864   staticpro (&QCdbus_type_variant);
1865
1866   QCdbus_type_struct = intern (":struct");
1867   staticpro (&QCdbus_type_struct);
1868
1869   QCdbus_type_dict_entry = intern (":dict-entry");
1870   staticpro (&QCdbus_type_dict_entry);
1871
1872   DEFVAR_LISP ("dbus-registered-functions-table",
1873                &Vdbus_registered_functions_table,
1874     doc: /* Hash table of registered functions for D-Bus.
1875 There are two different uses of the hash table: for calling registered
1876 functions, targeted by signals or method calls, and for calling
1877 handlers in case of non-blocking method call returns.
1878
1879 In the first case, the key in the hash table is the list (BUS
1880 INTERFACE MEMBER).  BUS is either the symbol `:system' or the symbol
1881 `:session'.  INTERFACE is a string which denotes a D-Bus interface,
1882 and MEMBER, also a string, is either a method or a signal INTERFACE is
1883 offering.  All arguments but BUS must not be nil.
1884
1885 The value in the hash table is a list of quadruple lists
1886 \((UNAME SERVICE PATH HANDLER) (UNAME SERVICE PATH HANDLER) ...).
1887 SERVICE is the service name as registered, UNAME is the corresponding
1888 unique name.  PATH is the object path of the sending object.  All of
1889 them can be nil, which means a wildcard then.  HANDLER is the function
1890 to be called when a D-Bus message, which matches the key criteria,
1891 arrives.
1892
1893 In the second case, the key in the hash table is the list (BUS SERIAL).
1894 BUS is either the symbol `:system' or the symbol `:session'.  SERIAL
1895 is the serial number of the non-blocking method call, a reply is
1896 expected.  Both arguments must not be nil.  The value in the hash
1897 table is HANDLER, the function to be called when the D-Bus reply
1898 message arrives.  */);
1899   /* We initialize Vdbus_registered_functions_table in dbus.el,
1900      because we need to define a hash table function first.  */
1901   Vdbus_registered_functions_table = Qnil;
1902
1903   DEFVAR_LISP ("dbus-debug", &Vdbus_debug,
1904     doc: /* If non-nil, debug messages of D-Bus bindings are raised.  */);
1905 #ifdef DBUS_DEBUG
1906   Vdbus_debug = Qt;
1907 #else
1908   Vdbus_debug = Qnil;
1909 #endif
1910
1911   Fprovide (intern ("dbusbind"), Qnil);
1912
1913 }
1914
1915 #endif /* HAVE_DBUS */
1916
1917 /* arch-tag: 0e828477-b571-4fe4-b559-5c9211bc14b8
1918    (do not change this comment) */