/* Elisp bindings for D-Bus.
- Copyright (C) 2007-2014 Free Software Foundation, Inc.
+ Copyright (C) 2007-2016 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or
-(at your option) any later version.
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#include <dbus/dbus.h>
#include "lisp.h"
-#include "frame.h"
#include "termhooks.h"
#include "keyboard.h"
#include "process.h"
#endif
\f
-/* Subroutines. */
-static Lisp_Object Qdbus_init_bus;
-static Lisp_Object Qdbus_get_unique_name;
-static Lisp_Object Qdbus_message_internal;
-
-/* D-Bus error symbol. */
-static Lisp_Object Qdbus_error;
-
-/* Lisp symbols of the system and session buses. */
-static Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
-
-/* Lisp symbol for method call timeout. */
-static Lisp_Object QCdbus_timeout;
-
-/* Lisp symbols of D-Bus types. */
-static Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
-static Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
-static Lisp_Object QCdbus_type_int32, QCdbus_type_uint32;
-static Lisp_Object QCdbus_type_int64, QCdbus_type_uint64;
-static Lisp_Object QCdbus_type_double, QCdbus_type_string;
-static Lisp_Object QCdbus_type_object_path, QCdbus_type_signature;
-#ifdef DBUS_TYPE_UNIX_FD
-static Lisp_Object QCdbus_type_unix_fd;
-#endif
-static Lisp_Object QCdbus_type_array, QCdbus_type_variant;
-static Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
-
-/* Lisp symbols of objects in `dbus-registered-objects-table'. */
-static Lisp_Object QCdbus_registered_serial, QCdbus_registered_method;
-static Lisp_Object QCdbus_registered_signal;
-
/* Alist of D-Bus buses we are polling for messages.
The key is the symbol or string of the bus, and the value is the
connection address. */
} while (0)
#else /* !DBUS_DEBUG */
-# if __STDC_VERSION__ < 199901
-# define XD_DEBUG_MESSAGE (void) /* Pre-C99 compilers cannot debug. */
-# else
-# define XD_DEBUG_MESSAGE(...) \
+# define XD_DEBUG_MESSAGE(...) \
do { \
if (!NILP (Vdbus_debug)) \
{ \
message ("%s: %s", __func__, s); \
} \
} while (0)
-# endif
# define XD_DEBUG_VALID_LISP_OBJECT_P(object)
#endif
xd_symbol_to_dbus_type (Lisp_Object object)
{
return
- ((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE
- : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN
- : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16
- : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16
- : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32
- : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32
- : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64
- : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64
- : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE
- : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING
- : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH
- : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE
+ (EQ (object, QCbyte) ? DBUS_TYPE_BYTE
+ : EQ (object, QCboolean) ? DBUS_TYPE_BOOLEAN
+ : EQ (object, QCint16) ? DBUS_TYPE_INT16
+ : EQ (object, QCuint16) ? DBUS_TYPE_UINT16
+ : EQ (object, QCint32) ? DBUS_TYPE_INT32
+ : EQ (object, QCuint32) ? DBUS_TYPE_UINT32
+ : EQ (object, QCint64) ? DBUS_TYPE_INT64
+ : EQ (object, QCuint64) ? DBUS_TYPE_UINT64
+ : EQ (object, QCdouble) ? DBUS_TYPE_DOUBLE
+ : EQ (object, QCstring) ? DBUS_TYPE_STRING
+ : EQ (object, QCobject_path) ? DBUS_TYPE_OBJECT_PATH
+ : EQ (object, QCsignature) ? DBUS_TYPE_SIGNATURE
#ifdef DBUS_TYPE_UNIX_FD
- : (EQ (object, QCdbus_type_unix_fd)) ? DBUS_TYPE_UNIX_FD
+ : EQ (object, QCunix_fd) ? DBUS_TYPE_UNIX_FD
#endif
- : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY
- : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT
- : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT
- : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY
+ : EQ (object, QCarray) ? DBUS_TYPE_ARRAY
+ : EQ (object, QCvariant) ? DBUS_TYPE_VARIANT
+ : EQ (object, QCstruct) ? DBUS_TYPE_STRUCT
+ : EQ (object, QCdict_entry) ? DBUS_TYPE_DICT_ENTRY
: DBUS_TYPE_INVALID);
}
/* Transform the object to its string representation for debug
messages. */
-#define XD_OBJECT_TO_STRING(object) \
- SDATA (format2 ("%s", object, Qnil))
+static char *
+XD_OBJECT_TO_STRING (Lisp_Object object)
+{
+ AUTO_STRING (format, "%s");
+ return SSDATA (CALLN (Fformat, format, object));
+}
#define XD_DBUS_VALIDATE_BUS_ADDRESS(bus) \
do { \
if ((session_bus_address != NULL) \
&& (!NILP (Fstring_equal \
(bus, build_string (session_bus_address))))) \
- bus = QCdbus_session_bus; \
+ bus = QCsession; \
} \
\
else \
{ \
CHECK_SYMBOL (bus); \
- if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus))) \
+ if (!(EQ (bus, QCsystem) || EQ (bus, QCsession))) \
XD_SIGNAL2 (build_string ("Wrong bus name"), bus); \
/* We do not want to have an autolaunch for the session bus. */ \
- if (EQ (bus, QCdbus_session_bus) && session_bus_address == NULL) \
+ if (EQ (bus, QCsession) && session_bus_address == NULL) \
XD_SIGNAL2 (build_string ("No connection to bus"), bus); \
} \
} while (0)
ptrdiff_t xlen = strlen (x);
if (DBUS_MAXIMUM_SIGNATURE_LENGTH - xlen <= siglen)
string_overflow ();
- strcat (signature, x);
+ strcpy (signature + siglen, x);
}
/* Compute SIGNATURE of OBJECT. It must have a form that it can be
CHECK_CONS (object);
/* Type symbol is optional. */
- if (EQ (QCdbus_type_array, CAR_SAFE (elt)))
+ if (EQ (QCarray, CAR_SAFE (elt)))
elt = XD_NEXT_VALUE (elt);
/* If the array is empty, DBUS_TYPE_STRING is the default
&& STRINGP (CAR_SAFE (XD_NEXT_VALUE (object)))
&& NILP (CDR_SAFE (XD_NEXT_VALUE (object))))
{
- strcpy (signature, SSDATA (CAR_SAFE (XD_NEXT_VALUE (object))));
+ lispstpcpy (signature, CAR_SAFE (XD_NEXT_VALUE (object)));
object = CDR_SAFE (XD_NEXT_VALUE (object));
}
uprintmax_t pval;
dbus_message_iter_get_basic (iter, &val);
pval = val;
- XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
+ XD_DEBUG_MESSAGE ("%c %"pMu, dtype, pval);
return make_fixnum_or_float (val);
}
case DBUS_TYPE_DICT_ENTRY:
{
Lisp_Object result;
- struct gcpro gcpro1;
DBusMessageIter subiter;
int subtype;
result = Qnil;
- GCPRO1 (result);
dbus_message_iter_recurse (iter, &subiter);
while ((subtype = dbus_message_iter_get_arg_type (&subiter))
!= DBUS_TYPE_INVALID)
dbus_message_iter_next (&subiter);
}
XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (result));
- RETURN_UNGCPRO (Fnreverse (result));
+ return Fnreverse (result);
}
default:
unsigned int flags = dbus_watch_get_flags (watch);
int fd = xd_find_watch_fd (watch);
- XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d",
+ XD_DEBUG_MESSAGE ("fd %d, write %u, enabled %u",
fd, flags & DBUS_WATCH_WRITABLE,
dbus_watch_get_enabled (watch));
}
/* Stop monitoring WATCH for possible I/O.
- DATA is the used bus, either a string or QCdbus_system_bus or
- QCdbus_session_bus. */
+ DATA is the used bus, either a string or QCsystem or QCsession. */
static void
xd_remove_watch (DBusWatch *watch, void *data)
{
/* Unset session environment. */
#if 0
- if (XSYMBOL (QCdbus_session_bus) == data)
+ /* This is buggy, since unsetenv is not thread-safe. */
+ if (XSYMBOL (QCsession) == data)
{
XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
unsetenv ("DBUS_SESSION_BUS_ADDRESS");
if (NILP (val))
return;
- busobj = CDR_SAFE(val);
+ busobj = CDR_SAFE (val);
if (NILP (busobj)) {
xd_registered_buses = Fdelete (val, xd_registered_buses);
return;
return;
}
-DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 2, 0,
+DEFUN ("dbus--init-bus", Fdbus__init_bus, Sdbus__init_bus, 1, 2, 0,
doc: /* Establish the connection to D-Bus BUS.
+This function is dbus internal. You almost certainly want to use
+`dbus-init-bus'.
+
BUS can be either the symbol `:system' or the symbol `:session', or it
can be a string denoting the address of the corresponding bus. For
the system and session buses, this function is called when loading
connection = dbus_connection_open_private (SSDATA (bus), &derror);
else
- if (NILP (private))
- connection = dbus_bus_get (EQ (bus, QCdbus_system_bus)
- ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
- &derror);
- else
- connection = dbus_bus_get_private (EQ (bus, QCdbus_system_bus)
- ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION,
- &derror);
+ {
+ DBusBusType bustype = (EQ (bus, QCsystem)
+ ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION);
+ if (NILP (private))
+ connection = dbus_bus_get (bustype, &derror);
+ else
+ connection = dbus_bus_get_private (bustype, &derror);
+ }
if (dbus_error_is_set (&derror))
XD_ERROR (derror);
XSETFASTINT (val, (intptr_t) connection);
xd_registered_buses = Fcons (Fcons (bus, val), xd_registered_buses);
- /* We do not want to abort. */
- xputenv ("DBUS_FATAL_WARNINGS=0");
-
/* Cleanup. */
dbus_error_free (&derror);
}
The following usages are expected:
`dbus-call-method', `dbus-call-method-asynchronously':
- \(dbus-message-internal
+ (dbus-message-internal
dbus-message-type-method-call BUS SERVICE PATH INTERFACE METHOD HANDLER
&optional :timeout TIMEOUT &rest ARGS)
`dbus-send-signal':
- \(dbus-message-internal
+ (dbus-message-internal
dbus-message-type-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS)
`dbus-method-return-internal':
- \(dbus-message-internal
+ (dbus-message-internal
dbus-message-type-method-return BUS SERVICE SERIAL &rest ARGS)
`dbus-method-error-internal':
- \(dbus-message-internal
+ (dbus-message-internal
dbus-message-type-error BUS SERVICE SERIAL &rest ARGS)
usage: (dbus-message-internal &rest REST) */)
Lisp_Object interface = Qnil;
Lisp_Object member = Qnil;
Lisp_Object result;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
DBusConnection *connection;
DBusMessage *dmessage;
DBusMessageIter iter;
wrong_type_argument (Qinvalid_function, handler);
}
- /* Protect Lisp variables. */
- GCPRO6 (bus, service, path, interface, member, handler);
-
/* Trace parameters. */
switch (mtype)
{
/* Create the D-Bus message. */
dmessage = dbus_message_new (mtype);
if (dmessage == NULL)
- {
- UNGCPRO;
- XD_SIGNAL1 (build_string ("Unable to create a new message"));
- }
+ XD_SIGNAL1 (build_string ("Unable to create a new message"));
if (STRINGP (service))
{
/* Set destination. */
{
if (!dbus_message_set_destination (dmessage, SSDATA (service)))
- {
- UNGCPRO;
- XD_SIGNAL2 (build_string ("Unable to set the destination"),
- service);
- }
+ XD_SIGNAL2 (build_string ("Unable to set the destination"),
+ service);
}
else
&& (strcmp (dbus_bus_get_unique_name (connection), SSDATA (uname))
!= 0)
&& (!dbus_message_set_destination (dmessage, SSDATA (service))))
- {
- UNGCPRO;
- XD_SIGNAL2 (build_string ("Unable to set signal destination"),
- service);
- }
+ XD_SIGNAL2 (build_string ("Unable to set signal destination"),
+ service);
}
}
if ((!dbus_message_set_path (dmessage, SSDATA (path)))
|| (!dbus_message_set_interface (dmessage, SSDATA (interface)))
|| (!dbus_message_set_member (dmessage, SSDATA (member))))
- {
- UNGCPRO;
- XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
- }
+ XD_SIGNAL1 (build_string ("Unable to set the message parameter"));
}
else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */
{
if (!dbus_message_set_reply_serial (dmessage, serial))
- {
- UNGCPRO;
- XD_SIGNAL1 (build_string ("Unable to create a return message"));
- }
+ XD_SIGNAL1 (build_string ("Unable to create a return message"));
if ((mtype == DBUS_MESSAGE_TYPE_ERROR)
&& (!dbus_message_set_error_name (dmessage, DBUS_ERROR_FAILED)))
- {
- UNGCPRO;
- XD_SIGNAL1 (build_string ("Unable to create a error message"));
- }
+ XD_SIGNAL1 (build_string ("Unable to create a error message"));
}
/* Check for timeout parameter. */
- if ((count+2 <= nargs) && (EQ ((args[count]), QCdbus_timeout)))
+ if ((count + 2 <= nargs) && EQ (args[count], QCtimeout))
{
CHECK_NATNUM (args[count+1]);
timeout = min (XFASTINT (args[count+1]), INT_MAX);
message queue. */
if (!dbus_connection_send_with_reply (connection, dmessage,
NULL, timeout))
- {
- UNGCPRO;
- XD_SIGNAL1 (build_string ("Cannot send message"));
- }
+ XD_SIGNAL1 (build_string ("Cannot send message"));
/* The result is the key in Vdbus_registered_objects_table. */
serial = dbus_message_get_serial (dmessage);
- result = list3 (QCdbus_registered_serial,
- bus, make_fixnum_or_float (serial));
+ result = list3 (QCserial, bus, make_fixnum_or_float (serial));
/* Create a hash table entry. */
Fputhash (result, handler, Vdbus_registered_objects_table);
/* Send the message. The message is just added to the outgoing
message queue. */
if (!dbus_connection_send (connection, dmessage, NULL))
- {
- UNGCPRO;
- XD_SIGNAL1 (build_string ("Cannot send message"));
- }
+ XD_SIGNAL1 (build_string ("Cannot send message"));
result = Qnil;
}
dbus_message_unref (dmessage);
/* Return the result. */
- RETURN_UNGCPRO (result);
+ return result;
}
/* Read one queued incoming message of the D-Bus BUS.
xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
{
Lisp_Object args, key, value;
- struct gcpro gcpro1;
struct input_event event;
DBusMessage *dmessage;
DBusMessageIter iter;
/* Collect the parameters. */
args = Qnil;
- GCPRO1 (args);
/* Loop over the resulting parameters. Construct a list. */
if (dbus_message_iter_init (dmessage, &iter))
|| (mtype == DBUS_MESSAGE_TYPE_ERROR))
{
/* Search for a registered function of the message. */
- key = list3 (QCdbus_registered_serial, bus,
- make_fixnum_or_float (serial));
+ key = list3 (QCserial, bus, make_fixnum_or_float (serial));
value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
/* There shall be exactly one entry. Construct an event. */
goto cleanup;
/* Search for a registered function of the message. */
- key = list4 ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
- ? QCdbus_registered_method
- : QCdbus_registered_signal,
+ key = list4 (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL ? QCmethod : QCsignal,
bus, build_string (interface), build_string (member));
value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
/* Cleanup. */
cleanup:
dbus_message_unref (dmessage);
-
- UNGCPRO;
}
/* Read queued incoming messages of the D-Bus BUS.
\f
void
-syms_of_dbusbind (void)
+init_dbusbind (void)
{
+ /* We do not want to abort. */
+ xputenv ("DBUS_FATAL_WARNINGS=0");
+}
- DEFSYM (Qdbus_init_bus, "dbus-init-bus");
- defsubr (&Sdbus_init_bus);
-
- DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name");
+void
+syms_of_dbusbind (void)
+{
+ defsubr (&Sdbus__init_bus);
defsubr (&Sdbus_get_unique_name);
DEFSYM (Qdbus_message_internal, "dbus-message-internal");
defsubr (&Sdbus_message_internal);
+ /* D-Bus error symbol. */
DEFSYM (Qdbus_error, "dbus-error");
Fput (Qdbus_error, Qerror_conditions,
list2 (Qdbus_error, Qerror));
Fput (Qdbus_error, Qerror_message,
build_pure_c_string ("D-Bus error"));
- DEFSYM (QCdbus_system_bus, ":system");
- DEFSYM (QCdbus_session_bus, ":session");
- DEFSYM (QCdbus_timeout, ":timeout");
- DEFSYM (QCdbus_type_byte, ":byte");
- DEFSYM (QCdbus_type_boolean, ":boolean");
- DEFSYM (QCdbus_type_int16, ":int16");
- DEFSYM (QCdbus_type_uint16, ":uint16");
- DEFSYM (QCdbus_type_int32, ":int32");
- DEFSYM (QCdbus_type_uint32, ":uint32");
- DEFSYM (QCdbus_type_int64, ":int64");
- DEFSYM (QCdbus_type_uint64, ":uint64");
- DEFSYM (QCdbus_type_double, ":double");
- DEFSYM (QCdbus_type_string, ":string");
- DEFSYM (QCdbus_type_object_path, ":object-path");
- DEFSYM (QCdbus_type_signature, ":signature");
+ /* Lisp symbols of the system and session buses. */
+ DEFSYM (QCsystem, ":system");
+ DEFSYM (QCsession, ":session");
+
+ /* Lisp symbol for method call timeout. */
+ DEFSYM (QCtimeout, ":timeout");
+
+ /* Lisp symbols of D-Bus types. */
+ DEFSYM (QCbyte, ":byte");
+ DEFSYM (QCboolean, ":boolean");
+ DEFSYM (QCint16, ":int16");
+ DEFSYM (QCuint16, ":uint16");
+ DEFSYM (QCint32, ":int32");
+ DEFSYM (QCuint32, ":uint32");
+ DEFSYM (QCint64, ":int64");
+ DEFSYM (QCuint64, ":uint64");
+ DEFSYM (QCdouble, ":double");
+ DEFSYM (QCstring, ":string");
+ DEFSYM (QCobject_path, ":object-path");
+ DEFSYM (QCsignature, ":signature");
#ifdef DBUS_TYPE_UNIX_FD
- DEFSYM (QCdbus_type_unix_fd, ":unix-fd");
+ DEFSYM (QCunix_fd, ":unix-fd");
#endif
- DEFSYM (QCdbus_type_array, ":array");
- DEFSYM (QCdbus_type_variant, ":variant");
- DEFSYM (QCdbus_type_struct, ":struct");
- DEFSYM (QCdbus_type_dict_entry, ":dict-entry");
- DEFSYM (QCdbus_registered_serial, ":serial");
- DEFSYM (QCdbus_registered_method, ":method");
- DEFSYM (QCdbus_registered_signal, ":signal");
+ DEFSYM (QCarray, ":array");
+ DEFSYM (QCvariant, ":variant");
+ DEFSYM (QCstruct, ":struct");
+ DEFSYM (QCdict_entry, ":dict-entry");
+
+ /* Lisp symbols of objects in `dbus-registered-objects-table'. */
+ DEFSYM (QCserial, ":serial");
+ DEFSYM (QCmethod, ":method");
+ DEFSYM (QCsignal, ":signal");
DEFVAR_LISP ("dbus-compiled-version",
Vdbus_compiled_version,
either a method, a signal or a property INTERFACE is offering. All
arguments but BUS must not be nil.
-The value in the hash table is a list of quadruple lists \((UNAME
+The value in the hash table is a list of quadruple lists ((UNAME
SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as
registered, UNAME is the corresponding unique name. In case of
registered methods and properties, UNAME is nil. PATH is the object
non-blocking method call, a reply is expected. Both arguments must
not be nil. The value in the hash table is HANDLER, the function to
be called when the D-Bus reply message arrives. */);
- {
- Lisp_Object args[2];
- args[0] = QCtest;
- args[1] = Qequal;
- Vdbus_registered_objects_table = Fmake_hash_table (2, args);
- }
+ Vdbus_registered_objects_table = CALLN (Fmake_hash_table, QCtest, Qequal);
DEFVAR_LISP ("dbus-debug", Vdbus_debug,
doc: /* If non-nil, debug messages of D-Bus bindings are raised. */);