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

   1 /* dbusbind.c -- Elisp bindings for D-Bus. */
   2
   3 /*
   4  * Time-stamp: <Sunday Jan 29, 2012 17:41:26 steve>
   5  * Created:    <2012-01-03>
   6  * Maintainer: Steve Youngs <steve@sxemacs.org>
   7  * Homepage:   https://www.sxemacs.org/
   8  */
   9
  10 /*
  11  * Copyright (C) 2007-2011 Free Software Foundation, Inc.
  12  * Copyright (C) 2012 Steve Youngs
  13  * Copyright (C) 2012 Nelson Ferreira
  14  */
  15
  16 /*
  17  * This file is part of SXEmacs.
  18
  19  * SXEmacs is free software: you can redistribute it and/or modify
  20  * it under the terms of the GNU General Public License as published by
  21  * the Free Software Foundation, either version 3 of the License, or
  22  * (at your option) any later version.
  23
  24  * SXEmacs is distributed in the hope that it will be useful,
  25  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  26  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  27  * GNU General Public License for more details.
  28
  29  * You should have received a copy of the GNU General Public License
  30  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  31  */
  32
  33
  34 #include <config.h>
  35
  36 #ifdef HAVE_DBUS
  37 #include <stdio.h>
  38 #include <dbus/dbus.h>
  39 #include <setjmp.h>
  40 #include "lisp.h"
  41 #include "ui/frame.h"
  42 #include "process.h"
  43 #include "elhash.h"
  44 #include "dbusbind.h"
  45
  46 /*
  47  * #include "termhooks.h"
  48  * #include "keyboard.h"
  49  */
  50
  51 \f
  52 /*
  53  * Stuff lifted from GNU/Emacs to let this work
  54  * This stuff needs to be ported and then removed!!
  55  */
  56
  57 /* Internal version of Fsignal that never returns.
  58    Used for anything but Qquit (which can return from Fsignal).  */
  59
  60 void
  61 xsignal (Lisp_Object error_symbol, Lisp_Object data)
  62 {
  63         Fsignal (error_symbol, data);
  64         abort ();
  65 }
  66
  67 /* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list.  */
  68
  69 void
  70 xsignal0 (Lisp_Object error_symbol)
  71 {
  72         xsignal (error_symbol, Qnil);
  73 }
  74
  75 void
  76 xsignal1 (Lisp_Object error_symbol, Lisp_Object arg)
  77 {
  78         xsignal (error_symbol, list1 (arg));
  79 }
  80
  81 void
  82 xsignal2 (Lisp_Object error_symbol, Lisp_Object arg1, Lisp_Object arg2)
  83 {
  84         xsignal (error_symbol, list2 (arg1, arg2));
  85 }
  86
  87 void
  88 xsignal3 (Lisp_Object error_symbol, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
  89 {
  90         xsignal (error_symbol, list3 (arg1, arg2, arg3));
  91 }
  92
  93 Lisp_Object
  94 format2 (const char *string1, Lisp_Object arg0, Lisp_Object arg1)
  95 {
  96         Lisp_Object args[3];
  97         args[0] = build_string (string1);
  98         args[1] = arg0;
  99         args[2] = arg1;
 100         return Fformat (3, args);
 101 }
 102
 103 /* End lifted from GNU */
 104
 105 /* Whether we are reading a D-Bus event.  */
 106 static int xd_in_read_queued_messages = 0;
 107
 108 \f
 109 /* This was a macro.  On Solaris 2.11 it was said to compile for
 110    hours, when optimization is enabled.  So we have transferred it into
 111    a function.  */
 112 /* Determine the DBusType of a given Lisp symbol.  OBJECT must be one
 113    of the predefined D-Bus type symbols.  */
 114 static int
 115 xd_symbol_to_dbus_type (Lisp_Object object)
 116 {
 117         return
 118                 ((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE
 119                  : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN
 120                  : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16
 121                  : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16
 122                  : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32
 123                  : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32
 124                  : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64
 125                  : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64
 126                  : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE
 127                  : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING
 128                  : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH
 129                  : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE
 130 #ifdef DBUS_TYPE_UNIX_FD
 131                  : (EQ (object, QCdbus_type_unix_fd)) ? DBUS_TYPE_UNIX_FD
 132 #endif
 133                  : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY
 134                  : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT
 135                  : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT
 136                  : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY
 137                  : DBUS_TYPE_INVALID);
 138 }
 139
 140 /* Append to SIGNATURE a copy of X, making sure SIGNATURE does
 141    not become too long.  */
 142 static void
 143 xd_signature_cat (char *signature, char const *x)
 144 {
 145         int siglen = strlen (signature);
 146         int xlen = strlen (x);
 147         if (DBUS_MAXIMUM_SIGNATURE_LENGTH - xlen <= siglen)
 148                 string_overflow ();
 149         strcat (signature, x);
 150 }
 151
 152 /* Compute SIGNATURE of OBJECT.  It must have a form that it can be
 153    used in dbus_message_iter_open_container.  DTYPE is the DBusType
 154    the object is related to.  It is passed as argument, because it
 155    cannot be detected in basic type objects, when they are preceded by
 156    a type symbol.  PARENT_TYPE is the DBusType of a container this
 157    signature is embedded, or DBUS_TYPE_INVALID.  It is needed for the
 158    check that DBUS_TYPE_DICT_ENTRY occurs only as array element.  */
 159 static void
 160 xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lisp_Object object)
 161 {
 162         unsigned int subtype;
 163         Lisp_Object elt;
 164         char const *subsig;
 165         int subsiglen;
 166         char x[DBUS_MAXIMUM_SIGNATURE_LENGTH];
 167
 168         elt = object;
 169
 170         switch (dtype)
 171         {
 172         case DBUS_TYPE_BYTE:
 173         case DBUS_TYPE_UINT16:
 174         case DBUS_TYPE_UINT32:
 175         case DBUS_TYPE_UINT64:
 176 #ifdef DBUS_TYPE_UNIX_FD
 177         case DBUS_TYPE_UNIX_FD:
 178 #endif
 179                 CHECK_NATNUM (object);
 180                 sprintf (signature, "%c", dtype);
 181                 break;
 182
 183         case DBUS_TYPE_BOOLEAN:
 184                 if (!EQ (object, Qt) && !EQ (object, Qnil))
 185                         wrong_type_argument (intern ("booleanp"), object);
 186                 sprintf (signature, "%c", dtype);
 187                 break;
 188
 189         case DBUS_TYPE_INT16:
 190         case DBUS_TYPE_INT32:
 191         case DBUS_TYPE_INT64:
 192                 CHECK_NUMBER (object);
 193                 sprintf (signature, "%c", dtype);
 194                 break;
 195
 196         case DBUS_TYPE_DOUBLE:
 197                 CHECK_FLOAT (object);
 198                 sprintf (signature, "%c", dtype);
 199                 break;
 200
 201         case DBUS_TYPE_STRING:
 202         case DBUS_TYPE_OBJECT_PATH:
 203         case DBUS_TYPE_SIGNATURE:
 204                 CHECK_STRING (object);
 205                 sprintf (signature, "%c", dtype);
 206                 break;
 207
 208         case DBUS_TYPE_ARRAY:
 209                 /* Check that all list elements have the same D-Bus type.  For
 210                    complex element types, we just check the container type, not
 211                    the whole element's signature.  */
 212                 CHECK_CONS (object);
 213
 214                 /* Type symbol is optional.  */
 215                 if (EQ (QCdbus_type_array, CAR_SAFE (elt)))
 216                         elt = XD_NEXT_VALUE (elt);
 217
 218                 /* If the array is empty, DBUS_TYPE_STRING is the default
 219                    element type.  */
 220                 if (NILP (elt))
 221                 {
 222                         subtype = DBUS_TYPE_STRING;
 223                         subsig = DBUS_TYPE_STRING_AS_STRING;
 224                 }
 225                 else
 226                 {
 227                         subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 228                         xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 229                         subsig = x;
 230                 }
 231
 232                 /* If the element type is DBUS_TYPE_SIGNATURE, and this is the
 233                    only element, the value of this element is used as he array's
 234                    element signature.  */
 235                 if ((subtype == DBUS_TYPE_SIGNATURE)
 236                     && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt)))
 237                     && NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
 238                         subsig = SSDATA (CAR_SAFE (XD_NEXT_VALUE (elt)));
 239
 240                 while (!NILP (elt))
 241                 {
 242                         if (subtype != XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)))
 243                                 wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt));
 244                         elt = CDR_SAFE (XD_NEXT_VALUE (elt));
 245                 }
 246
 247                 subsiglen = snprintf (signature, DBUS_MAXIMUM_SIGNATURE_LENGTH,
 248                                       "%c%s", dtype, subsig);
 249                 if (! (0 <= subsiglen && subsiglen < DBUS_MAXIMUM_SIGNATURE_LENGTH))
 250                         string_overflow ();
 251                 break;
 252
 253         case DBUS_TYPE_VARIANT:
 254                 /* Check that there is exactly one list element.  */
 255                 CHECK_CONS (object);
 256
 257                 elt = XD_NEXT_VALUE (elt);
 258                 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 259                 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 260
 261                 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
 262                         wrong_type_argument (intern ("D-Bus"),
 263                                              CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
 264
 265                 sprintf (signature, "%c", dtype);
 266                 break;
 267
 268         case DBUS_TYPE_STRUCT:
 269                 /* A struct list might contain any number of elements with
 270                    different types.  No further check needed.  */
 271                 CHECK_CONS (object);
 272
 273                 elt = XD_NEXT_VALUE (elt);
 274
 275                 /* Compose the signature from the elements.  It is enclosed by
 276                    parentheses.  */
 277                 sprintf (signature, "%c", DBUS_STRUCT_BEGIN_CHAR );
 278                 while (!NILP (elt))
 279                 {
 280                         subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 281                         xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 282                         xd_signature_cat (signature, x);
 283                         elt = CDR_SAFE (XD_NEXT_VALUE (elt));
 284                 }
 285                 xd_signature_cat (signature, DBUS_STRUCT_END_CHAR_AS_STRING);
 286                 break;
 287
 288         case DBUS_TYPE_DICT_ENTRY:
 289                 /* Check that there are exactly two list elements, and the first
 290                    one is of basic type.  The dictionary entry itself must be an
 291                    element of an array.  */
 292                 CHECK_CONS (object);
 293
 294                 /* Check the parent object type.  */
 295                 if (parent_type != DBUS_TYPE_ARRAY)
 296                         wrong_type_argument (intern ("D-Bus"), object);
 297
 298                 /* Compose the signature from the elements.  It is enclosed by
 299                    curly braces.  */
 300                 sprintf (signature, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR);
 301
 302                 /* First element.  */
 303                 elt = XD_NEXT_VALUE (elt);
 304                 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 305                 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 306                 xd_signature_cat (signature, x);
 307
 308                 if (!XD_BASIC_DBUS_TYPE (subtype))
 309                         wrong_type_argument (intern ("D-Bus"), CAR_SAFE (XD_NEXT_VALUE (elt)));
 310
 311                 /* Second element.  */
 312                 elt = CDR_SAFE (XD_NEXT_VALUE (elt));
 313                 subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
 314                 xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 315                 xd_signature_cat (signature, x);
 316
 317                 if (!NILP (CDR_SAFE (XD_NEXT_VALUE (elt))))
 318                         wrong_type_argument (intern ("D-Bus"),
 319                                              CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
 320
 321                 /* Closing signature.  */
 322                 xd_signature_cat (signature, DBUS_DICT_ENTRY_END_CHAR_AS_STRING);
 323                 break;
 324
 325         default:
 326                 wrong_type_argument (intern ("D-Bus"), object);
 327         }
 328
 329         XD_DEBUG_MESSAGE ("%s", signature);
 330 }
 331
 332 /* Append C value, extracted from Lisp OBJECT, to iteration ITER.
 333    DTYPE must be a valid DBusType.  It is used to convert Lisp
 334    objects, being arguments of `dbus-call-method' or
 335    `dbus-send-signal', into corresponding C values appended as
 336    arguments to a D-Bus message.  */
 337 #define pI "l"
 338 static void
 339 xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter)
 340 {
 341         char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
 342         DBusMessageIter subiter;
 343
 344         if (XD_BASIC_DBUS_TYPE (dtype))
 345                 switch (dtype)
 346                 {
 347                 case DBUS_TYPE_BYTE:
 348                         CHECK_NATNUM (object);
 349                         {
 350                                 unsigned char val = XFASTINT (object) & 0xFF;
 351                                 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 352                                 if (!dbus_message_iter_append_basic (iter, dtype, &val))
 353                                         XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 354                                 return;
 355                         }
 356
 357                 case DBUS_TYPE_BOOLEAN:
 358                 {
 359                         dbus_bool_t val = (NILP (object)) ? FALSE : TRUE;
 360                         XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
 361                         if (!dbus_message_iter_append_basic (iter, dtype, &val))
 362                                 XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 363                         return;
 364                 }
 365
 366                 case DBUS_TYPE_INT16:
 367                         CHECK_NUMBER (object);
 368                         {
 369                                 dbus_int16_t val = XINT (object);
 370                                 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
 371                                 if (!dbus_message_iter_append_basic (iter, dtype, &val))
 372                                         XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 373                                 return;
 374                         }
 375
 376                 case DBUS_TYPE_UINT16:
 377                         CHECK_NATNUM (object);
 378                         {
 379                                 dbus_uint16_t val = XFASTINT (object);
 380                                 XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
 381                                 if (!dbus_message_iter_append_basic (iter, dtype, &val))
 382                                         XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 383                                 return;
 384                         }
 385
 386                 case DBUS_TYPE_INT32:
 387                         CHECK_NUMBER (object);
 388                         {
 389                                 dbus_int32_t val = XINT (object);
 390                                 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 391                                 if (!dbus_message_iter_append_basic (iter, dtype, &val))
 392                                         XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 393                                 return;
 394                         }
 395
 396                 case DBUS_TYPE_UINT32:
 397 #ifdef DBUS_TYPE_UNIX_FD
 398                 case DBUS_TYPE_UNIX_FD:
 399 #endif
 400                         CHECK_NATNUM (object);
 401                         {
 402                                 dbus_uint32_t val = XFASTINT (object);
 403                                 XD_DEBUG_MESSAGE ("%c %u", dtype, val);
 404                                 if (!dbus_message_iter_append_basic (iter, dtype, &val))
 405                                         XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 406                                 return;
 407                         }
 408
 409                 case DBUS_TYPE_INT64:
 410                         CHECK_NUMBER (object);
 411                         {
 412                                 dbus_int64_t val = XINT (object);
 413                                 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
 414                                 if (!dbus_message_iter_append_basic (iter, dtype, &val))
 415                                         XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 416                                 return;
 417                         }
 418
 419                 case DBUS_TYPE_UINT64:
 420                         CHECK_NATNUM (object);
 421                         {
 422                                 dbus_uint64_t val = XFASTINT (object);
 423                                 XD_DEBUG_MESSAGE ("%c %"pI"d", dtype, XFASTINT (object));
 424                                 if (!dbus_message_iter_append_basic (iter, dtype, &val))
 425                                         XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 426                                 return;
 427                         }
 428
 429                 case DBUS_TYPE_DOUBLE:
 430                         CHECK_FLOAT (object);
 431                         {
 432                                 double val = XFLOAT_DATA (object);
 433                                 XD_DEBUG_MESSAGE ("%c %f", dtype, val);
 434                                 if (!dbus_message_iter_append_basic (iter, dtype, &val))
 435                                         XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 436                                 return;
 437                         }
 438
 439                 case DBUS_TYPE_STRING:
 440                 case DBUS_TYPE_OBJECT_PATH:
 441                 case DBUS_TYPE_SIGNATURE:
 442                         CHECK_STRING (object);
 443                         {
 444                                 /* We need to send a valid UTF-8 string.  We could encode `object'
 445                                    but by not encoding it, we guarantee it's valid utf-8, even if
 446                                    it contains eight-bit-bytes.  Of course, you can still send
 447                                    manually-crafted junk by passing a unibyte string.  */
 448                                 char *val = SSDATA (object);
 449                                 XD_DEBUG_MESSAGE ("%c %s", dtype, val);
 450                                 if (!dbus_message_iter_append_basic (iter, dtype, &val))
 451                                         XD_SIGNAL2 (build_string ("Unable to append argument"), object);
 452                                 return;
 453                         }
 454                 }
 455
 456         else /* Compound types.  */
 457         {
 458
 459                 /* All compound types except array have a type symbol.  For
 460                    array, it is optional.  Skip it.  */
 461                 if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))))
 462                         object = XD_NEXT_VALUE (object);
 463
 464                 /* Open new subiteration.  */
 465                 switch (dtype)
 466                 {
 467                 case DBUS_TYPE_ARRAY:
 468                         /* An array has only elements of the same type.  So it is
 469                            sufficient to check the first element's signature
 470                            only.  */
 471
 472                         if (NILP (object))
 473                                 /* If the array is empty, DBUS_TYPE_STRING is the default
 474                                    element type.  */
 475                                 strcpy (signature, DBUS_TYPE_STRING_AS_STRING);
 476
 477                         else
 478                                 /* If the element type is DBUS_TYPE_SIGNATURE, and this is
 479                                    the only element, the value of this element is used as
 480                                    the array's element signature.  */
 481                                 if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object))
 482                                      == DBUS_TYPE_SIGNATURE)
 483                                     && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object)))
 484                                     && NILP (CDR_SAFE (XD_NEXT_VALUE (object))))
 485                                 {
 486                                         strcpy (signature, SSDATA (CAR_SAFE (XD_NEXT_VALUE (object))));
 487                                         object = CDR_SAFE (XD_NEXT_VALUE (object));
 488                                 }
 489
 490                                 else
 491                                         xd_signature (signature,
 492                                                       XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
 493                                                       dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
 494
 495                         XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
 496                                           SDATA (format2 ("%s", object, Qnil)));
 497                         if (!dbus_message_iter_open_container (iter, dtype,
 498                                                                signature, &subiter))
 499                                 XD_SIGNAL3 (build_string ("Cannot open container"),
 500                                             make_number (dtype), build_string (signature));
 501                         break;
 502
 503                 case DBUS_TYPE_VARIANT:
 504                         /* A variant has just one element.  */
 505                         xd_signature (signature, XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)),
 506                                       dtype, CAR_SAFE (XD_NEXT_VALUE (object)));
 507
 508                         XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
 509                                           SDATA (format2 ("%s", object, Qnil)));
 510                         if (!dbus_message_iter_open_container (iter, dtype,
 511                                                                signature, &subiter))
 512                                 XD_SIGNAL3 (build_string ("Cannot open container"),
 513                                             make_number (dtype), build_string (signature));
 514                         break;
 515
 516                 case DBUS_TYPE_STRUCT:
 517                 case DBUS_TYPE_DICT_ENTRY:
 518                         /* These containers do not require a signature.  */
 519                         XD_DEBUG_MESSAGE ("%c %s", dtype,
 520                                           SDATA (format2 ("%s", object, Qnil)));
 521                         if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
 522                                 XD_SIGNAL2 (build_string ("Cannot open container"),
 523                                             make_number (dtype));
 524                         break;
 525                 }
 526
 527                 /* Loop over list elements.  */
 528                 while (!NILP (object))
 529                 {
 530                         dtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object));
 531                         object = XD_NEXT_VALUE (object);
 532
 533                         xd_append_arg (dtype, CAR_SAFE (object), &subiter);
 534
 535                         object = CDR_SAFE (object);
 536                 }
 537
 538                 /* Close the subiteration.  */
 539                 if (!dbus_message_iter_close_container (iter, &subiter))
 540                         XD_SIGNAL2 (build_string ("Cannot close container"),
 541                                     make_number (dtype));
 542         }
 543 }
 544
 545 /* Retrieve C value from a DBusMessageIter structure ITER, and return
 546    a converted Lisp object.  The type DTYPE of the argument of the
 547    D-Bus message must be a valid DBusType.  Compound D-Bus types
 548    result always in a Lisp list.  */
 549 static Lisp_Object
 550 xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter)
 551 {
 552
 553         switch (dtype)
 554         {
 555         case DBUS_TYPE_BYTE:
 556         {
 557                 unsigned int val;
 558                 dbus_message_iter_get_basic (iter, &val);
 559                 val = val & 0xFF;
 560                 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 561                 return make_number (val);
 562         }
 563
 564         case DBUS_TYPE_BOOLEAN:
 565         {
 566                 dbus_bool_t val;
 567                 dbus_message_iter_get_basic (iter, &val);
 568                 XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
 569                 return (val == FALSE) ? Qnil : Qt;
 570         }
 571
 572         case DBUS_TYPE_INT16:
 573         {
 574                 dbus_int16_t val;
 575                 dbus_message_iter_get_basic (iter, &val);
 576                 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 577                 return make_number (val);
 578         }
 579
 580         case DBUS_TYPE_UINT16:
 581         {
 582                 dbus_uint16_t val;
 583                 dbus_message_iter_get_basic (iter, &val);
 584                 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 585                 return make_number (val);
 586         }
 587
 588         case DBUS_TYPE_INT32:
 589         {
 590                 dbus_int32_t val;
 591                 dbus_message_iter_get_basic (iter, &val);
 592                 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 593                 return make_fixnum_or_float (val);
 594         }
 595
 596         case DBUS_TYPE_UINT32:
 597 #ifdef DBUS_TYPE_UNIX_FD
 598         case DBUS_TYPE_UNIX_FD:
 599 #endif
 600         {
 601                 dbus_uint32_t val;
 602                 dbus_message_iter_get_basic (iter, &val);
 603                 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 604                 return make_fixnum_or_float (val);
 605         }
 606
 607         case DBUS_TYPE_INT64:
 608         {
 609                 dbus_int64_t val;
 610                 dbus_message_iter_get_basic (iter, &val);
 611                 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
 612                 return make_fixnum_or_float (val);
 613         }
 614
 615         case DBUS_TYPE_UINT64:
 616         {
 617                 dbus_uint64_t val;
 618                 dbus_message_iter_get_basic (iter, &val);
 619                 XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
 620                 return make_fixnum_or_float (val);
 621         }
 622
 623         case DBUS_TYPE_DOUBLE:
 624         {
 625                 double val;
 626                 dbus_message_iter_get_basic (iter, &val);
 627                 XD_DEBUG_MESSAGE ("%c %f", dtype, val);
 628                 return make_float (val);
 629         }
 630
 631         case DBUS_TYPE_STRING:
 632         case DBUS_TYPE_OBJECT_PATH:
 633         case DBUS_TYPE_SIGNATURE:
 634         {
 635                 char *val;
 636                 dbus_message_iter_get_basic (iter, &val);
 637                 XD_DEBUG_MESSAGE ("%c %s", dtype, val);
 638                 return build_string (val);
 639         }
 640
 641         case DBUS_TYPE_ARRAY:
 642         case DBUS_TYPE_VARIANT:
 643         case DBUS_TYPE_STRUCT:
 644         case DBUS_TYPE_DICT_ENTRY:
 645         {
 646                 Lisp_Object result;
 647                 struct gcpro gcpro1;
 648                 DBusMessageIter subiter;
 649                 int subtype;
 650                 result = Qnil;
 651                 GCPRO1 (result);
 652                 dbus_message_iter_recurse (iter, &subiter);
 653                 while ((subtype = dbus_message_iter_get_arg_type (&subiter))
 654                        != DBUS_TYPE_INVALID)
 655                 {
 656                         result = Fcons (xd_retrieve_arg (subtype, &subiter), result);
 657                         dbus_message_iter_next (&subiter);
 658                 }
 659                 XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (format2 ("%s", result, Qnil)));
 660        &n