/* Elisp bindings for D-Bus.
- Copyright (C) 2007, 2008 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
This file is part of GNU Emacs.
/* Whether to debug D-Bus. */
Lisp_Object Vdbus_debug;
+/* Whether we are reading a D-Bus event. */
+int xd_in_read_queued_messages = 0;
+
\f
/* We use "xd_" and "XD_" as prefix for all internal symbols, because
we don't want to poison other namespaces with "dbus_". */
+/* Raise a signal. If we are reading events, we cannot signal; we
+ throw to xd_read_queued_messages then. */
+#define XD_SIGNAL1(arg) \
+ do { \
+ if (xd_in_read_queued_messages) \
+ Fthrow (Qdbus_error, Qnil); \
+ else \
+ xsignal1 (Qdbus_error, arg); \
+ } while (0)
+
+#define XD_SIGNAL2(arg1, arg2) \
+ do { \
+ if (xd_in_read_queued_messages) \
+ Fthrow (Qdbus_error, Qnil); \
+ else \
+ xsignal2 (Qdbus_error, arg1, arg2); \
+ } while (0)
+
+#define XD_SIGNAL3(arg1, arg2, arg3) \
+ do { \
+ if (xd_in_read_queued_messages) \
+ Fthrow (Qdbus_error, Qnil); \
+ else \
+ xsignal3 (Qdbus_error, arg1, arg2, arg3); \
+ } while (0)
+
/* Raise a Lisp error from a D-Bus ERROR. */
#define XD_ERROR(error) \
do { \
/* Remove the trailing newline. */ \
if (strchr (s, '\n') != NULL) \
s[strlen (s) - 1] = '\0'; \
- xsignal1 (Qdbus_error, build_string (s)); \
+ XD_SIGNAL1 (build_string (s)); \
} while (0)
/* Macros for debugging. In order to enable them, build with
if (!valid_lisp_object_p (object)) \
{ \
XD_DEBUG_MESSAGE ("%d Assertion failure", __LINE__); \
- xsignal1 (Qdbus_error, build_string ("Assertion failure")); \
+ XD_SIGNAL1 (build_string ("Assertion failure")); \
} \
} while (0)
: (FLOATP (object)) ? DBUS_TYPE_DOUBLE \
: (STRINGP (object)) ? DBUS_TYPE_STRING \
: (XD_DBUS_TYPE_P (object)) ? XD_SYMBOL_TO_DBUS_TYPE (object) \
- : (CONSP (object)) ? ((XD_DBUS_TYPE_P (CAR_SAFE (object))) \
- ? XD_SYMBOL_TO_DBUS_TYPE (CAR_SAFE (object)) \
- : DBUS_TYPE_ARRAY) \
+ : (CONSP (object)) \
+ ? ((XD_DBUS_TYPE_P (CAR_SAFE (object))) \
+ ? ((XD_BASIC_DBUS_TYPE (XD_SYMBOL_TO_DBUS_TYPE (CAR_SAFE (object)))) \
+ ? DBUS_TYPE_ARRAY \
+ : XD_SYMBOL_TO_DBUS_TYPE (CAR_SAFE (object))) \
+ : DBUS_TYPE_ARRAY) \
: DBUS_TYPE_INVALID)
/* Return a list pointer which does not have a Lisp symbol as car. */
strcat (signature, x);
elt = CDR_SAFE (XD_NEXT_VALUE (elt));
}
- sprintf (signature, "%s%c", signature, DBUS_STRUCT_END_CHAR);
+ strcat (signature, DBUS_STRUCT_END_CHAR_AS_STRING);
break;
case DBUS_TYPE_DICT_ENTRY:
CAR_SAFE (CDR_SAFE (XD_NEXT_VALUE (elt))));
/* Closing signature. */
- sprintf (signature, "%s%c", signature, DBUS_DICT_ENTRY_END_CHAR);
+ strcat (signature, DBUS_DICT_ENTRY_END_CHAR_AS_STRING);
break;
default:
unsigned char 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);
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
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);
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
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);
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
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);
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
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);
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
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);
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
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);
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
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);
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
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);
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
case DBUS_TYPE_STRING:
char *val = SDATA (Fstring_make_unibyte (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);
+ XD_SIGNAL2 (build_string ("Unable to append argument"), object);
return;
}
}
SDATA (format2 ("%s", object, Qnil)));
if (!dbus_message_iter_open_container (iter, dtype,
signature, &subiter))
- xsignal3 (Qdbus_error,
- build_string ("Cannot open container"),
- make_number (dtype), build_string (signature));
+ XD_SIGNAL3 (build_string ("Cannot open container"),
+ make_number (dtype), build_string (signature));
break;
case DBUS_TYPE_VARIANT:
SDATA (format2 ("%s", object, Qnil)));
if (!dbus_message_iter_open_container (iter, dtype,
signature, &subiter))
- xsignal3 (Qdbus_error,
- build_string ("Cannot open container"),
- make_number (dtype), build_string (signature));
+ XD_SIGNAL3 (build_string ("Cannot open container"),
+ make_number (dtype), build_string (signature));
break;
case DBUS_TYPE_STRUCT:
XD_DEBUG_MESSAGE ("%c %s", dtype,
SDATA (format2 ("%s", object, Qnil)));
if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
- xsignal2 (Qdbus_error,
- build_string ("Cannot open container"),
- make_number (dtype));
+ XD_SIGNAL2 (build_string ("Cannot open container"),
+ make_number (dtype));
break;
}
/* Close the subiteration. */
if (!dbus_message_iter_close_container (iter, &subiter))
- xsignal2 (Qdbus_error,
- build_string ("Cannot close container"),
- make_number (dtype));
+ XD_SIGNAL2 (build_string ("Cannot close container"),
+ make_number (dtype));
}
}
/* Parameter check. */
CHECK_SYMBOL (bus);
if (!((EQ (bus, QCdbus_system_bus)) || (EQ (bus, QCdbus_session_bus))))
- xsignal2 (Qdbus_error, build_string ("Wrong bus name"), bus);
+ XD_SIGNAL2 (build_string ("Wrong bus name"), bus);
/* Open a connection to the bus. */
dbus_error_init (&derror);
XD_ERROR (derror);
if (connection == NULL)
- xsignal2 (Qdbus_error, build_string ("No connection"), bus);
+ XD_SIGNAL2 (build_string ("No connection"), bus);
/* Return the result. */
return connection;
/* Request the name. */
name = dbus_bus_get_unique_name (connection);
if (name == NULL)
- xsignal1 (Qdbus_error, build_string ("No unique name available"));
+ XD_SIGNAL1 (build_string ("No unique name available"));
/* Return. */
return build_string (name);
=> "i686"
-usage: (dbus-call-method
- BUS SERVICE PATH INTERFACE METHOD
- &optional :timeout TIMEOUT &rest ARGS) */)
+usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TIMEOUT &rest ARGS) */)
(nargs, args)
int nargs;
register Lisp_Object *args;
SDATA (method));
UNGCPRO;
if (dmessage == NULL)
- xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
+ XD_SIGNAL1 (build_string ("Unable to create a new message"));
/* Check for timeout parameter. */
if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
XD_ERROR (derror);
if (reply == NULL)
- xsignal1 (Qdbus_error, build_string ("No reply"));
+ XD_SIGNAL1 (build_string ("No reply"));
XD_DEBUG_MESSAGE ("Message sent");
-| i686
-usage: (dbus-call-method-asynchronously
- BUS SERVICE PATH INTERFACE METHOD HANDLER
- &optional :timeout TIMEOUT &rest ARGS) */)
+usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLER &optional :timeout TIMEOUT &rest ARGS) */)
(nargs, args)
int nargs;
register Lisp_Object *args;
SDATA (interface),
SDATA (method));
if (dmessage == NULL)
- xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
+ XD_SIGNAL1 (build_string ("Unable to create a new message"));
/* Check for timeout parameter. */
if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
/* 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_SIGNAL1 (build_string ("Cannot send message"));
XD_DEBUG_MESSAGE ("Message sent");
|| (!dbus_message_set_destination (dmessage, SDATA (service))))
{
UNGCPRO;
- xsignal1 (Qdbus_error,
- build_string ("Unable to create a return message"));
+ XD_SIGNAL1 (build_string ("Unable to create a return message"));
}
UNGCPRO;
/* Send the message. The message is just added to the outgoing
message queue. */
if (!dbus_connection_send (connection, dmessage, NULL))
- xsignal1 (Qdbus_error, build_string ("Cannot send message"));
+ XD_SIGNAL1 (build_string ("Cannot send message"));
/* Flush connection to ensure the message is handled. */
dbus_connection_flush (connection);
|| (!dbus_message_set_destination (dmessage, SDATA (service))))
{
UNGCPRO;
- xsignal1 (Qdbus_error,
- build_string ("Unable to create a error message"));
+ XD_SIGNAL1 (build_string ("Unable to create a error message"));
}
UNGCPRO;
/* Send the message. The message is just added to the outgoing
message queue. */
if (!dbus_connection_send (connection, dmessage, NULL))
- xsignal1 (Qdbus_error, build_string ("Cannot send message"));
+ XD_SIGNAL1 (build_string ("Cannot send message"));
/* Flush connection to ensure the message is handled. */
dbus_connection_flush (connection);
SDATA (signal));
UNGCPRO;
if (dmessage == NULL)
- xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
+ XD_SIGNAL1 (build_string ("Unable to create a new message"));
/* Initialize parameter list of message. */
dbus_message_iter_init_append (dmessage, &iter);
/* Send the message. The message is just added to the outgoing
message queue. */
if (!dbus_connection_send (connection, dmessage, NULL))
- xsignal1 (Qdbus_error, build_string ("Cannot send message"));
+ XD_SIGNAL1 (build_string ("Cannot send message"));
/* Flush connection to ensure the message is handled. */
dbus_connection_flush (connection);
Lisp errors during the call. */
if (HASH_TABLE_P (Vdbus_registered_functions_table))
{
- internal_condition_case_1 (xd_read_message, QCdbus_system_bus,
- Qerror, Fidentity);
- internal_condition_case_1 (xd_read_message, QCdbus_session_bus,
- Qerror, Fidentity);
+ xd_in_read_queued_messages = 1;
+ internal_catch (Qdbus_error, xd_read_message, QCdbus_system_bus);
+ internal_catch (Qdbus_error, xd_read_message, QCdbus_session_bus);
+ xd_in_read_queued_messages = 0;
}
}
/* When there is no unique name, we mark it with an empty
string. */
if (NILP (uname))
- uname = build_string ("");
+ uname = empty_unibyte_string;
}
else
uname = service;