* dbusbind.c (QCdbus_timeout): New D-Bus internal symbol.

(Fdbus_call_method): New parameter TIMEOUT.
(dbus-send-signal): Optimize UNGCPRO call.

1 files changed, 29 insertions, 15 deletions

diff --git a/src/dbusbind.c b/src/dbusbind.c
index 029c53640d..0771105356 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -44,6 +44,9 @@ Lisp_Object Qdbus_error;
 /* Lisp symbols of the system and session buses.  */
 Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
 
+/* Lisp symbol for method call timeout.  */
+Lisp_Object QCdbus_timeout;
+
 /* Lisp symbols of D-Bus types.  */
 Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
 Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
@@ -724,6 +727,11 @@ SERVICE is the D-Bus service name to be used.  PATH is the D-Bus
 object path SERVICE is registered at.  INTERFACE is an interface
 offered by SERVICE.  It must provide METHOD.
 
+If the parameter `:timeout' is given, the following integer TIMEOUT
+specifies the maximun number of milliseconds the method call must
+return. The default value is 25.000. If the method call doesn't return
+in time, a D-Bus error is raised.
+
 All other arguments ARGS are passed to METHOD as arguments.  They are
 converted into D-Bus types via the following rules:
 
@@ -777,7 +785,9 @@ object is returned instead of a list containing this single Lisp object.
 
   => "i686"
 
-usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &rest ARGS)  */)
+usage: (dbus-call-method
+         BUS SERVICE PATH INTERFACE METHOD
+         &optional :timeout TIMEOUT &rest ARGS)  */)
      (nargs, args)
      int nargs;
      register Lisp_Object *args;
@@ -791,7 +801,8 @@ usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &rest ARGS)  */)
   DBusMessageIter iter;
   DBusError derror;
   unsigned int dtype;
-  int i;
+  int timeout = -1;
+  int i = 5;
   char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
 
   /* Check parameters.  */
@@ -822,19 +833,23 @@ usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &rest ARGS)  */)
 					   SDATA (path),
 					   SDATA (interface),
 					   SDATA (method));
+  UNGCPRO;
   if (dmessage == NULL)
+    xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
+
+  /* Check for timeout parameter.  */
+  if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
     {
-      UNGCPRO;
-      xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
+      CHECK_NATNUM (args[i+1]);
+      timeout = XUINT (args[i+1]);
+      i = i+2;
     }
 
-  UNGCPRO;
-
   /* Initialize parameter list of message.  */
   dbus_message_iter_init_append (dmessage, &iter);
 
   /* Append parameters to the message.  */
-  for (i = 5; i < nargs; ++i)
+  for (; i < nargs; ++i)
     {
       dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
       if (XD_DBUS_TYPE_P (args[i]))
@@ -864,7 +879,7 @@ usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &rest ARGS)  */)
   dbus_error_init (&derror);
   reply = dbus_connection_send_with_reply_and_block (connection,
 						     dmessage,
-						     -1,
+						     timeout,
 						     &derror);
 
   if (dbus_error_is_set (&derror))
@@ -1071,13 +1086,9 @@ usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)  */)
   dmessage = dbus_message_new_signal (SDATA (path),
 				      SDATA (interface),
 				      SDATA (signal));
-  if (dmessage == NULL)
-    {
-      UNGCPRO;
-      xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
-    }
-
   UNGCPRO;
+  if (dmessage == NULL)
+    xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
 
   /* Initialize parameter list of message.  */
   dbus_message_iter_init_append (dmessage, &iter);
@@ -1178,7 +1189,7 @@ xd_read_message (bus)
   interface = dbus_message_get_interface (dmessage);
   member    = dbus_message_get_member (dmessage);
 
-  /* dbus-registered-functions-table requires non nil interface and member. */
+  /* Vdbus_registered_functions_table requires non-nil interface and member.  */
   if ((NULL == interface) || (NULL == member))
     goto cleanup;
 
@@ -1462,6 +1473,9 @@ syms_of_dbusbind ()
   QCdbus_session_bus = intern (":session");
   staticpro (&QCdbus_session_bus);
 
+  QCdbus_timeout = intern (":timeout");
+  staticpro (&QCdbus_timeout);
+
   QCdbus_type_byte = intern (":byte");
   staticpro (&QCdbus_type_byte);