changeset 87490:5db1ff3b9244

* dbusbind.c: Fix several errors and compiler warnings. Reported by Tom Tromey <[e-mail]> (XD_ERROR, XD_DEBUG_MESSAGE) (XD_DEBUG_VALID_LISP_OBJECT_P): Wrap code with "do ... while (0)". (xd_append_arg): Part for basic D-Bus types rewitten. (xd_retrieve_arg): Split implementation of DBUS_TYPE_BYTE and DBUS_TYPE_(U)INT16. Don't call XD_DEBUG_MESSAGE with "%f" if not appropriate. (xd_read_message): Return Qnil. Don't signal an error; it is not useful during event reading. (Fdbus_register_signal): Signal an error if the check for FUNCTIONP fails. (Fdbus_register_method): New function. The implementation is not complete, the call of the function signals an error therefore. (Fdbus_unregister_object): New function, renamed from Fdbus_unregister_signal. The initial check signals an error, if it the objct is not well formed.

--- a/src/ChangeLog	Sun Dec 30 13:42:10 2007 +0000
+++ b/src/ChangeLog	Sun Dec 30 15:41:47 2007 +0000
@@ -1,3 +1,23 @@
[phone]  Michael Albinus  <[e-mail]>
+
+	* dbusbind.c: Fix several errors and compiler warnings.  Reported
+	by Tom Tromey <[e-mail]>
+	(XD_ERROR, XD_DEBUG_MESSAGE)
+	(XD_DEBUG_VALID_LISP_OBJECT_P): Wrap code with "do ... while (0)".
+	(xd_append_arg): Part for basic D-Bus types rewitten.
+	(xd_retrieve_arg): Split implementation of DBUS_TYPE_BYTE and
+	DBUS_TYPE_(U)INT16.  Don't call XD_DEBUG_MESSAGE with "%f" if not
+	appropriate.
+	(xd_read_message): Return Qnil.  Don't signal an error; it is not
+	useful during event reading.
+	(Fdbus_register_signal): Signal an error if the check for
+	FUNCTIONP fails.
+	(Fdbus_register_method): New function.  The implementation is not
+	complete, the call of the function signals an error therefore.
+	(Fdbus_unregister_object): New function, renamed from
+	Fdbus_unregister_signal.  The initial check signals an error, if
+	it the objct is not well formed.
+
 2007-12-30  Richard Stallman  <[e-mail]>
 
 	* textprop.c (get_char_property_and_overlay):

--- a/src/dbusbind.c	Sun Dec 30 13:42:10 2007 +0000
+++ b/src/dbusbind.c	Sun Dec 30 15:41:47 2007 +0000
@@ -35,7 +35,8 @@
 Lisp_Object Qdbus_call_method;
 Lisp_Object Qdbus_send_signal;
 Lisp_Object Qdbus_register_signal;
-Lisp_Object Qdbus_unregister_signal;
+Lisp_Object Qdbus_register_method;
+Lisp_Object Qdbus_unregister_object;
 
 /* D-Bus error symbol.  */
 Lisp_Object Qdbus_error;
@@ -65,7 +66,7 @@
 
 /* Raise a Lisp error from a D-Bus ERROR.  */
 #define XD_ERROR(error)							\
-  {									\
+  do {									\
     char s[1024];							\
     strcpy (s, error.message);						\
     dbus_error_free (&error);						\
@@ -73,33 +74,37 @@
     if (strchr (s, '\n') != NULL)					\
       s[strlen (s) - 1] = '\0';						\
     xsignal1 (Qdbus_error, build_string (s));				\
-  }
+  } while (0)
 
 /* Macros for debugging.  In order to enable them, build with
-   "make MYCPPFLAGS='-DDBUS_DEBUG'".  */
+   "make MYCPPFLAGS='-DDBUS_DEBUG -Wall'".  */
 #ifdef DBUS_DEBUG
 #define XD_DEBUG_MESSAGE(...)		\
-  {					\
+  do {					\
     char s[1024];			\
     sprintf (s, __VA_ARGS__);		\
     printf ("%s: %s\n", __func__, s);	\
     message ("%s: %s", __func__, s);	\
-  }
+  } while (0)
 #define XD_DEBUG_VALID_LISP_OBJECT_P(object)				\
-  if (!valid_lisp_object_p (object))					\
-    {									\
-      XD_DEBUG_MESSAGE ("%s Assertion failure", __LINE__);		\
-      xsignal1 (Qdbus_error, build_string ("Assertion failure"));	\
-    }
+  do {									\
+    if (!valid_lisp_object_p (object))					\
+      {									\
+	XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__);		\
+	xsignal1 (Qdbus_error, build_string ("Assertion failure"));	\
+      }									\
+  } while (0)
 
 #else /* !DBUS_DEBUG */
-#define XD_DEBUG_MESSAGE(...)		\
-  if (!NILP (Vdbus_debug))		\
-    {					\
-      char s[1024];			\
-      sprintf (s, __VA_ARGS__);		\
-      message ("%s: %s", __func__, s);	\
-    }
+#define XD_DEBUG_MESSAGE(...)						\
+  do {									\
+    if (!NILP (Vdbus_debug))						\
+      {									\
+	char s[1024];							\
+	sprintf (s, __VA_ARGS__);					\
+	message ("%s: %s", __func__, s);				\
+      }
+  } while (0)
 #define XD_DEBUG_VALID_LISP_OBJECT_P(object)
 #endif
 
@@ -328,75 +333,112 @@
      Lisp_Object object;
      DBusMessageIter *iter;
 {
-  Lisp_Object elt;
   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
   DBusMessageIter subiter;
-  char *value;
-
-  XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (format2 ("%s", object, Qnil)));
 
   if (XD_BASIC_DBUS_TYPE (dtype))
-    {
-      switch (dtype)
+    switch (dtype)
+      {
+      case DBUS_TYPE_BYTE:
 	{
-	case DBUS_TYPE_BYTE:
-	  XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object));
-	  value = (unsigned char *) XUINT (object);
-	  break;
-
-	case DBUS_TYPE_BOOLEAN:
-	  XD_DEBUG_MESSAGE ("%c %s", dtype, (NILP (object)) ? "false" : "true");
-	  value = (NILP (object))
-	    ? (unsigned char *) FALSE : (unsigned char *) TRUE;
-	  break;
-
-	case DBUS_TYPE_INT16:
-	  XD_DEBUG_MESSAGE ("%c %d", dtype, XINT (object));
-	  value = (char *) (dbus_int16_t *) XINT (object);
-	  break;
-
-	case DBUS_TYPE_UINT16:
-	  XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object));
-	  value = (char *) (dbus_uint16_t *) XUINT (object);
-	  break;
+	  unsigned int val = XUINT (object) & 0xFF;
+	  XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+	  if (!dbus_message_iter_append_basic (iter, dtype, &val))
+	    xsignal2 (Qdbus_error,
+		      build_string ("Unable to append argument"), object);
+	  return;
+	}
 
-	case DBUS_TYPE_INT32:
-	  XD_DEBUG_MESSAGE ("%c %d", dtype, XINT (object));
-	  value = (char *) (dbus_int32_t *) XINT (object);
-	  break;
-
-	case DBUS_TYPE_UINT32:
-	  XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object));
-	  value = (char *) (dbus_uint32_t *) XUINT (object);
-	  break;
-
-	case DBUS_TYPE_INT64:
-	  XD_DEBUG_MESSAGE ("%c %d", dtype, XINT (object));
-	  value = (char *) (dbus_int64_t *) XINT (object);
-	  break;
+      case DBUS_TYPE_BOOLEAN:
+	{
+	  dbus_bool_t val = (NILP (object)) ? FALSE : TRUE;
+	  XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
+	  if (!dbus_message_iter_append_basic (iter, dtype, &val))
+	    xsignal2 (Qdbus_error,
+		      build_string ("Unable to append argument"), object);
+	  return;
+	}
 
-	case DBUS_TYPE_UINT64:
-	  XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object));
-	  value = (char *) (dbus_int64_t *) XUINT (object);
-	  break;
+      case DBUS_TYPE_INT16:
+	{
+	  dbus_int16_t val = XINT (object);
+	  XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
+	  if (!dbus_message_iter_append_basic (iter, dtype, &val))
+	    xsignal2 (Qdbus_error,
+		      build_string ("Unable to append argument"), object);
+	  return;
+	}
 
-	case DBUS_TYPE_DOUBLE:
-	  XD_DEBUG_MESSAGE ("%c %f", dtype, XFLOAT (object));
-	  value = (char *) (float *) XFLOAT (object);
-	  break;
-
-	case DBUS_TYPE_STRING:
-	case DBUS_TYPE_OBJECT_PATH:
-	case DBUS_TYPE_SIGNATURE:
-	  XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (object));
-	  value = SDATA (object);
-	  break;
+      case DBUS_TYPE_UINT16:
+	{
+	  dbus_uint16_t val = XUINT (object);
+	  XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
+	  if (!dbus_message_iter_append_basic (iter, dtype, &val))
+	    xsignal2 (Qdbus_error,
+		      build_string ("Unable to append argument"), object);
+	  return;
 	}
 
-      if (!dbus_message_iter_append_basic (iter, dtype, &value))
-	xsignal2 (Qdbus_error,
-		  build_string ("Unable to append argument"), object);
-    }
+      case DBUS_TYPE_INT32:
+	{
+	  dbus_int32_t val = XINT (object);
+	  XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+	  if (!dbus_message_iter_append_basic (iter, dtype, &val))
+	    xsignal2 (Qdbus_error,
+		      build_string ("Unable to append argument"), object);
+	  return;
+	}
+
+      case DBUS_TYPE_UINT32:
+	{
+	  dbus_uint32_t val = XUINT (object);
+	  XD_DEBUG_MESSAGE ("%c %u", dtype, val);
+	  if (!dbus_message_iter_append_basic (iter, dtype, &val))
+	    xsignal2 (Qdbus_error,
+		      build_string ("Unable to append argument"), object);
+	  return;
+	}
+
+      case DBUS_TYPE_INT64:
+	{
+	  dbus_int64_t val = XINT (object);
+	  XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
+	  if (!dbus_message_iter_append_basic (iter, dtype, &val))
+	    xsignal2 (Qdbus_error,
+		      build_string ("Unable to append argument"), object);
+	  return;
+	}
+
+      case DBUS_TYPE_UINT64:
+	{
+	  dbus_uint64_t val = XUINT (object);
+	  XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val);
+	  if (!dbus_message_iter_append_basic (iter, dtype, &val))
+	    xsignal2 (Qdbus_error,
+		      build_string ("Unable to append argument"), object);
+	  return;
+	}
+
+      case DBUS_TYPE_DOUBLE:
+	XD_DEBUG_MESSAGE ("%c %f", dtype, XFLOAT_DATA (object));
+	if (!dbus_message_iter_append_basic (iter, dtype,
+					     &XFLOAT_DATA (object)))
+	  xsignal2 (Qdbus_error,
+		    build_string ("Unable to append argument"), object);
+	return;
+
+      case DBUS_TYPE_STRING:
+      case DBUS_TYPE_OBJECT_PATH:
+      case DBUS_TYPE_SIGNATURE:
+	{
+	  char *val = SDATA (object);
+	  XD_DEBUG_MESSAGE ("%c %s", dtype, val);
+	  if (!dbus_message_iter_append_basic (iter, dtype, &val))
+	    xsignal2 (Qdbus_error,
+		      build_string ("Unable to append argument"), object);
+	  return;
+	}
+      }
 
   else /* Compound types.  */
     {
@@ -470,11 +512,10 @@
   switch (dtype)
     {
     case DBUS_TYPE_BYTE:
-    case DBUS_TYPE_INT16:
-    case DBUS_TYPE_UINT16:
       {
-	dbus_uint16_t val;
+	unsigned int val;
 	dbus_message_iter_get_basic (iter, &val);
+	val = val & 0xFF;
 	XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 	return make_number (val);
       }
@@ -487,15 +528,21 @@
 	return (val == FALSE) ? Qnil : Qt;
       }
 
+    case DBUS_TYPE_INT16:
+    case DBUS_TYPE_UINT16:
+      {
+	dbus_uint16_t val;
+	dbus_message_iter_get_basic (iter, &val);
+	XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+	return make_number (val);
+      }
+
     case DBUS_TYPE_INT32:
     case DBUS_TYPE_UINT32:
       {
 	dbus_uint32_t val;
 	dbus_message_iter_get_basic (iter, &val);
-	if (FIXNUM_OVERFLOW_P (val))
-	  XD_DEBUG_MESSAGE ("%c %f", dtype, val)
-	else
-	  XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+	XD_DEBUG_MESSAGE ("%c %d", dtype, val);
 	return make_fixnum_or_float (val);
       }
 
@@ -504,10 +551,7 @@
       {
 	dbus_uint64_t val;
 	dbus_message_iter_get_basic (iter, &val);
-	if (FIXNUM_OVERFLOW_P (val))
-	  XD_DEBUG_MESSAGE ("%c %f", dtype, val)
-	else
-	  XD_DEBUG_MESSAGE ("%c %d", dtype, val);
+	XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val);
 	return make_fixnum_or_float (val);
       }
 
@@ -923,6 +967,7 @@
   DBusMessage *dmessage;
   DBusMessageIter iter;
   unsigned int dtype;
+  int mtype;
   char uname[DBUS_MAXIMUM_NAME_LENGTH];
   char path[DBUS_MAXIMUM_MATCH_RULE_LENGTH]; /* Unlimited in D-Bus spec.  */
   char interface[DBUS_MAXIMUM_NAME_LENGTH];
@@ -937,38 +982,37 @@
 
   /* Return if there is no queued message.  */
   if (dmessage == NULL)
-    return;
-
-  XD_DEBUG_MESSAGE ("Event received");
+    return Qnil;
 
   /* Collect the parameters.  */
   args = Qnil;
   GCPRO1 (args);
 
-  if (!dbus_message_iter_init (dmessage, &iter))
+  /* Loop over the resulting parameters.  Construct a list.  */
+  if (dbus_message_iter_init (dmessage, &iter))
     {
-      UNGCPRO;
-      XD_DEBUG_MESSAGE ("Cannot read event");
-      return;
+      while ((dtype = dbus_message_iter_get_arg_type (&iter))
+	     != DBUS_TYPE_INVALID)
+	{
+	  args = Fcons (xd_retrieve_arg (dtype, &iter), args);
+	  dbus_message_iter_next (&iter);
+	}
+      /* The arguments are stored in reverse order.  Reorder them.  */
+      args = Fnreverse (args);
     }
 
-  /* Loop over the resulting parameters.  Construct a list.  */
-  while ((dtype = dbus_message_iter_get_arg_type (&iter)) != DBUS_TYPE_INVALID)
-    {
-      args = Fcons (xd_retrieve_arg (dtype, &iter), args);
-      dbus_message_iter_next (&iter);
-    }
-
-  /* The arguments are stored in reverse order.  Reorder them.  */
-  args = Fnreverse (args);
-
-  /* Read unique name, object path, interface and member from the
-     message.  */
+  /* Read message type, unique name, object path, interface and member
+     from the message.  */
+  mtype =            dbus_message_get_type (dmessage);
   strcpy (uname,     dbus_message_get_sender (dmessage));
   strcpy (path,      dbus_message_get_path (dmessage));
   strcpy (interface, dbus_message_get_interface (dmessage));
   strcpy (member,    dbus_message_get_member (dmessage));
 
+  XD_DEBUG_MESSAGE ("Event received: %d %s %s %s %s %s",
+		    mtype, uname, path, interface, member,
+		    SDATA (format2 ("%s", args, Qnil)));
+
   /* Search for a registered function of the message.  */
   key = list3 (bus, build_string (interface), build_string (member));
   value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
@@ -1013,7 +1057,7 @@
 
   /* Cleanup.  */
   dbus_message_unref (dmessage);
-  UNGCPRO;
+  RETURN_UNGCPRO (Qnil);
 }
 
 /* Read queued incoming messages from the system and session buses.  */
@@ -1064,11 +1108,11 @@
       ("org.freedesktop.Hal" "/org/freedesktop/Hal/Manager" my-signal-handler))
 
 `dbus-register-signal' returns an object, which can be used in
-`dbus-unregister-signal' for removing the registration.  */)
+`dbus-unregister-object' for removing the registration.  */)
      (bus, service, path, interface, signal, handler)
      Lisp_Object bus, service, path, interface, signal, handler;
 {
-  Lisp_Object uname, key, value;
+  Lisp_Object uname, key, key1, value;
   DBusConnection *connection;
   char rule[DBUS_MAXIMUM_MATCH_RULE_LENGTH];
   DBusError derror;
@@ -1079,7 +1123,8 @@
   if (!NILP (path)) CHECK_STRING (path);
   CHECK_STRING (interface);
   CHECK_STRING (signal);
-  FUNCTIONP (handler);
+  if (!FUNCTIONP (handler))
+    wrong_type_argument (intern ("functionp"), handler);
 
   /* Retrieve unique name of service.  If service is a known name, we
      will register for the corresponding unique name, if any.  Signals
@@ -1130,21 +1175,84 @@
 
   /* Create a hash table entry.  */
   key = list3 (bus, interface, signal);
+  key1 = list4 (uname, service, path, handler);
   value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
 
-  if (NILP (Fmember (list4 (uname, service, path, handler), value)))
-    Fputhash (key,
-	      Fcons (list4 (uname, service, path, handler), value),
-	      Vdbus_registered_functions_table);
+  if (NILP (Fmember (key1, value)))
+    Fputhash (key, Fcons (key1, value), Vdbus_registered_functions_table);
 
   /* Return object.  */
   return list2 (key, list3 (service, path, handler));
 }
 
-DEFUN ("dbus-unregister-signal", Fdbus_unregister_signal, Sdbus_unregister_signal,
+DEFUN ("dbus-register-method", Fdbus_register_method, Sdbus_register_method,
+       6, 6, 0,
+       doc: /* Register for method METHOD on the D-Bus BUS.
+
+BUS is either the symbol `:system' or the symbol `:session'.
+
+SERVICE is the D-Bus service name of the D-Bus object METHOD is
+registered for.  It must be a known name.
+
+PATH is the D-Bus object path SERVICE is registered.  INTERFACE is the
+interface offered by SERVICE.  It must provide METHOD.  HANDLER is a
+Lisp function to be called when a method call is received.  It must
+accept the input arguments of METHOD.  The return value of HANDLER is
+used for composing the returning D-Bus message.
+
+The function is not fully implemented and documented.  Don't use it.  */)
+     (bus, service, path, interface, method, handler)
+     Lisp_Object bus, service, path, interface, method, handler;
+{
+  Lisp_Object key, key1, value;
+  DBusConnection *connection;
+  int result;
+  DBusError derror;
+
+  if (NILP (Vdbus_debug))
+    xsignal1 (Qdbus_error, build_string ("Not implemented yet"));
+
+  /* Check parameters.  */
+  CHECK_SYMBOL (bus);
+  CHECK_STRING (service);
+  CHECK_STRING (path);
+  CHECK_STRING (interface);
+  CHECK_STRING (method);
+  if (!FUNCTIONP (handler))
+    wrong_type_argument (intern ("functionp"), handler);
+  /* TODO: We must check for a valid service name, otherwise there is
+     a segmentation fault.  */
+
+  /* Open a connection to the bus.  */
+  connection = xd_initialize (bus);
+
+  /* Request the known name from the bus.  We can ignore the result,
+     it is set to -1 if there is an error - kind of redundancy.  */
+  dbus_error_init (&derror);
+  result = dbus_bus_request_name (connection, SDATA (service), 0, &derror);
+  if (dbus_error_is_set (&derror))
+    XD_ERROR (derror);
+
+  /* Create a hash table entry.  */
+  key = list3 (bus, interface, method);
+  key1 = list4 (Qnil, service, path, handler);
+  value = Fgethash (key, Vdbus_registered_functions_table, Qnil);
+
+  /* We use nil for the unique name, because the method might be
+     called from everybody.  */
+  if (NILP (Fmember (key1, value)))
+    Fputhash (key, Fcons (key1, value), Vdbus_registered_functions_table);
+
+  /* Return object.  */
+  return list2 (key, list3 (service, path, handler));
+}
+
+DEFUN ("dbus-unregister-object", Fdbus_unregister_object, Sdbus_unregister_object,
        1, 1, 0,
        doc: /* Unregister OBJECT from the D-Bus.
-OBJECT must be the result of a preceding `dbus-register-signal' call.  */)
+OBJECT must be the result of a preceding `dbus-register-signal' or
+`dbus-register-method' call.  It returns t if OBJECT has been
+unregistered, nil otherwise.  */)
      (object)
      Lisp_Object object;
 {
@@ -1152,7 +1260,8 @@
   struct gcpro gcpro1;
 
   /* Check parameter.  */
-  CONSP (object) && (!NILP (XCAR (object))) && CONSP (XCDR (object));
+  if (!(CONSP (object) && (!NILP (XCAR (object))) && CONSP (XCDR (object))))
+    wrong_type_argument (intern ("D-Bus"), object);
 
   /* Find the corresponding entry in the hash table.  */
   value = Fgethash (XCAR (object), Vdbus_registered_functions_table, Qnil);
@@ -1205,9 +1314,13 @@
   staticpro (&Qdbus_register_signal);
   defsubr (&Sdbus_register_signal);
 
-  Qdbus_unregister_signal = intern ("dbus-unregister-signal");
-  staticpro (&Qdbus_unregister_signal);
-  defsubr (&Sdbus_unregister_signal);
+  Qdbus_register_method = intern ("dbus-register-method");
+  staticpro (&Qdbus_register_method);
+  defsubr (&Sdbus_register_method);
+
+  Qdbus_unregister_object = intern ("dbus-unregister-object");
+  staticpro (&Qdbus_unregister_object);
+  defsubr (&Sdbus_unregister_object);
 
   Qdbus_error = intern ("dbus-error");
   staticpro (&Qdbus_error);