diff options
Diffstat (limited to 'src/dbusbind.c')
| -rw-r--r-- | src/dbusbind.c | 553 |
1 files changed, 369 insertions, 184 deletions
diff --git a/src/dbusbind.c b/src/dbusbind.c index 789aa008611..1c74180f15c 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1,5 +1,5 @@ /* Elisp bindings for D-Bus. - Copyright (C) 2007-2017 Free Software Foundation, Inc. + Copyright (C) 2007-2022 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -26,6 +26,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "lisp.h" #include "termhooks.h" #include "keyboard.h" +#include "pdumper.h" #include "process.h" #ifndef DBUS_NUM_MESSAGE_TYPES @@ -43,7 +44,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ /* 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. */ + connection address. For every bus, just one connection is counted. + If there shall be a second connection to the same bus, a different + symbol or string for the bus must be chosen. On Lisp level, a bus + stands for the associated connection. */ static Lisp_Object xd_registered_buses; /* Whether we are reading a D-Bus event. */ @@ -191,26 +195,56 @@ xd_symbol_to_dbus_type (Lisp_Object object) : DBUS_TYPE_INVALID); } +/* Determine the Lisp symbol of DBusType. */ +static Lisp_Object +xd_dbus_type_to_symbol (int type) +{ + return + (type == DBUS_TYPE_BYTE) ? QCbyte + : (type == DBUS_TYPE_BOOLEAN) ? QCboolean + : (type == DBUS_TYPE_INT16) ? QCint16 + : (type == DBUS_TYPE_UINT16) ? QCuint16 + : (type == DBUS_TYPE_INT32) ? QCint32 + : (type == DBUS_TYPE_UINT32) ? QCuint32 + : (type == DBUS_TYPE_INT64) ? QCint64 + : (type == DBUS_TYPE_UINT64) ? QCuint64 + : (type == DBUS_TYPE_DOUBLE) ? QCdouble + : (type == DBUS_TYPE_STRING) ? QCstring + : (type == DBUS_TYPE_OBJECT_PATH) ? QCobject_path + : (type == DBUS_TYPE_SIGNATURE) ? QCsignature +#ifdef DBUS_TYPE_UNIX_FD + : (type == DBUS_TYPE_UNIX_FD) ? QCunix_fd +#endif + : (type == DBUS_TYPE_ARRAY) ? QCarray + : (type == DBUS_TYPE_VARIANT) ? QCvariant + : (type == DBUS_TYPE_STRUCT) ? QCstruct + : (type == DBUS_TYPE_DICT_ENTRY) ? QCdict_entry + : Qnil; +} + +#define XD_KEYWORDP(object) !NILP (Fkeywordp (object)) + /* Check whether a Lisp symbol is a predefined D-Bus type symbol. */ #define XD_DBUS_TYPE_P(object) \ - (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID))) + XD_KEYWORDP (object) && \ + ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)) /* Determine the DBusType of a given Lisp OBJECT. It is used to convert Lisp objects, being arguments of `dbus-call-method' or `dbus-send-signal', into corresponding C values appended as arguments to a D-Bus message. */ #define XD_OBJECT_TO_DBUS_TYPE(object) \ - ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \ - : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \ - : (INTEGERP (object)) ? DBUS_TYPE_INT32 \ + ((EQ (object, Qt) || NILP (object)) ? DBUS_TYPE_BOOLEAN \ + : (FIXNATP (object)) ? DBUS_TYPE_UINT32 \ + : (FIXNUMP (object)) ? DBUS_TYPE_INT32 \ : (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_BASIC_DBUS_TYPE (xd_symbol_to_dbus_type (CAR_SAFE (object)))) \ + ? ((XD_DBUS_TYPE_P (XCAR (object))) \ + ? ((XD_BASIC_DBUS_TYPE (xd_symbol_to_dbus_type (XCAR (object)))) \ ? DBUS_TYPE_ARRAY \ - : xd_symbol_to_dbus_type (CAR_SAFE (object))) \ + : xd_symbol_to_dbus_type (XCAR (object))) \ : DBUS_TYPE_ARRAY) \ : DBUS_TYPE_INVALID) @@ -237,8 +271,7 @@ static char * XD_OBJECT_TO_STRING (Lisp_Object object) { AUTO_STRING (format, "%s"); - Lisp_Object args[] = { format, object }; - return SSDATA (styled_format (ARRAYELTS (args), args, false, false)); + return SSDATA (CALLN (Fformat, format, object)); } #define XD_DBUS_VALIDATE_BUS_ADDRESS(bus) \ @@ -265,10 +298,13 @@ XD_OBJECT_TO_STRING (Lisp_Object object) else \ { \ CHECK_SYMBOL (bus); \ - if (!(EQ (bus, QCsystem) || EQ (bus, QCsession))) \ + if (!(EQ (bus, QCsystem) || EQ (bus, QCsession) \ + || EQ (bus, QCsystem_private) \ + || EQ (bus, QCsession_private))) \ XD_SIGNAL2 (build_string ("Wrong bus name"), bus); \ /* We do not want to have an autolaunch for the session bus. */ \ - if (EQ (bus, QCsession) && session_bus_address == NULL) \ + if ((EQ (bus, QCsession) || EQ (bus, QCsession_private)) \ + && session_bus_address == NULL) \ XD_SIGNAL2 (build_string ("No connection to bus"), bus); \ } \ } while (0) @@ -347,7 +383,6 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) int subtype; Lisp_Object elt; char const *subsig; - int subsiglen; char x[DBUS_MAXIMUM_SIGNATURE_LENGTH]; elt = object; @@ -356,18 +391,19 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) { case DBUS_TYPE_BYTE: case DBUS_TYPE_UINT16: - CHECK_NATNUM (object); + CHECK_FIXNAT (object); sprintf (signature, "%c", dtype); break; case DBUS_TYPE_BOOLEAN: - if (!EQ (object, Qt) && !EQ (object, Qnil)) - wrong_type_argument (intern ("booleanp"), object); + /* There must be an argument. */ + if (EQ (QCboolean, object)) + wrong_type_argument (Qbooleanp, object); sprintf (signature, "%c", dtype); break; case DBUS_TYPE_INT16: - CHECK_NUMBER (object); + CHECK_FIXNUM (object); sprintf (signature, "%c", dtype); break; @@ -379,14 +415,19 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) case DBUS_TYPE_INT32: case DBUS_TYPE_INT64: case DBUS_TYPE_DOUBLE: - CHECK_NUMBER_OR_FLOAT (object); + CHECK_NUMBER (object); sprintf (signature, "%c", dtype); break; case DBUS_TYPE_STRING: case DBUS_TYPE_OBJECT_PATH: case DBUS_TYPE_SIGNATURE: - CHECK_STRING (object); + /* We dont check the syntax of signature. This will be done by + libdbus. */ + if (dtype == DBUS_TYPE_OBJECT_PATH) + XD_DBUS_VALIDATE_PATH (object) + else + CHECK_STRING (object); sprintf (signature, "%c", dtype); break; @@ -397,7 +438,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) CHECK_CONS (object); /* Type symbol is optional. */ - if (EQ (QCarray, CAR_SAFE (elt))) + if (EQ (QCarray, XCAR (elt))) elt = XD_NEXT_VALUE (elt); /* If the array is empty, DBUS_TYPE_STRING is the default @@ -417,22 +458,29 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) /* If the element type is DBUS_TYPE_SIGNATURE, and this is the only element, the value of this element is used as the array's element signature. */ - if ((subtype == DBUS_TYPE_SIGNATURE) - && STRINGP (CAR_SAFE (XD_NEXT_VALUE (elt))) - && NILP (CDR_SAFE (XD_NEXT_VALUE (elt)))) - subsig = SSDATA (CAR_SAFE (XD_NEXT_VALUE (elt))); + if (subtype == DBUS_TYPE_SIGNATURE) + { + Lisp_Object elt1 = XD_NEXT_VALUE (elt); + if (CONSP (elt1) && STRINGP (XCAR (elt1)) && NILP (XCDR (elt1))) + { + subsig = SSDATA (XCAR (elt1)); + elt = Qnil; + } + } while (!NILP (elt)) { - if (subtype != XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt))) + char x[DBUS_MAXIMUM_SIGNATURE_LENGTH]; + subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)); + xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt))); + if (strcmp (subsig, x) != 0) wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt)); elt = CDR_SAFE (XD_NEXT_VALUE (elt)); } - subsiglen = snprintf (signature, DBUS_MAXIMUM_SIGNATURE_LENGTH, - "%c%s", dtype, subsig); - if (! (0 <= subsiglen && subsiglen < DBUS_MAXIMUM_SIGNATURE_LENGTH)) - string_overflow (); + signature[0] = dtype; + signature[1] = '\0'; + xd_signature_cat (signature, subsig); break; case DBUS_TYPE_VARIANT: @@ -440,6 +488,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) CHECK_CONS (object); elt = XD_NEXT_VALUE (elt); + CHECK_CONS (elt); subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)); xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt))); @@ -451,11 +500,12 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) break; case DBUS_TYPE_STRUCT: - /* A struct list might contain any number of elements with - different types. No further check needed. */ + /* A struct list might contain any (but zero) number of elements + with different types. No further check needed. */ CHECK_CONS (object); elt = XD_NEXT_VALUE (elt); + CHECK_CONS (elt); /* Compose the signature from the elements. It is enclosed by parentheses. */ @@ -486,6 +536,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) /* First element. */ elt = XD_NEXT_VALUE (elt); + CHECK_CONS (elt); subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)); xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt))); xd_signature_cat (signature, x); @@ -495,6 +546,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) /* Second element. */ elt = CDR_SAFE (XD_NEXT_VALUE (elt)); + CHECK_CONS (elt); subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)); xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt))); xd_signature_cat (signature, x); @@ -518,11 +570,12 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) static intmax_t xd_extract_signed (Lisp_Object x, intmax_t lo, intmax_t hi) { - CHECK_NUMBER_OR_FLOAT (x); + CHECK_NUMBER (x); if (INTEGERP (x)) { - if (lo <= XINT (x) && XINT (x) <= hi) - return XINT (x); + intmax_t i; + if (integer_to_intmax (x, &i) && lo <= i && i <= hi) + return i; } else { @@ -534,23 +587,23 @@ xd_extract_signed (Lisp_Object x, intmax_t lo, intmax_t hi) return n; } } + if (xd_in_read_queued_messages) Fthrow (Qdbus_error, Qnil); else - args_out_of_range_3 (x, - make_fixnum_or_float (lo), - make_fixnum_or_float (hi)); + args_out_of_range_3 (x, INT_TO_INTEGER (lo), INT_TO_INTEGER (hi)); } /* Convert X to an unsigned integer with bounds 0 and HI. */ static uintmax_t xd_extract_unsigned (Lisp_Object x, uintmax_t hi) { - CHECK_NUMBER_OR_FLOAT (x); + CHECK_NUMBER (x); if (INTEGERP (x)) { - if (0 <= XINT (x) && XINT (x) <= hi) - return XINT (x); + uintmax_t i; + if (integer_to_uintmax (x, &i) && i <= hi) + return i; } else { @@ -562,10 +615,11 @@ xd_extract_unsigned (Lisp_Object x, uintmax_t hi) return n; } } + if (xd_in_read_queued_messages) Fthrow (Qdbus_error, Qnil); else - args_out_of_range_3 (x, make_number (0), make_fixnum_or_float (hi)); + args_out_of_range_3 (x, make_fixnum (0), INT_TO_INTEGER (hi)); } /* Append C value, extracted from Lisp OBJECT, to iteration ITER. @@ -583,9 +637,9 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) switch (dtype) { case DBUS_TYPE_BYTE: - CHECK_NATNUM (object); + CHECK_FIXNAT (object); { - unsigned char val = XFASTINT (object) & 0xFF; + unsigned char val = XFIXNAT (object) & 0xFF; XD_DEBUG_MESSAGE ("%c %u", dtype, val); if (!dbus_message_iter_append_basic (iter, dtype, &val)) XD_SIGNAL2 (build_string ("Unable to append argument"), object); @@ -593,6 +647,9 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) } case DBUS_TYPE_BOOLEAN: + /* There must be an argument. */ + if (EQ (QCboolean, object)) + wrong_type_argument (Qbooleanp, object); { dbus_bool_t val = (NILP (object)) ? FALSE : TRUE; XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true"); @@ -660,8 +717,8 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) xd_extract_signed (object, TYPE_MINIMUM (dbus_int64_t), TYPE_MAXIMUM (dbus_int64_t)); - printmax_t pval = val; - XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval); + intmax_t pval = val; + XD_DEBUG_MESSAGE ("%c %"PRIdMAX, dtype, pval); if (!dbus_message_iter_append_basic (iter, dtype, &val)) XD_SIGNAL2 (build_string ("Unable to append argument"), object); return; @@ -672,8 +729,8 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) dbus_uint64_t val = xd_extract_unsigned (object, TYPE_MAXIMUM (dbus_uint64_t)); - uprintmax_t pval = val; - XD_DEBUG_MESSAGE ("%c %"pMu, dtype, pval); + uintmax_t pval = val; + XD_DEBUG_MESSAGE ("%c %"PRIuMAX, dtype, pval); if (!dbus_message_iter_append_basic (iter, dtype, &val)) XD_SIGNAL2 (build_string ("Unable to append argument"), object); return; @@ -691,7 +748,12 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) case DBUS_TYPE_STRING: case DBUS_TYPE_OBJECT_PATH: case DBUS_TYPE_SIGNATURE: - CHECK_STRING (object); + /* We dont check the syntax of signature. This will be done + by libdbus. */ + if (dtype == DBUS_TYPE_OBJECT_PATH) + XD_DBUS_VALIDATE_PATH (object) + else + CHECK_STRING (object); { /* We need to send a valid UTF-8 string. We could encode `object' but by not encoding it, we guarantee it's valid utf-8, even if @@ -727,29 +789,34 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) strcpy (signature, DBUS_TYPE_STRING_AS_STRING); else - /* If the element type is DBUS_TYPE_SIGNATURE, and this is - the only element, the value of this element is used as - the array's element signature. */ - if ((XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)) - == DBUS_TYPE_SIGNATURE) - && STRINGP (CAR_SAFE (XD_NEXT_VALUE (object))) - && NILP (CDR_SAFE (XD_NEXT_VALUE (object)))) - { - lispstpcpy (signature, CAR_SAFE (XD_NEXT_VALUE (object))); - object = CDR_SAFE (XD_NEXT_VALUE (object)); - } - - else - xd_signature (signature, - XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)), - dtype, CAR_SAFE (XD_NEXT_VALUE (object))); + { + /* If the element type is DBUS_TYPE_SIGNATURE, and this is + the only element, the value of this element is used as + the array's element signature. */ + if (CONSP (object) && (XD_OBJECT_TO_DBUS_TYPE (XCAR (object)) + == DBUS_TYPE_SIGNATURE)) + { + Lisp_Object val = XD_NEXT_VALUE (object); + if (CONSP (val) && STRINGP (XCAR (val)) && NILP (XCDR (val)) + && SBYTES (XCAR (val)) < DBUS_MAXIMUM_SIGNATURE_LENGTH) + { + lispstpcpy (signature, XCAR (val)); + object = Qnil; + } + } + + if (!NILP (object)) + xd_signature (signature, + XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (object)), + dtype, CAR_SAFE (XD_NEXT_VALUE (object))); + } XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature, XD_OBJECT_TO_STRING (object)); if (!dbus_message_iter_open_container (iter, dtype, signature, &subiter)) XD_SIGNAL3 (build_string ("Cannot open container"), - make_number (dtype), build_string (signature)); + make_fixnum (dtype), build_string (signature)); break; case DBUS_TYPE_VARIANT: @@ -762,7 +829,7 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) if (!dbus_message_iter_open_container (iter, dtype, signature, &subiter)) XD_SIGNAL3 (build_string ("Cannot open container"), - make_number (dtype), build_string (signature)); + make_fixnum (dtype), build_string (signature)); break; case DBUS_TYPE_STRUCT: @@ -771,7 +838,7 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (object)); if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter)) XD_SIGNAL2 (build_string ("Cannot open container"), - make_number (dtype)); + make_fixnum (dtype)); break; } @@ -789,7 +856,7 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) /* Close the subiteration. */ if (!dbus_message_iter_close_container (iter, &subiter)) XD_SIGNAL2 (build_string ("Cannot close container"), - make_number (dtype)); + make_fixnum (dtype)); } } @@ -809,7 +876,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_get_basic (iter, &val); val = val & 0xFF; XD_DEBUG_MESSAGE ("%c %u", dtype, val); - return make_number (val); + return list2 (xd_dbus_type_to_symbol (dtype), make_fixnum (val)); } case DBUS_TYPE_BOOLEAN: @@ -817,7 +884,8 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_bool_t val; dbus_message_iter_get_basic (iter, &val); XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true"); - return (val == FALSE) ? Qnil : Qt; + return list2 (xd_dbus_type_to_symbol (dtype), + (val == FALSE) ? Qnil : Qt); } case DBUS_TYPE_INT16: @@ -827,7 +895,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_get_basic (iter, &val); pval = val; XD_DEBUG_MESSAGE ("%c %d", dtype, pval); - return make_number (val); + return list2 (xd_dbus_type_to_symbol (dtype), make_fixnum (val)); } case DBUS_TYPE_UINT16: @@ -837,7 +905,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_get_basic (iter, &val); pval = val; XD_DEBUG_MESSAGE ("%c %d", dtype, pval); - return make_number (val); + return list2 (xd_dbus_type_to_symbol (dtype), make_fixnum (val)); } case DBUS_TYPE_INT32: @@ -847,7 +915,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_get_basic (iter, &val); pval = val; XD_DEBUG_MESSAGE ("%c %d", dtype, pval); - return make_fixnum_or_float (val); + return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val)); } case DBUS_TYPE_UINT32: @@ -860,27 +928,25 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) dbus_message_iter_get_basic (iter, &val); pval = val; XD_DEBUG_MESSAGE ("%c %u", dtype, pval); - return make_fixnum_or_float (val); + return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val)); } case DBUS_TYPE_INT64: { dbus_int64_t val; - printmax_t pval; dbus_message_iter_get_basic (iter, &val); - pval = val; - XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval); - return make_fixnum_or_float (val); + intmax_t pval = val; + XD_DEBUG_MESSAGE ("%c %"PRIdMAX, dtype, pval); + return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val)); } case DBUS_TYPE_UINT64: { dbus_uint64_t val; - uprintmax_t pval; dbus_message_iter_get_basic (iter, &val); - pval = val; - XD_DEBUG_MESSAGE ("%c %"pMu, dtype, pval); - return make_fixnum_or_float (val); + uintmax_t pval = val; + XD_DEBUG_MESSAGE ("%c %"PRIuMAX, dtype, pval); + return list2 (xd_dbus_type_to_symbol (dtype), INT_TO_INTEGER (val)); } case DBUS_TYPE_DOUBLE: @@ -888,7 +954,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) double val; dbus_message_iter_get_basic (iter, &val); XD_DEBUG_MESSAGE ("%c %f", dtype, val); - return make_float (val); + return list2 (xd_dbus_type_to_symbol (dtype), make_float (val)); } case DBUS_TYPE_STRING: @@ -898,7 +964,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter) char *val; dbus_message_iter_get_basic (iter, &val); XD_DEBUG_MESSAGE ("%c %s", dtype, val); - return build_string (val); + return list2 (xd_dbus_type_to_symbol (dtype), build_string (val)); } case DBUS_TYPE_ARRAY: @@ -918,7 +984,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 Fnreverse (result); + return Fcons (xd_dbus_type_to_symbol (dtype), Fnreverse (result)); } default: @@ -945,11 +1011,12 @@ xd_get_connection_references (DBusConnection *connection) static DBusConnection * xd_lisp_dbus_to_dbus (Lisp_Object bus) { - return (DBusConnection *) XSAVE_POINTER (bus, 0); + return xmint_pointer (bus); } -/* Return D-Bus connection address. BUS is either a Lisp symbol, - :system or :session, or a string denoting the bus address. */ +/* Return D-Bus connection address. + BUS is either a Lisp symbol, :system, :session, :system-private or + :session-private, or a string denoting the bus address. */ static DBusConnection * xd_get_connection_address (Lisp_Object bus) { @@ -1011,7 +1078,8 @@ xd_add_watch (DBusWatch *watch, void *data) } /* Stop monitoring WATCH for possible I/O. - DATA is the used bus, either a string or QCsystem or QCsession. */ + DATA is the used bus, either a string or QCsystem, QCsession, + QCsystem_private or QCsession_private. */ static void xd_remove_watch (DBusWatch *watch, void *data) { @@ -1026,7 +1094,7 @@ xd_remove_watch (DBusWatch *watch, void *data) /* Unset session environment. */ #if 0 /* This is buggy, since unsetenv is not thread-safe. */ - if (XSYMBOL (QCsession) == data) + if (XSYMBOL (QCsession) == data) || (XSYMBOL (QCsession_private) == data) { XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS"); unsetenv ("DBUS_SESSION_BUS_ADDRESS"); @@ -1100,6 +1168,11 @@ can be a string denoting the address of the corresponding bus. For the system and session buses, this function is called when loading `dbus.el', there is no need to call it again. +A special case is BUS being the symbol `:system-private' or +`:session-private'. These symbols still denote the system or session +bus, but using a private connection. They should not be used outside +dbus.el. + The function returns a number, which counts the connections this Emacs session has established to the BUS under the same unique name (see `dbus-get-unique-name'). It depends on the libraries Emacs is linked @@ -1122,6 +1195,10 @@ this connection to those buses. */) ptrdiff_t refcount; /* Check parameter. */ + if (!NILP (private)) + bus = EQ (bus, QCsystem) + ? QCsystem_private + : EQ (bus, QCsession) ? QCsession_private : bus; XD_DBUS_VALIDATE_BUS_ADDRESS (bus); /* Close bus if it is already open. */ @@ -1149,8 +1226,9 @@ this connection to those buses. */) else { - DBusBusType bustype = (EQ (bus, QCsystem) - ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION); + DBusBusType bustype + = EQ (bus, QCsystem) || EQ (bus, QCsystem_private) + ? DBUS_BUS_SYSTEM : DBUS_BUS_SESSION; if (NILP (private)) connection = dbus_bus_get (bustype, &derror); else @@ -1164,9 +1242,9 @@ this connection to those buses. */) XD_SIGNAL2 (build_string ("No connection to bus"), bus); /* If it is not the system or session bus, we must register - ourselves. Otherwise, we have called dbus_bus_get, which has - configured us to exit if the connection closes - we undo this - setting. */ + ourselves. Otherwise, we have called dbus_bus_get{_private}, + which has configured us to exit if the connection closes - we + undo this setting. */ if (STRINGP (bus)) dbus_bus_register (connection, &derror); else @@ -1181,25 +1259,28 @@ this connection to those buses. */) xd_add_watch, xd_remove_watch, xd_toggle_watch, - SYMBOLP (bus) + XD_KEYWORDP (bus) ? (void *) XSYMBOL (bus) : (void *) XSTRING (bus), NULL)) XD_SIGNAL1 (build_string ("Cannot add watch functions")); /* Add bus to list of registered buses. */ - val = make_save_ptr (connection); + val = make_mint_ptr (connection); xd_registered_buses = Fcons (Fcons (bus, val), xd_registered_buses); /* Cleanup. */ dbus_error_free (&derror); } + XD_DEBUG_MESSAGE ("Registered buses: %s", + XD_OBJECT_TO_STRING (xd_registered_buses)); + /* Return reference counter. */ refcount = xd_get_connection_references (connection); XD_DEBUG_MESSAGE ("Bus %s, Reference counter %"pD"d", XD_OBJECT_TO_STRING (bus), refcount); - return make_number (refcount); + return make_fixnum (refcount); } DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name, @@ -1247,7 +1328,11 @@ The following usages are expected: `dbus-method-error-internal': (dbus-message-internal - dbus-message-type-error BUS SERVICE SERIAL &rest ARGS) + dbus-message-type-error BUS SERVICE SERIAL ERROR-NAME &rest ARGS) + +`dbus-check-arguments': (does not send a message) + (dbus-message-internal + dbus-message-type-invalid BUS SERVICE &rest ARGS) usage: (dbus-message-internal &rest REST) */) (ptrdiff_t nargs, Lisp_Object *args) @@ -1256,6 +1341,7 @@ usage: (dbus-message-internal &rest REST) */) Lisp_Object path = Qnil; Lisp_Object interface = Qnil; Lisp_Object member = Qnil; + Lisp_Object error_name = Qnil; Lisp_Object result; DBusConnection *connection; DBusMessage *dmessage; @@ -1265,7 +1351,7 @@ usage: (dbus-message-internal &rest REST) */) dbus_uint32_t serial = 0; unsigned int ui_serial; int timeout = -1; - ptrdiff_t count; + ptrdiff_t count, count0; char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH]; /* Initialize parameters. */ @@ -1274,11 +1360,11 @@ usage: (dbus-message-internal &rest REST) */) service = args[2]; handler = Qnil; - CHECK_NATNUM (message_type); - if (! (DBUS_MESSAGE_TYPE_INVALID < XFASTINT (message_type) - && XFASTINT (message_type) < DBUS_NUM_MESSAGE_TYPES)) + CHECK_FIXNAT (message_type); + if (! (DBUS_MESSAGE_TYPE_INVALID <= XFIXNAT (message_type) + && XFIXNAT (message_type) < DBUS_NUM_MESSAGE_TYPES)) XD_SIGNAL2 (build_string ("Invalid message type"), message_type); - mtype = XFASTINT (message_type); + mtype = XFIXNAT (message_type); if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) || (mtype == DBUS_MESSAGE_TYPE_SIGNAL)) @@ -1290,11 +1376,16 @@ usage: (dbus-message-internal &rest REST) */) handler = args[6]; count = (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) ? 7 : 6; } - else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */ + else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) + || (mtype == DBUS_MESSAGE_TYPE_ERROR)) { serial = xd_extract_unsigned (args[3], TYPE_MAXIMUM (dbus_uint32_t)); - count = 4; + if (mtype == DBUS_MESSAGE_TYPE_ERROR) + error_name = args[4]; + count = (mtype == DBUS_MESSAGE_TYPE_ERROR) ? 5 : 4; } + else /* DBUS_MESSAGE_TYPE_INVALID */ + count = 3; /* Check parameters. */ XD_DBUS_VALIDATE_BUS_ADDRESS (bus); @@ -1302,7 +1393,7 @@ usage: (dbus-message-internal &rest REST) */) if (nargs < count) xsignal2 (Qwrong_number_of_arguments, Qdbus_message_internal, - make_number (nargs)); + make_fixnum (nargs)); if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL) || (mtype == DBUS_MESSAGE_TYPE_SIGNAL)) @@ -1336,24 +1427,41 @@ usage: (dbus-message-internal &rest REST) */) XD_OBJECT_TO_STRING (interface), XD_OBJECT_TO_STRING (member)); break; - default: /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */ + case DBUS_MESSAGE_TYPE_METHOD_RETURN: ui_serial = serial; XD_DEBUG_MESSAGE ("%s %s %s %u", XD_MESSAGE_TYPE_TO_STRING (mtype), XD_OBJECT_TO_STRING (bus), XD_OBJECT_TO_STRING (service), ui_serial); + break; + case DBUS_MESSAGE_TYPE_ERROR: + ui_serial = serial; + XD_DEBUG_MESSAGE ("%s %s %s %u %s", + XD_MESSAGE_TYPE_TO_STRING (mtype), + XD_OBJECT_TO_STRING (bus), + XD_OBJECT_TO_STRING (service), + ui_serial, + XD_OBJECT_TO_STRING (error_name)); + break; + default: /* DBUS_MESSAGE_TYPE_INVALID */ + XD_DEBUG_MESSAGE ("%s %s %s", + XD_MESSAGE_TYPE_TO_STRING (mtype), + XD_OBJECT_TO_STRING (bus), + XD_OBJECT_TO_STRING (service)); } /* Retrieve bus address. */ connection = xd_get_connection_address (bus); - /* Create the D-Bus message. */ - dmessage = dbus_message_new (mtype); + /* Create the D-Bus message. Since DBUS_MESSAGE_TYPE_INVALID is not + a valid message type, we mockup it with DBUS_MESSAGE_TYPE_SIGNAL. */ + dmessage = dbus_message_new + ((mtype == DBUS_MESSAGE_TYPE_INVALID) ? DBUS_MESSAGE_TYPE_SIGNAL : mtype); if (dmessage == NULL) XD_SIGNAL1 (build_string ("Unable to create a new message")); - if (STRINGP (service)) + if ((STRINGP (service)) && (mtype != DBUS_MESSAGE_TYPE_INVALID)) { if (mtype != DBUS_MESSAGE_TYPE_SIGNAL) /* Set destination. */ @@ -1395,21 +1503,22 @@ usage: (dbus-message-internal &rest REST) */) XD_SIGNAL1 (build_string ("Unable to set the message parameter")); } - else /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */ + else if ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) + || (mtype == DBUS_MESSAGE_TYPE_ERROR)) { if (!dbus_message_set_reply_serial (dmessage, serial)) 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))) - XD_SIGNAL1 (build_string ("Unable to create a error message")); + && (!dbus_message_set_error_name (dmessage, SSDATA (error_name)))) + XD_SIGNAL1 (build_string ("Unable to create an error message")); } /* Check for timeout parameter. */ if ((count + 2 <= nargs) && EQ (args[count], QCtimeout)) { - CHECK_NATNUM (args[count+1]); - timeout = min (XFASTINT (args[count+1]), INT_MAX); + CHECK_FIXNAT (args[count+1]); + timeout = min (XFIXNAT (args[count+1]), INT_MAX); count = count+2; } @@ -1417,22 +1526,25 @@ usage: (dbus-message-internal &rest REST) */) dbus_message_iter_init_append (dmessage, &iter); /* Append parameters to the message. */ + count0 = count - 1; for (; count < nargs; ++count) { dtype = XD_OBJECT_TO_DBUS_TYPE (args[count]); - if (XD_DBUS_TYPE_P (args[count])) + if (count + 1 < nargs && XD_DBUS_TYPE_P (args[count])) { XD_DEBUG_VALID_LISP_OBJECT_P (args[count]); XD_DEBUG_VALID_LISP_OBJECT_P (args[count+1]); - XD_DEBUG_MESSAGE ("Parameter%"pD"d %s %s", count - 4, + XD_DEBUG_MESSAGE ("Parameter%"pD"d: %s Parameter%"pD"d: %s", + count - count0, XD_OBJECT_TO_STRING (args[count]), + count + 1 - count0, XD_OBJECT_TO_STRING (args[count+1])); ++count; } else { XD_DEBUG_VALID_LISP_OBJECT_P (args[count]); - XD_DEBUG_MESSAGE ("Parameter%"pD"d %s", count - 4, + XD_DEBUG_MESSAGE ("Parameter%"pD"d: %s", count - count0, XD_OBJECT_TO_STRING (args[count])); } @@ -1443,7 +1555,10 @@ usage: (dbus-message-internal &rest REST) */) xd_append_arg (dtype, args[count], &iter); } - if (!NILP (handler)) + if (mtype == DBUS_MESSAGE_TYPE_INVALID) + result = Qt; + + else if (!NILP (handler)) { /* Send the message. The message is just added to the outgoing message queue. */ @@ -1453,7 +1568,7 @@ usage: (dbus-message-internal &rest REST) */) /* The result is the key in Vdbus_registered_objects_table. */ serial = dbus_message_get_serial (dmessage); - result = list3 (QCserial, bus, make_fixnum_or_float (serial)); + result = list3 (QCserial, bus, INT_TO_INTEGER (serial)); /* Create a hash table entry. */ Fputhash (result, handler, Vdbus_registered_objects_table); @@ -1468,7 +1583,8 @@ usage: (dbus-message-internal &rest REST) */) result = Qnil; } - XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result)); + if (mtype != DBUS_MESSAGE_TYPE_INVALID) + XD_DEBUG_MESSAGE ("Message sent: %s", XD_OBJECT_TO_STRING (result)); /* Cleanup. */ dbus_message_unref (dmessage); @@ -1478,8 +1594,8 @@ usage: (dbus-message-internal &rest REST) */) } /* Read one queued incoming message of the D-Bus BUS. - BUS is either a Lisp symbol, :system or :session, or a string denoting - the bus address. */ + BUS is either a Lisp symbol, :system, :session, :system-private or + :session-private, or a string denoting the bus address. */ static void xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) { @@ -1491,7 +1607,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) int mtype; dbus_uint32_t serial; unsigned int ui_serial; - const char *uname, *path, *interface, *member; + const char *uname, *destination, *path, *interface, *member, *error_name; dmessage = dbus_connection_pop_message (connection); @@ -1516,7 +1632,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) } /* Read message type, message serial, unique name, object path, - interface and member from the message. */ + interface, member and error name from the message. */ mtype = dbus_message_get_type (dmessage); ui_serial = serial = ((mtype == DBUS_MESSAGE_TYPE_METHOD_RETURN) @@ -1524,13 +1640,16 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) ? dbus_message_get_reply_serial (dmessage) : dbus_message_get_serial (dmessage); uname = dbus_message_get_sender (dmessage); + destination = dbus_message_get_destination (dmessage); path = dbus_message_get_path (dmessage); interface = dbus_message_get_interface (dmessage); member = dbus_message_get_member (dmessage); + error_name = dbus_message_get_error_name (dmessage); - XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s", + XD_DEBUG_MESSAGE ("Event received: %s %u %s %s %s %s %s %s", XD_MESSAGE_TYPE_TO_STRING (mtype), - ui_serial, uname, path, interface, member, + ui_serial, uname, destination, path, interface, + mtype == DBUS_MESSAGE_TYPE_ERROR ? error_name : member, XD_OBJECT_TO_STRING (args)); if (mtype == DBUS_MESSAGE_TYPE_INVALID) @@ -1540,12 +1659,12 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) || (mtype == DBUS_MESSAGE_TYPE_ERROR)) { /* Search for a registered function of the message. */ - key = list3 (QCserial, bus, make_fixnum_or_float (serial)); + key = list3 (QCserial, bus, INT_TO_INTEGER (serial)); value = Fgethash (key, Vdbus_registered_objects_table, Qnil); /* There shall be exactly one entry. Construct an event. */ if (NILP (value)) - goto cleanup; + goto monitor; /* Remove the entry. */ Fremhash (key, Vdbus_registered_objects_table); @@ -1554,6 +1673,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) EVENT_INIT (event); event.kind = DBUS_EVENT; event.frame_or_window = Qnil; + /* Handler. */ event.arg = Fcons (value, args); } @@ -1562,7 +1682,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) /* Vdbus_registered_objects_table requires non-nil interface and member. */ if ((interface == NULL) || (member == NULL)) - goto cleanup; + goto monitor; /* Search for a registered function of the message. */ key = list4 (mtype == DBUS_MESSAGE_TYPE_METHOD_CALL ? QCmethod : QCsignal, @@ -1570,45 +1690,53 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) value = Fgethash (key, Vdbus_registered_objects_table, Qnil); /* Loop over the registered functions. Construct an event. */ - while (!NILP (value)) + for (; !NILP (value); value = CDR_SAFE (value)) { key = CAR_SAFE (value); + Lisp_Object key_uname = CAR_SAFE (key); /* key has the structure (UNAME SERVICE PATH HANDLER). */ - if (((uname == NULL) - || (NILP (CAR_SAFE (key))) - || (strcmp (uname, SSDATA (CAR_SAFE (key))) == 0)) - && ((path == NULL) - || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key))))) - || (strcmp (path, - SSDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key))))) - == 0)) - && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key))))))) - { - EVENT_INIT (event); - event.kind = DBUS_EVENT; - event.frame_or_window = Qnil; - event.arg - = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))), args); - break; - } - value = CDR_SAFE (value); + if (uname && !NILP (key_uname) + && strcmp (uname, SSDATA (key_uname)) != 0) + continue; + Lisp_Object key_service_etc = CDR_SAFE (key); + Lisp_Object key_path_etc = CDR_SAFE (key_service_etc); + Lisp_Object key_path = CAR_SAFE (key_path_etc); + if (path && !NILP (key_path) + && strcmp (path, SSDATA (key_path)) != 0) + continue; + Lisp_Object handler = CAR_SAFE (CDR_SAFE (key_path_etc)); + if (NILP (handler)) + continue; + + /* Construct an event and exit the loop. */ + EVENT_INIT (event); + event.kind = DBUS_EVENT; + event.frame_or_window = Qnil; + event.arg = Fcons (handler, args); + break; } if (NILP (value)) - goto cleanup; + goto monitor; } - /* Add type, serial, uname, path, interface and member to the event. */ - event.arg = Fcons ((member == NULL ? Qnil : build_string (member)), - event.arg); + /* Add type, serial, uname, destination, path, interface and member + or error_name to the event. */ + event.arg + = Fcons (mtype == DBUS_MESSAGE_TYPE_ERROR + ? error_name == NULL ? Qnil : build_string (error_name) + : member == NULL ? Qnil : build_string (member), + event.arg); event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)), event.arg); event.arg = Fcons ((path == NULL ? Qnil : build_string (path)), event.arg); + event.arg = Fcons ((destination == NULL ? Qnil : build_string (destination)), + event.arg); event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)), event.arg); - event.arg = Fcons (make_fixnum_or_float (serial), event.arg); - event.arg = Fcons (make_number (mtype), event.arg); + event.arg = Fcons (INT_TO_INTEGER (serial), event.arg); + event.arg = Fcons (make_fixnum (mtype), event.arg); /* Add the bus symbol to the event. */ event.arg = Fcons (bus, event.arg); @@ -1618,14 +1746,58 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event.arg)); + /* Monitor. */ + monitor: + /* Search for a registered function of the message. */ + key = list2 (QCmonitor, bus); + value = Fgethash (key, Vdbus_registered_objects_table, Qnil); + + /* There shall be exactly one entry. Construct an event. */ + if (NILP (value)) + goto cleanup; + + /* Construct an event. */ + EVENT_INIT (event); + event.kind = DBUS_EVENT; + event.frame_or_window = Qnil; + + /* Add type, serial, uname, destination, path, interface, member + or error_name and handler to the event. */ + event.arg + = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (CAR_SAFE (value))))), + args); + event.arg + = Fcons (mtype == DBUS_MESSAGE_TYPE_ERROR + ? error_name == NULL ? Qnil : build_string (error_name) + : member == NULL ? Qnil : build_string (member), + event.arg); + event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)), + event.arg); + event.arg = Fcons ((path == NULL ? Qnil : build_string (path)), + event.arg); + event.arg = Fcons ((destination == NULL ? Qnil : build_string (destination)), + event.arg); + event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)), + event.arg); + event.arg = Fcons (INT_TO_INTEGER (serial), event.arg); + event.arg = Fcons (make_fixnum (mtype), event.arg); + + /* Add the bus symbol to the event. */ + event.arg = Fcons (bus, event.arg); + + /* Store it into the input event queue. */ + kbd_buffer_store_event (&event); + + XD_DEBUG_MESSAGE ("Monitor event stored: %s", XD_OBJECT_TO_STRING (event.arg)); + /* Cleanup. */ cleanup: dbus_message_unref (dmessage); } /* Read queued incoming messages of the D-Bus BUS. - BUS is either a Lisp symbol, :system or :session, or a string denoting - the bus address. */ + BUS is either a Lisp symbol, :system, :session, :system-private or + :session-private, or a string denoting the bus address. */ static Lisp_Object xd_read_message (Lisp_Object bus) { @@ -1654,7 +1826,7 @@ xd_read_queued_messages (int fd, void *data) while (!NILP (busp)) { key = CAR_SAFE (CAR_SAFE (busp)); - if ((SYMBOLP (key) && XSYMBOL (key) == data) + if ((XD_KEYWORDP (key) && XSYMBOL (key) == data) || (STRINGP (key) && XSTRING (key) == data)) bus = key; busp = CDR_SAFE (busp); @@ -1677,6 +1849,12 @@ init_dbusbind (void) xputenv ("DBUS_FATAL_WARNINGS=0"); } +static void +syms_of_dbusbind_for_pdumper (void) +{ + xd_registered_buses = Qnil; +} + void syms_of_dbusbind (void) { @@ -1696,6 +1874,8 @@ syms_of_dbusbind (void) /* Lisp symbols of the system and session buses. */ DEFSYM (QCsystem, ":system"); DEFSYM (QCsession, ":session"); + DEFSYM (QCsystem_private, ":system-private"); + DEFSYM (QCsession_private, ":session-private"); /* Lisp symbol for method call timeout. */ DEFSYM (QCtimeout, ":timeout"); @@ -1721,10 +1901,12 @@ syms_of_dbusbind (void) DEFSYM (QCstruct, ":struct"); DEFSYM (QCdict_entry, ":dict-entry"); - /* Lisp symbols of objects in `dbus-registered-objects-table'. */ + /* Lisp symbols of objects in `dbus-registered-objects-table'. + `:property', which does exist there as well, is not declared here. */ DEFSYM (QCserial, ":serial"); DEFSYM (QCmethod, ":method"); DEFSYM (QCsignal, ":signal"); + DEFSYM (QCmonitor, ":monitor"); DEFVAR_LISP ("dbus-compiled-version", Vdbus_compiled_version, @@ -1753,57 +1935,61 @@ syms_of_dbusbind (void) DEFVAR_LISP ("dbus-message-type-invalid", Vdbus_message_type_invalid, doc: /* This value is never a valid message type. */); - Vdbus_message_type_invalid = make_number (DBUS_MESSAGE_TYPE_INVALID); + Vdbus_message_type_invalid = make_fixnum (DBUS_MESSAGE_TYPE_INVALID); DEFVAR_LISP ("dbus-message-type-method-call", Vdbus_message_type_method_call, doc: /* Message type of a method call message. */); - Vdbus_message_type_method_call = make_number (DBUS_MESSAGE_TYPE_METHOD_CALL); + Vdbus_message_type_method_call = make_fixnum (DBUS_MESSAGE_TYPE_METHOD_CALL); DEFVAR_LISP ("dbus-message-type-method-return", Vdbus_message_type_method_return, doc: /* Message type of a method return message. */); Vdbus_message_type_method_return - = make_number (DBUS_MESSAGE_TYPE_METHOD_RETURN); + = make_fixnum (DBUS_MESSAGE_TYPE_METHOD_RETURN); DEFVAR_LISP ("dbus-message-type-error", Vdbus_message_type_error, doc: /* Message type of an error reply message. */); - Vdbus_message_type_error = make_number (DBUS_MESSAGE_TYPE_ERROR); + Vdbus_message_type_error = make_fixnum (DBUS_MESSAGE_TYPE_ERROR); DEFVAR_LISP ("dbus-message-type-signal", Vdbus_message_type_signal, doc: /* Message type of a signal message. */); - Vdbus_message_type_signal = make_number (DBUS_MESSAGE_TYPE_SIGNAL); + Vdbus_message_type_signal = make_fixnum (DBUS_MESSAGE_TYPE_SIGNAL); DEFVAR_LISP ("dbus-registered-objects-table", Vdbus_registered_objects_table, doc: /* Hash table of registered functions for D-Bus. There are two different uses of the hash table: for accessing -registered interfaces properties, targeted by signals or method calls, -and for calling handlers in case of non-blocking method call returns. +registered interfaces properties, targeted by signals, method calls or +monitors, and for calling handlers in case of non-blocking method call +returns. In the first case, the key in the hash table is the list (TYPE BUS -INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method', -`:signal' or `:property'. BUS is either a Lisp symbol, `:system' or -`:session', or a string denoting the bus address. INTERFACE is a -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. +[INTERFACE MEMBER]). TYPE is one of the Lisp symbols `:method', +`:signal', `:property' or `:monitor'. BUS is either a Lisp symbol, +`:system', `:session', `:system-private' or `:session-private', or a +string denoting the bus address. INTERFACE is a 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 can be nil. 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 -path of the sending object. All of them can be nil, which means a -wildcard then. OBJECT is either the handler to be called when a D-Bus -message, which matches the key criteria, arrives (TYPE `:method' and -`:signal'), or a cons cell containing the value of the property (TYPE -`:property'). +registered methods, properties and monitors, UNAME is nil. PATH is +the object path of the sending object. All of them can be nil, which +means a wildcard then. + +OBJECT is either the handler to be called when a D-Bus message, which +matches the key criteria, arrives (TYPE `:method', `:signal' and +`:monitor'), or a list (ACCESS EMITS-SIGNAL VALUE) for TYPE +`:property'. -For entries of type `:signal', there is also a fifth element RULE, -which keeps the match string the signal is registered with. +For entries of type `:signal' or `:monitor', there is also a fifth +element RULE, which keeps the match string the signal or monitor is +registered with. In the second case, the key in the hash table is the list (:serial BUS SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a @@ -1825,11 +2011,10 @@ be called when the D-Bus reply message arrives. */); #endif /* Initialize internal objects. */ - xd_registered_buses = Qnil; + pdumper_do_now_and_after_load (syms_of_dbusbind_for_pdumper); staticpro (&xd_registered_buses); Fprovide (intern_c_string ("dbusbind"), Qnil); - } #endif /* HAVE_DBUS */ |