;; </signal>
;; </interface>
+(defconst dbus-interface-monitoring (concat dbus-interface-dbus ".Monitoring")
+ "The monitoring interface.
+See URL `https://dbus.freedesktop.org/doc/dbus-specification.html#bus-messages-become-monitor'.")
+
+;; <interface name="org.freedesktop.DBus.Monitoring">
+;; <method name="BecomeMonitor">
+;; <arg name="rule" type="as" direction="in"/>
+;; <arg name="flags" type="u" direction="in"/> ;; Not used, must be 0.
+;; </method>
+;; </interface>
+
(defconst dbus-interface-local (concat dbus-interface-dbus ".Local")
"An interface whose methods can only be invoked by the local implementation.")
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (null service) (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
- (or (memq bus '(:system :session)) (stringp bus)
+ (or (memq bus '(:system :session :system-private :session-private))
+ (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
"Check whether EVENT is a well formed D-Bus event.
EVENT is a list which starts with symbol `dbus-event':
- (dbus-event BUS TYPE SERIAL SERVICE PATH INTERFACE MEMBER HANDLER &rest ARGS)
+ (dbus-event BUS TYPE SERIAL SERVICE DESTINATION PATH
+ INTERFACE MEMBER HANDLER &rest ARGS)
BUS identifies the D-Bus the message is coming from. It is
-either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address. TYPE is the D-Bus message type which
-has caused the event, SERIAL is the serial number of the received
-D-Bus message. SERVICE and PATH are the unique name and the
-object path of the D-Bus object emitting the message. INTERFACE
-and MEMBER denote the message which has been sent. HANDLER is
-the function which has been registered for this message. ARGS
-are the typed arguments as returned from the message. They are
-passed to HANDLER without type information, when it is called
-during event handling in `dbus-handle-event'.
+either a Lisp symbol, `:system', `:session', `:systemp-private'
+or `:session-private', or a string denoting the bus address.
+
+TYPE is the D-Bus message type which has caused the event, SERIAL
+is the serial number of the received D-Bus message when TYPE is
+equal `dbus-message-type-method-return' or `dbus-message-type-error'.
+
+SERVICE and PATH are the unique name and the object path of the
+D-Bus object emitting the message. DESTINATION is the D-Bus name
+the message is dedicated to, or nil in case thje message is a
+broadcast signal.
+
+INTERFACE and MEMBER denote the message which has been sent.
+When TYPE is `dbus-message-type-error', MEMBER is the error name.
+
+HANDLER is the function which has been registered for this
+message. ARGS are the typed arguments as returned from the
+message. They are passed to HANDLER without type information,
+when it is called during event handling in `dbus-handle-event'.
This function signals a `dbus-error' if the event is not well
formed."
(unless (and (listp event)
(eq (car event) 'dbus-event)
;; Bus symbol.
- (or (symbolp (nth 1 event))
+ (or (keywordp (nth 1 event))
(stringp (nth 1 event)))
;; Type.
(and (natnump (nth 2 event))
(= dbus-message-type-error (nth 2 event))
(or (stringp (nth 4 event))
(null (nth 4 event))))
- ;; Object path.
+ ;; Destination.
(or (= dbus-message-type-method-return (nth 2 event))
(= dbus-message-type-error (nth 2 event))
- (stringp (nth 5 event)))
- ;; Interface.
+ (or (stringp (nth 5 event))
+ (null (nth 5 event))))
+ ;; Object path.
(or (= dbus-message-type-method-return (nth 2 event))
(= dbus-message-type-error (nth 2 event))
(stringp (nth 6 event)))
- ;; Member.
+ ;; Interface.
(or (= dbus-message-type-method-return (nth 2 event))
(= dbus-message-type-error (nth 2 event))
(stringp (nth 7 event)))
+ ;; Member.
+ (or (= dbus-message-type-method-return (nth 2 event))
+ (stringp (nth 8 event)))
;; Handler.
- (functionp (nth 8 event)))
+ (functionp (nth 9 event))
+ ;; Arguments.
+ (listp (nthcdr 10 event)))
(signal 'dbus-error (list "Not a valid D-Bus event" event))))
(defun dbus-delete-types (&rest args)
If the HANDLER returns a `dbus-error', it is propagated as return message."
(interactive "e")
(condition-case err
- (let (args result)
+ (let (monitor args result)
;; We ignore not well-formed events.
(dbus-check-event event)
;; Remove type information.
- (setq args (mapcar #'dbus-delete-types (nthcdr 9 event)))
- ;; Error messages must be propagated.
- (when (= dbus-message-type-error (nth 2 event))
- (signal 'dbus-error args))
- ;; Apply the handler.
- (setq result (apply (nth 8 event) args))
- ;; Return an (error) message when it is a message call.
- (when (= dbus-message-type-method-call (nth 2 event))
- (dbus-ignore-errors
- (if (eq (car-safe result) :error)
- (apply #'dbus-method-error-internal
- (nth 1 event) (nth 4 event) (nth 3 event) (cdr result))
- (if (eq result :ignore)
- (dbus-method-return-internal
- (nth 1 event) (nth 4 event) (nth 3 event))
- (apply #'dbus-method-return-internal
- (nth 1 event) (nth 4 event) (nth 3 event)
- (if (consp result) result (list result))))))))
+ (setq args (mapcar #'dbus-delete-types (nthcdr 10 event)))
+ (setq monitor
+ (gethash
+ (list :monitor (nth 1 event)) dbus-registered-objects-table))
+ (if monitor
+ ;; A monitor event shall not trigger other operations, and
+ ;; it shall not trigger D-Bus errors.
+ (setq result (dbus-ignore-errors (apply (nth 9 event) args)))
+ ;; Error messages must be propagated. The error name is in
+ ;; the member slot.
+ (when (= dbus-message-type-error (nth 2 event))
+ (signal 'dbus-error (cons (nth 8 event) args)))
+ ;; Apply the handler.
+ (setq result (apply (nth 9 event) args))
+ ;; Return an (error) message when it is a message call.
+ (when (= dbus-message-type-method-call (nth 2 event))
+ (dbus-ignore-errors
+ (if (eq (car-safe result) :error)
+ (apply #'dbus-method-error-internal
+ (nth 1 event) (nth 4 event) (nth 3 event) (cdr result))
+ (if (eq result :ignore)
+ (dbus-method-return-internal
+ (nth 1 event) (nth 4 event) (nth 3 event))
+ (apply #'dbus-method-return-internal
+ (nth 1 event) (nth 4 event) (nth 3 event)
+ (if (consp result) result (list result)))))))))
;; Error handling.
(dbus-error
;; Return an error message when it is a message call.
(dbus-check-event event)
(nth 4 event))
+(defun dbus-event-destination-name (event)
+ "Return the name of the D-Bus object the event is dedicated to.
+The result is a string. EVENT is a D-Bus event, see `dbus-check-event'.
+This function signals a `dbus-error' if the event is not well
+formed."
+ (dbus-check-event event)
+ (nth 5 event))
+
(defun dbus-event-path-name (event)
"Return the object path of the D-Bus object the event is coming from.
The result is a string. EVENT is a D-Bus event, see `dbus-check-event'.
This function signals a `dbus-error' if the event is not well
formed."
(dbus-check-event event)
- (nth 5 event))
+ (nth 6 event))
(defun dbus-event-interface-name (event)
"Return the interface name of the D-Bus object the event is coming from.
This function signals a `dbus-error' if the event is not well
formed."
(dbus-check-event event)
- (nth 6 event))
+ (nth 7 event))
(defun dbus-event-member-name (event)
"Return the member name the event is coming from.
-It is either a signal name or a method name. The result is a
-string. EVENT is a D-Bus event, see `dbus-check-event'. This
-function signals a `dbus-error' if the event is not well formed."
+It is either a signal name, a method name or an error name. The
+result is a string. EVENT is a D-Bus event, see
+`dbus-check-event'. This function signals a `dbus-error' if the
+event is not well formed."
(dbus-check-event event)
- (nth 7 event))
+ (nth 8 event))
+
+(defun dbus-event-handler (event)
+ "Return the handler the event is applied with.
+The result is a function. EVENT is a D-Bus event, see
+`dbus-check-event'. This function signals a `dbus-error' if the
+event is not well formed."
+ (dbus-check-event event)
+ (nth 9 event))
+
+(defun dbus-event-arguments (event)
+ "Return the arguments the event is carrying on.
+The result is a list of arguments. EVENT is a D-Bus event, see
+`dbus-check-event'. This function signals a `dbus-error' if the
+event is not well formed."
+ (dbus-check-event event)
+ (nthcdr 10 event))
\f
;;; D-Bus registered names.
;; "Set" needs the third typed argument from `last-input-event'.
((string-equal method "Set")
- (let* ((value (dbus-flatten-types (nth 11 last-input-event)))
+ (let* ((value (dbus-flatten-types (nth 12 last-input-event)))
(entry (dbus-get-this-registered-property
bus service path interface property))
(object (car (last (car entry)))))
result)
'(:signature "{oa{sa{sv}}}"))))))
+(defun dbus-register-monitor
+ (bus &optional service path interface member handler &rest args)
+ "Register HANDLER for monitor events on the D-Bus BUS.
+
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
+
+SERVICE is the D-Bus service name of the D-Bus. It must be a
+known name (see discussion of DONT-REGISTER-SERVICE below).
+
+PATH is the D-Bus object path SERVICE is registered at (see
+discussion of DONT-REGISTER-SERVICE below). INTERFACE is the
+name of the interface used at PATH. MEMBER is either a method
+name, a signal name, or an error name.
+
+HANDLER is the function to be called when a monitor event
+arrives. If nil, the default handler `dbus-monitor-handler' is
+applied. It is called with ARGS as arguments."
+
+ (let ((bus-private (if (eq bus :system) :system-private
+ (if (eq bus :session) :session-private bus)))
+ keyword type rule1 rule2 key key1 value)
+ (unless handler (setq handler #'dbus-monitor-handler))
+ ;; Read arguments.
+ (while args
+ (when (keywordp (setq keyword (pop args)))
+ (cond
+ ((eq :type keyword)
+ ;; Must be "signal", "method_call", "method_return", or "error".
+ (setq type (pop args))))))
+ ;; Compose rules.
+ (setq rule1
+ (or
+ (string-join
+ (delq nil
+ (list (when service (format "sender='%s'" service))
+ (when path (format "path='%s'" path))
+ (when interface (format "interface='%s'" interface))
+ (when member (format "member='%s'" member))
+ (when type (format "type='%s'" type))))
+ ",")
+ "")
+ rule2
+ (when service
+ (string-join
+ (delq nil
+ (list (format "destination='%s'" service)
+ (when path (format "path='%s'" path))
+ (when interface (format "interface='%s'" interface))
+ (when member (format "member='%s'" member))
+ (when type (format "type='%s'" type))))
+ ",")))
+
+ (unless (ignore-errors (dbus-get-unique-name bus-private))
+ (dbus-init-bus bus 'private))
+ (dbus-call-method
+ bus-private dbus-service-dbus dbus-path-dbus dbus-interface-monitoring
+ "BecomeMonitor"
+ (append `(:array :string ,rule1) (when rule2 `(:string ,rule2)))
+ :uint32 0)
+
+ (when dbus-debug (message "Matching rule \"%s\" created" rule1))
+
+ ;; Create a hash table entry.
+ (setq key (list :monitor bus-private)
+ key1 (list nil nil nil handler)
+ value (gethash key dbus-registered-objects-table))
+ (unless (member key1 value)
+ (puthash key (cons key1 value) dbus-registered-objects-table))
+
+ (when dbus-debug (message "%s" dbus-registered-objects-table))
+
+ ;; Return the object.
+ (list key (list service path handler))))
+
+(defun dbus-monitor-handler (&rest _args)
+ "Default handler for the \"org.freedesktop.DBus.Monitoring.BecomeMonitor\" interface.
+It will be applied all objects created by `dbus-register-monitor'."
+ (with-current-buffer (get-buffer-create "*D-Bus Monitor*")
+ (special-mode)
+ (let* ((inhibit-read-only t)
+ (eobp (eobp))
+ (event last-input-event)
+ (type (dbus-event-message-type event))
+ (sender (dbus-event-service-name event))
+ (destination (dbus-event-destination-name event))
+ (serial (dbus-event-serial-number event))
+ (path (dbus-event-path-name event))
+ (interface (dbus-event-interface-name event))
+ (member (dbus-event-member-name event))
+ (arguments (dbus-event-arguments event)))
+ (save-excursion
+ (goto-char (point-max))
+ (insert
+ (format
+ (concat
+ "%s sender=%s -> destination=%s serial=%s "
+ "path=%s interface=%s member=%s\n")
+ (cond
+ ((= type dbus-message-type-method-call) "method-call")
+ ((= type dbus-message-type-method-return) "method-return")
+ ((= type dbus-message-type-error) "error")
+ ((= type dbus-message-type-signal) "signal"))
+ sender destination serial path interface member))
+ (dolist (arg arguments)
+ (pp (dbus-flatten-types arg) (current-buffer)))
+ (insert "\n"))
+ (when eobp
+ (goto-char (point-max))))))
+
(defun dbus-handle-bus-disconnect ()
"React to a bus disconnection.
BUS is the bus that disconnected. This routine unregisters all
handlers on the given bus and causes all synchronous calls
pending at the time of disconnect to fail."
(let ((bus (dbus-event-bus-name last-input-event))
- (keys-to-remove))
+ keys-to-remove)
(maphash
(lambda (key value)
(when (and (eq (nth 0 key) :serial)
(list 'dbus-event
bus
dbus-message-type-error
- (nth 2 key)
- nil
- nil
- nil
- nil
- value)
- (list 'dbus-error "Bus disconnected" bus))
+ (nth 2 key) ; serial
+ nil ; service
+ nil ; destination
+ nil ; path
+ nil ; interface
+ nil ; member
+ value) ; handler
+ (list 'dbus-error dbus-error-disconnected "Bus disconnected" bus))
(push key keys-to-remove)))
dbus-registered-objects-table)
(dolist (key keys-to-remove)
;;; TODO:
-;; * Check property type in org.freedesktop.DBus.Properties.Set.
-;;
;; * Implement org.freedesktop.DBus.ObjectManager.InterfacesAdded and
;; org.freedesktop.DBus.ObjectManager.InterfacesRemoved.
;;
-;; * Implement org.freedesktop.DBus.Monitoring.BecomeMonitor.
-;;
;; * Cache introspection data.
;;
;; * Run handlers in own threads.
\f
/* 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. */
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)
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)
{
}
/* 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)
{
/* 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");
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
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. */
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
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
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",
}
/* 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)
{
int mtype;
dbus_uint32_t serial;
unsigned int ui_serial;
- const char *uname, *path, *interface, *member, *error_name;
+ const char *uname, *destination, *path, *interface, *member, *error_name;
dmessage = dbus_connection_pop_message (connection);
? 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);
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, error_name,
+ 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)
/* 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);
EVENT_INIT (event);
event.kind = DBUS_EVENT;
event.frame_or_window = Qnil;
- event.arg =
- Fcons (value,
- (mtype == DBUS_MESSAGE_TYPE_ERROR)
- ? Fcons (list2 (QCstring, build_string (error_name)), args)
- : args);
+ /* Handler. */
+ event.arg = Fcons (value, args);
}
else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */
/* 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,
EVENT_INIT (event);
event.kind = DBUS_EVENT;
event.frame_or_window = Qnil;
+ /* Handler. */
event.arg
= Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))), 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 (INT_TO_INTEGER (serial), event.arg);
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)
{
/* 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");
DEFSYM (QCdict_entry, ":dict-entry");
/* Lisp symbols of objects in `dbus-registered-objects-table'.
- `:property', which does exist there as well, is not used here. */
+ `: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,
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
-list (ACCESS EMITS-SIGNAL VALUE) for TYPE `:property'.
+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.
projects / emacs.git / commitdiff