X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7f55d4251806e4712762bef0a3ed41a53f850a58..9569916d94c6c448862d02919e52fc3bfb9b9c8d:/src/dbusbind.c
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 54e92cce16..7a94c81eea 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -1,12 +1,12 @@
/* Elisp bindings for D-Bus.
- Copyright (C) 2007-2015 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
@@ -23,7 +23,6 @@ along with GNU Emacs. If not, see . */
#include
#include "lisp.h"
-#include "frame.h"
#include "termhooks.h"
#include "keyboard.h"
#include "process.h"
@@ -169,25 +168,25 @@ static int
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);
}
@@ -233,8 +232,12 @@ xd_symbol_to_dbus_type (Lisp_Object object)
/* 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 { \
@@ -254,16 +257,16 @@ xd_symbol_to_dbus_type (Lisp_Object object)
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)
@@ -392,7 +395,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
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
@@ -874,7 +877,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
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);
}
@@ -902,11 +905,9 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
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)
@@ -915,7 +916,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_next (&subiter);
}
XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (result));
- RETURN_UNGCPRO (Fnreverse (result));
+ return Fnreverse (result);
}
default:
@@ -942,7 +943,7 @@ xd_get_connection_references (DBusConnection *connection)
static DBusConnection*
xd_lisp_dbus_to_dbus (Lisp_Object bus)
{
- return (DBusConnection *) (intptr_t) XFASTINT (bus);
+ return (DBusConnection *) XSAVE_POINTER (bus, 0);
}
/* Return D-Bus connection address. BUS is either a Lisp symbol,
@@ -990,7 +991,7 @@ xd_add_watch (DBusWatch *watch, void *data)
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));
@@ -1008,8 +1009,7 @@ xd_add_watch (DBusWatch *watch, void *data)
}
/* 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)
{
@@ -1024,7 +1024,7 @@ xd_remove_watch (DBusWatch *watch, void *data)
/* Unset session environment. */
#if 0
/* This is buggy, since unsetenv is not thread-safe. */
- if (XSYMBOL (QCdbus_session_bus) == data)
+ if (XSYMBOL (QCsession) == data)
{
XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS");
unsetenv ("DBUS_SESSION_BUS_ADDRESS");
@@ -1146,14 +1146,14 @@ this connection to those buses. */)
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);
@@ -1186,7 +1186,7 @@ this connection to those buses. */)
XD_SIGNAL1 (build_string ("Cannot add watch functions"));
/* Add bus to list of registered buses. */
- XSETFASTINT (val, (intptr_t) connection);
+ val = make_save_ptr (connection);
xd_registered_buses = Fcons (Fcons (bus, val), xd_registered_buses);
/* Cleanup. */
@@ -1231,20 +1231,20 @@ This is an internal function, it shall not be used outside dbus.el.
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) */)
@@ -1255,7 +1255,6 @@ 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;
@@ -1313,9 +1312,6 @@ usage: (dbus-message-internal &rest REST) */)
wrong_type_argument (Qinvalid_function, handler);
}
- /* Protect Lisp variables. */
- GCPRO6 (bus, service, path, interface, member, handler);
-
/* Trace parameters. */
switch (mtype)
{
@@ -1353,10 +1349,7 @@ usage: (dbus-message-internal &rest REST) */)
/* 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))
{
@@ -1364,11 +1357,8 @@ usage: (dbus-message-internal &rest REST) */)
/* 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
@@ -1388,11 +1378,8 @@ usage: (dbus-message-internal &rest REST) */)
&& (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);
}
}
@@ -1403,30 +1390,21 @@ usage: (dbus-message-internal &rest REST) */)
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);
@@ -1469,15 +1447,11 @@ usage: (dbus-message-internal &rest REST) */)
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);
@@ -1487,10 +1461,7 @@ usage: (dbus-message-internal &rest REST) */)
/* 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;
}
@@ -1501,7 +1472,7 @@ usage: (dbus-message-internal &rest REST) */)
dbus_message_unref (dmessage);
/* Return the result. */
- RETURN_UNGCPRO (result);
+ return result;
}
/* Read one queued incoming message of the D-Bus BUS.
@@ -1511,7 +1482,6 @@ static void
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;
@@ -1529,7 +1499,6 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
/* Collect the parameters. */
args = Qnil;
- GCPRO1 (args);
/* Loop over the resulting parameters. Construct a list. */
if (dbus_message_iter_init (dmessage, &iter))
@@ -1569,8 +1538,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
|| (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. */
@@ -1595,9 +1563,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
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);
@@ -1653,8 +1619,6 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
/* Cleanup. */
cleanup:
dbus_message_unref (dmessage);
-
- UNGCPRO;
}
/* Read queued incoming messages of the D-Bus BUS.
@@ -1714,11 +1678,7 @@ init_dbusbind (void)
void
syms_of_dbusbind (void)
{
-
- DEFSYM (Qdbus__init_bus, "dbus--init-bus");
defsubr (&Sdbus__init_bus);
-
- DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name");
defsubr (&Sdbus_get_unique_name);
DEFSYM (Qdbus_message_internal, "dbus-message-internal");
@@ -1732,37 +1692,37 @@ syms_of_dbusbind (void)
build_pure_c_string ("D-Bus error"));
/* Lisp symbols of the system and session buses. */
- DEFSYM (QCdbus_system_bus, ":system");
- DEFSYM (QCdbus_session_bus, ":session");
+ DEFSYM (QCsystem, ":system");
+ DEFSYM (QCsession, ":session");
/* Lisp symbol for method call timeout. */
- DEFSYM (QCdbus_timeout, ":timeout");
+ DEFSYM (QCtimeout, ":timeout");
/* Lisp symbols of D-Bus types. */
- 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");
+ 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 (QCarray, ":array");
+ DEFSYM (QCvariant, ":variant");
+ DEFSYM (QCstruct, ":struct");
+ DEFSYM (QCdict_entry, ":dict-entry");
/* Lisp symbols of objects in `dbus-registered-objects-table'. */
- DEFSYM (QCdbus_registered_serial, ":serial");
- DEFSYM (QCdbus_registered_method, ":method");
- DEFSYM (QCdbus_registered_signal, ":signal");
+ DEFSYM (QCserial, ":serial");
+ DEFSYM (QCmethod, ":method");
+ DEFSYM (QCsignal, ":signal");
DEFVAR_LISP ("dbus-compiled-version",
Vdbus_compiled_version,
@@ -1830,7 +1790,7 @@ string which denotes a D-Bus interface, and MEMBER, also a string, is
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