bug#20193: 25.0.50; declarative type specification for D-Bus args

[Daiki Ueno]

Michael Albinus <michael.albinus@gmx.de> writes:

> Daiki Ueno <ueno@gnu.org> writes:
>
>> Certainly.  Do you have any preference on the alternative form?  My
>> example used the `:type' keyword, but it was a tentative plan and might
>> be too verbose for programmers.  Reusing `:signature' might be a better
>> idea as you mentioned (though it might be confusing with the current
>> meaning of `:signature' as a D-Bus type "g").
>
> I'm OK with :type, as you said it is similar to what defcustom
> offers. :signature would be confusing indeed, when it means Lisp
> objects instead of a signature string.

Sorry for the long delay.  I have tried to implement it (patch
attached).  It basically adds a couple of new functions:

- xd_type_spec_to_signature(char *, Lisp_Object)
- xd_append_arg_with_type_spec(Lisp_Object, Lisp_Object, DBusMessageIter *)

which are similar to xd_signature and xd_append_arg, but take a
Lisp_Object denoting an argument type.

Comments appreciated.

Regards,
-- 
Daiki Ueno

>From 064aaaadd84310e4fd9beaa3d5c0fb74a70c4e92 Mon Sep 17 00:00:00 2001
From: Daiki Ueno <ueno@gnu.org>
Date: Thu, 27 Aug 2015 17:06:19 +0900
Subject: [PATCH] dbusbind: Add alternative form for compound args

* src/dbusbind.c (xd_append_basic_arg): New function, split from
xd_append_arg.
(xd_append_arg): Use xd_append_arg.
(xd_type_spec_to_signature): New function.
(xd_append_arg_with_type_spec): New function.
(Fdbus_message_internal): Use xd_append_arg_with_type_spec,
instead of xd_append_arg.
(syms_of_dbusbind): Provide subfeature `:type'.
* doc/misc/dbus.texi (Type Conversion): Mention `:type' keyword.

Fixes: debbugs:20193
---
 doc/misc/dbus.texi |  17 ++++-
 src/dbusbind.c     | 199 ++++++++++++++++++++++++++++++++++++++++++++++++++---
 2 files changed, 204 insertions(+), 12 deletions(-)

diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi
index 5dd8bf2..03feecc 100644
--- a/doc/misc/dbus.texi
+++ b/doc/misc/dbus.texi
@@ -1030,7 +1030,22 @@ corresponding D-Bus container.  @code{:array} is 
optional, because
 this is the default compound D-Bus type for a list.
 
 The objects being elements of the list are checked according to the
-D-Bus compound type rules.
+D-Bus compound type rules.  If those elements have a type different
+from the default type, they need to be prefixed with a type symbol.
+
+@lisp
+(dbus-call-method @dots{} :array '(:int32 @var{NAT-NUMBER} :int32 
@var{NAT-NUMBER}))
+@end lisp
+
+There is an alternative form to specify the type of the following
+compound type argument, using the keyword @code{:type} followed by a
+type specifier, which denotes a compound type as a list of type symbols.
+
+The above example is equivalent to:
+
+@lisp
+(dbus-call-method @dots{} :type '(:array :int32) '(@var{NAT-NUMBER} 
@var{NAT-NUMBER}))
+@end lisp
 
 @itemize
 @item An array must contain only elements of the same D-Bus type.  It
diff --git a/src/dbusbind.c b/src/dbusbind.c
index be1b890..81b6c27 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -567,18 +567,9 @@ xd_extract_unsigned (Lisp_Object x, uintmax_t hi)
     args_out_of_range_3 (x, make_number (0), make_fixnum_or_float (hi));
 }
 
-/* Append C value, extracted from Lisp OBJECT, to iteration ITER.
-   DTYPE must be a valid DBusType.  It is used to convert Lisp
-   objects, being arguments of `dbus-call-method' or
-   `dbus-send-signal', into corresponding C values appended as
-   arguments to a D-Bus message.  */
 static void
-xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter)
+xd_append_basic_arg (int dtype, Lisp_Object object, DBusMessageIter *iter)
 {
-  char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
-  DBusMessageIter subiter;
-
-  if (XD_BASIC_DBUS_TYPE (dtype))
   switch (dtype)
     {
     case DBUS_TYPE_BYTE:
@@ -703,7 +694,21 @@ xd_append_arg (int dtype, Lisp_Object object, 
DBusMessageIter *iter)
        return;
       }
     }
+}
+
+/* Append C value, extracted from Lisp OBJECT, to iteration ITER.
+   DTYPE must be a valid DBusType.  It is used to convert Lisp
+   objects, being arguments of `dbus-call-method' or
+   `dbus-send-signal', into corresponding C values appended as
+   arguments to a D-Bus message.  */
+static void
+xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter)
+{
+  char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
+  DBusMessageIter subiter;
 
+  if (XD_BASIC_DBUS_TYPE (dtype))
+    xd_append_basic_arg (dtype, object, iter);
   else /* Compound types.  */
     {
 
@@ -792,6 +797,161 @@ xd_append_arg (int dtype, Lisp_Object object, 
DBusMessageIter *iter)
     }
 }
 
+static void
+xd_type_spec_to_signature (char *signature, Lisp_Object spec)
+{
+  int dtype;
+
+  if (SYMBOLP (spec))
+    {
+      dtype = xd_symbol_to_dbus_type (spec);
+      if (!XD_BASIC_DBUS_TYPE (dtype))
+       wrong_type_argument (intern ("D-Bus"), spec);
+      sprintf (signature, "%c", dtype);
+    }
+  else /* Compound types.  */
+    {
+      char *subsig;
+      char x[DBUS_MAXIMUM_SIGNATURE_LENGTH];
+      Lisp_Object elt;
+
+      CHECK_CONS (spec);
+
+      dtype = xd_symbol_to_dbus_type (CAR (spec));
+      elt = CDR_SAFE (spec);
+
+      switch (dtype)
+       {
+       case DBUS_TYPE_ARRAY:
+         sprintf (signature, "%c", dtype);
+         if (NILP (elt))
+           /* If the array is empty, DBUS_TYPE_STRING is the default
+              element type.  */
+           subsig = DBUS_TYPE_STRING_AS_STRING;
+         else
+           {
+             xd_type_spec_to_signature (x, CAR_SAFE (elt));
+             subsig = x;
+           }
+         xd_signature_cat (signature, subsig);
+         break;
+
+       case DBUS_TYPE_VARIANT:
+         sprintf (signature, "%c", dtype);
+         break;
+
+       case DBUS_TYPE_STRUCT:
+         sprintf (signature, "%c", DBUS_STRUCT_BEGIN_CHAR);
+         while (!NILP (elt))
+           {
+             xd_type_spec_to_signature (x, CAR_SAFE (elt));
+             xd_signature_cat (signature, x);
+             elt = CDR_SAFE (elt);
+           }
+         xd_signature_cat (signature, DBUS_STRUCT_END_CHAR_AS_STRING);
+         break;
+
+       case DBUS_TYPE_DICT_ENTRY:
+         sprintf (signature, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR);
+         while (!NILP (elt))
+           {
+             xd_type_spec_to_signature (x, CAR_SAFE (elt));
+             xd_signature_cat (signature, x);
+             elt = CDR_SAFE (elt);
+           }
+         xd_signature_cat (signature, DBUS_DICT_ENTRY_END_CHAR_AS_STRING);
+         break;
+
+       default:
+         wrong_type_argument (intern ("D-Bus"), spec);
+       }
+    }
+}
+
+static void
+xd_append_arg_with_type_spec (Lisp_Object spec, Lisp_Object object,
+                             DBusMessageIter *iter)
+{
+  int dtype;
+
+  if (SYMBOLP (spec))
+    {
+      dtype = xd_symbol_to_dbus_type (spec);
+      if (!XD_BASIC_DBUS_TYPE (dtype))
+       wrong_type_argument (intern ("D-Bus"), spec);
+      xd_append_basic_arg (dtype, object, iter);
+    }
+  else /* Compound types.  */
+    {
+      char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
+      DBusMessageIter subiter;
+      int subtype;
+      Lisp_Object subspec;
+      Lisp_Object elt;
+
+      CHECK_CONS (spec);
+
+      dtype = xd_symbol_to_dbus_type (CAR (spec));
+      elt = CDR_SAFE (spec);
+
+      /* Open new subiteration.  */
+      switch (dtype)
+       {
+       case DBUS_TYPE_ARRAY:
+         if (NILP (elt))
+           /* If the array is empty, DBUS_TYPE_STRING is the default
+              element type.  */
+           subspec = QCdbus_type_string;
+         else
+           subspec = CAR_SAFE (elt);
+         xd_type_spec_to_signature (signature, subspec);
+         if (!dbus_message_iter_open_container (iter, dtype,
+                                                signature, &subiter))
+           XD_SIGNAL3 (build_string ("Cannot open container"),
+                       make_number (dtype), build_string (signature));
+         break;
+
+       case DBUS_TYPE_VARIANT:
+         /* A variant has just one element.  */
+         subspec = CAR_SAFE (elt);
+         xd_type_spec_to_signature (signature, subspec);
+
+         if (!dbus_message_iter_open_container (iter, dtype,
+                                                signature, &subiter))
+           XD_SIGNAL3 (build_string ("Cannot open container"),
+                       make_number (dtype), build_string (signature));
+         break;
+
+       case DBUS_TYPE_STRUCT:
+       case DBUS_TYPE_DICT_ENTRY:
+         /* These containers do not require a signature.  */
+         subspec = CAR_SAFE (elt);
+         xd_type_spec_to_signature (signature, subspec);
+
+         if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
+           XD_SIGNAL2 (build_string ("Cannot open container"),
+                       make_number (dtype));
+         break;
+
+       default:
+         wrong_type_argument (intern ("D-Bus"), list2 (spec, object));
+       }
+
+      /* Loop over list elements.  */
+      while (!NILP (object))
+       {
+         xd_append_arg_with_type_spec (subspec, CAR_SAFE (object), &subiter);
+
+         object = CDR_SAFE (object);
+       }
+
+      /* Close the subiteration.  */
+      if (!dbus_message_iter_close_container (iter, &subiter))
+       XD_SIGNAL2 (build_string ("Cannot close container"),
+                   make_number (dtype));
+    }
+}
+
 /* Retrieve C value from a DBusMessageIter structure ITER, and return
    a converted Lisp object.  The type DTYPE of the argument of the
    D-Bus message must be a valid DBusType.  Compound D-Bus types
@@ -1443,6 +1603,13 @@ usage: (dbus-message-internal &rest REST)  */)
   /* Append parameters to the message.  */
   for (; count < nargs; ++count)
     {
+      if (EQ (args[count], QCdbus_type_type))
+       {
+         xd_append_arg_with_type_spec (args[count+1], args[count+2], &iter);
+         count += 2;
+       }
+      else
+       {
          dtype = XD_OBJECT_TO_DBUS_TYPE (args[count]);
          if (XD_DBUS_TYPE_P (args[count]))
            {
@@ -1466,6 +1633,7 @@ usage: (dbus-message-internal &rest REST)  */)
 
          xd_append_arg (dtype, args[count], &iter);
        }
+    }
 
   if (!NILP (handler))
     {
@@ -1718,6 +1886,8 @@ init_dbusbind (void)
 void
 syms_of_dbusbind (void)
 {
+  Lisp_Object subfeatures = Qnil;
+
   defsubr (&Sdbus__init_bus);
   defsubr (&Sdbus_get_unique_name);
 
@@ -1759,6 +1929,9 @@ syms_of_dbusbind (void)
   DEFSYM (QCdbus_type_struct, ":struct");
   DEFSYM (QCdbus_type_dict_entry, ":dict-entry");
 
+  /* Lisp symbol to indicate explicit typing of the following parameter.  */
+  DEFSYM (QCdbus_type_type, ":type");
+
   /* Lisp symbols of objects in `dbus-registered-objects-table'.  */
   DEFSYM (QCdbus_registered_serial, ":serial");
   DEFSYM (QCdbus_registered_method, ":method");
@@ -1866,7 +2039,11 @@ be called when the D-Bus reply message arrives.  */);
   xd_registered_buses = Qnil;
   staticpro (&xd_registered_buses);
 
-  Fprovide (intern_c_string ("dbusbind"), Qnil);
+  /* Add subfeature `:type'.  */
+  subfeatures = pure_cons (pure_cons (QCdbus_type_type, pure_cons (Qt, Qnil)),
+                          subfeatures);
+
+  Fprovide (intern_c_string ("dbusbind"), subfeatures);
 
 }
 
-- 
2.4.3