+DEFUN ("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously,
+ Sdbus_call_method_asynchronously, 6, MANY, 0,
+ doc: /* Call METHOD on the D-Bus BUS asynchronously.
+
+BUS is either the symbol `:system' or the symbol `:session'.
+
+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.
+
+HANDLER is a Lisp function, which is called when the corresponding
+return message has arrived.
+
+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:
+
+ t and nil => DBUS_TYPE_BOOLEAN
+ number => DBUS_TYPE_UINT32
+ integer => DBUS_TYPE_INT32
+ float => DBUS_TYPE_DOUBLE
+ string => DBUS_TYPE_STRING
+ list => DBUS_TYPE_ARRAY
+
+All arguments can be preceded by a type symbol. For details about
+type symbols, see Info node `(dbus)Type Conversion'.
+
+The function returns a key into the hash table
+`dbus-registered-functions-table'. The corresponding entry in the
+hash table is removed, when the return message has been arrived, and
+HANDLER is called.
+
+Example:
+
+\(dbus-call-method-asynchronously
+ :system "org.freedesktop.Hal" "/org/freedesktop/Hal/devices/computer"
+ "org.freedesktop.Hal.Device" "GetPropertyString" 'message
+ "system.kernel.machine")
+
+ => (:system 2)
+
+ -| i686
+
+usage: (dbus-call-method-asynchronously
+ BUS SERVICE PATH INTERFACE METHOD HANDLER
+ &optional :timeout TIMEOUT &rest ARGS) */)
+ (nargs, args)
+ int nargs;
+ register Lisp_Object *args;
+{
+ Lisp_Object bus, service, path, interface, method, handler;
+ Lisp_Object result;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
+ DBusConnection *connection;
+ DBusMessage *dmessage;
+ DBusMessageIter iter;
+ unsigned int dtype;
+ int timeout = -1;
+ int i = 6;
+ char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
+
+ /* Check parameters. */
+ bus = args[0];
+ service = args[1];
+ path = args[2];
+ interface = args[3];
+ method = args[4];
+ handler = args[5];
+
+ CHECK_SYMBOL (bus);
+ CHECK_STRING (service);
+ CHECK_STRING (path);
+ CHECK_STRING (interface);
+ CHECK_STRING (method);
+ if (!FUNCTIONP (handler))
+ wrong_type_argument (intern ("functionp"), handler);
+ GCPRO6 (bus, service, path, interface, method, handler);
+
+ XD_DEBUG_MESSAGE ("%s %s %s %s",
+ SDATA (service),
+ SDATA (path),
+ SDATA (interface),
+ SDATA (method));
+
+ /* Open a connection to the bus. */
+ connection = xd_initialize (bus);
+
+ /* Create the message. */
+ dmessage = dbus_message_new_method_call (SDATA (service),
+ SDATA (path),
+ SDATA (interface),
+ SDATA (method));
+ 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)))
+ {
+ CHECK_NATNUM (args[i+1]);
+ timeout = XUINT (args[i+1]);
+ i = i+2;
+ }
+
+ /* Initialize parameter list of message. */
+ dbus_message_iter_init_append (dmessage, &iter);
+
+ /* Append parameters to the message. */
+ for (; i < nargs; ++i)
+ {
+ dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
+ if (XD_DBUS_TYPE_P (args[i]))
+ {
+ XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
+ XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]);
+ XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4,
+ SDATA (format2 ("%s", args[i], Qnil)),
+ SDATA (format2 ("%s", args[i+1], Qnil)));
+ ++i;
+ }
+ else
+ {
+ XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
+ XD_DEBUG_MESSAGE ("Parameter%d %s", i-4,
+ SDATA (format2 ("%s", args[i], Qnil)));
+ }
+
+ /* Check for valid signature. We use DBUS_TYPE_INVALID as
+ indication that there is no parent type. */
+ xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
+
+ xd_append_arg (dtype, args[i], &iter);
+ }
+
+ /* Send the message. The message is just added to the outgoing
+ message queue. */
+ if (!dbus_connection_send_with_reply (connection, dmessage, NULL, timeout))
+ xsignal1 (Qdbus_error, build_string ("Cannot send message"));
+
+ XD_DEBUG_MESSAGE ("Message sent");
+
+ /* The result is the key in Vdbus_registered_functions_table. */
+ result = (list2 (bus, make_number (dbus_message_get_serial (dmessage))));
+
+ /* Create a hash table entry. */
+ Fputhash (result, handler, Vdbus_registered_functions_table);
+
+ /* Cleanup. */
+ dbus_message_unref (dmessage);
+
+ /* Return the result. */
+ RETURN_UNGCPRO (result);
+}
+
HCoop / bpt / emacs.git / blobdiff