"Compares keys X and Y in the hash table of registered functions for D-Bus.
See `dbus-registered-functions-table' for a description of the hash table."
(and
- (listp x) (listp y)
;; Bus symbol, either :system or :session.
- (symbolp (car x)) (symbolp (car y)) (equal (car x) (car y))
- ;; Interface.
+ (equal (car x) (car y))
+ ;; Service.
+ (or
+ (null (nth 1 x)) (null (nth 1 y)) ; wildcard
+ (string-equal (nth 1 x) (nth 1 y)))
+ ;; Path.
(or
- (null (cadr x)) (null (cadr y)) ; wildcard
- (and
- (stringp (cadr x)) (stringp (cadr y)) (string-equal (cadr x) (cadr y))))
+ (null (nth 2 x)) (null (nth 2 y)) ; wildcard
+ (string-equal (nth 2 x) (nth 2 y)))
;; Member.
(or
- (null (caddr x)) (null (caddr y)) ; wildcard
- (and
- (stringp (caddr x)) (stringp (caddr y))
- (string-equal (caddr x) (caddr y))))))
+ (null (nth 3 x)) (null (nth 3 y)) ; wildcard
+ (string-equal (nth 3 x) (nth 3 y)))
+ ;; Interface.
+ (or
+ (null (nth 4 x)) (null (nth 4 y)) ; wildcard
+ (string-equal (nth 4 x) (nth 4 y)))))
(define-hash-table-test 'dbus-hash-table-test 'dbus-hash-table= 'sxhash)
-;; When we assume that interface and and member are always strings in
-;; the key, we could use `equal' as test function. But we want to
-;; have also `nil' there, being a wildcard.
+;; When we assume that service, path, interface and and member are
+;; always strings in the key, we could use `equal' as test function.
+;; But we want to have also `nil' there, being a wildcard.
(setq dbus-registered-functions-table
(make-hash-table :test 'dbus-hash-table-test))
+(defun dbus-list-hash-table ()
+ "Returns all registered signal registrations to D-Bus.
+The return value is a list, with elements of kind (KEY . VALUE).
+See `dbus-registered-functions-table' for a description of the
+hash table."
+ (let (result)
+ (maphash
+ '(lambda (key value) (add-to-list 'result (cons key value) 'append))
+ dbus-registered-functions-table)
+ result))
+
+(defun dbus-name-owner-changed-handler (service old-owner new-owner)
+ "Reapplies all signal registrations to D-Bus.
+This handler is applied when a \"NameOwnerChanged\" signal has
+arrived. SERVICE is the object name for which the name owner has
+been changed. OLD-OWNER is the previous owner of SERVICE, or the
+empty string if SERVICE was not owned yet. NEW-OWNER is the new
+owner of SERVICE, or the empty string if SERVICE looses any name owner."
+ (save-match-data
+ ;; Check whether SERVICE is a known name, and OLD-OWNER and
+ ;; NEW-OWNER are defined.
+ (when (and (stringp service) (not (string-match "^:" service))
+ (not (zerop (length old-owner)))
+ (not (zerop (length new-owner))))
+ (let ((bus (dbus-event-bus-name last-input-event)))
+ (maphash
+ '(lambda (key value)
+ ;; Check for matching bus and service name.
+ (when (and (equal bus (car key))
+ (string-equal old-owner (nth 1 key)))
+ ;; Remove old key, and add new entry with changed name.
+ (when dbus-debug (message "Remove rule for %s" key))
+ (dbus-unregister-signal key)
+ (setcar (nthcdr 1 key) new-owner)
+ (when dbus-debug (message "Add rule for %s" key))
+ (apply 'dbus-register-signal (append key (list value)))))
+ (copy-hash-table dbus-registered-functions-table))))))
+
+;; Register the handler.
+(condition-case nil
+ (progn
+ (dbus-register-signal
+ :system dbus-service-dbus dbus-path-dbus dbus-interface-dbus
+ "NameOwnerChanged" 'dbus-name-owner-changed-handler)
+ (dbus-register-signal
+ :session dbus-service-dbus dbus-path-dbus dbus-interface-dbus
+ "NameOwnerChanged" 'dbus-name-owner-changed-handler))
+ (dbus-error))
+
\f
;;; D-Bus events.
"Checks whether EVENT is a well formed D-Bus event.
EVENT is a list which starts with symbol `dbus-event':
- (dbus-event HANDLER BUS SERVICE PATH INTERFACE MEMBER &rest ARGS)
+ (dbus-event BUS SERVICE PATH INTERFACE MEMBER HANDLER &rest ARGS)
-HANDLER is the function which has been registered for this
-signal. BUS identifies the D-Bus the signal is coming from. It
-is either the symbol `:system' or the symbol `:session'. SERVICE
-and PATH are the name and the object path of the D-Bus object
+BUS identifies the D-Bus the signal is coming from. It is either
+the symbol `:system' or the symbol `:session'. SERVICE and PATH
+are the unique name and the object path of the D-Bus object
emitting the signal. INTERFACE and MEMBER denote the signal
-which has been sent. ARGS are the arguments passed to HANDLER,
-when it is called during event handling in `dbus-handle-event'.
+which has been sent. HANDLER is the function which has been
+registered for this signal. ARGS are the arguments passed to
+HANDLER, when it is called during event handling in
+`dbus-handle-event'.
This function raises a `dbus-error' signal in case the event is
not well formed."
(when dbus-debug (message "DBus-Event %s" event))
(unless (and (listp event)
(eq (car event) 'dbus-event)
- ;; Handler.
- (functionp (nth 1 event))
;; Bus symbol.
- (symbolp (nth 2 event))
+ (symbolp (nth 1 event))
;; Service.
- (stringp (nth 3 event))
+ (stringp (nth 2 event))
;; Object path.
- (stringp (nth 4 event))
+ (stringp (nth 3 event))
;; Interface.
- (stringp (nth 5 event))
+ (stringp (nth 4 event))
;; Member.
- (stringp (nth 6 event)))
+ (stringp (nth 5 event))
+ ;; Handler.
+ (functionp (nth 6 event)))
(signal 'dbus-error (list "Not a valid D-Bus event" event))))
;;;###autoload
(condition-case nil
(progn
(dbus-check-event event)
- (apply (cadr event) (nthcdr 7 event)))
+ (apply (nth 6 event) (nthcdr 7 event)))
(dbus-error)))
(defun dbus-event-bus-name (event)
raises a `dbus-error' signal in case the event is not well
formed."
(dbus-check-event event)
- (nth 2 event))
+ (nth 1 event))
(defun dbus-event-service-name (event)
"Return the name of the D-Bus object the event is coming from.
This function raises a `dbus-error' signal in case the event is
not well formed."
(dbus-check-event event)
- (nth 3 event))
+ (nth 2 event))
(defun dbus-event-path-name (event)
"Return the object path of the D-Bus object the event is coming from.
This function raises a `dbus-error' signal in case the event is
not well formed."
(dbus-check-event event)
- (nth 4 event))
+ (nth 3 event))
(defun dbus-event-interface-name (event)
"Return the interface name of the D-Bus object the event is coming from.
This function raises a `dbus-error' signal in case the event is
not well formed."
(dbus-check-event event)
- (nth 5 event))
+ (nth 4 event))
(defun dbus-event-member-name (event)
"Return the member name the event is coming from.
function raises a `dbus-error' signal in case the event is not
well formed."
(dbus-check-event event)
- (nth 6 event))
+ (nth 5 event))
\f
;;; D-Bus registered names.
activatable service names at all."
(condition-case nil
(dbus-call-method
- :system "ListActivatableNames" dbus-service-dbus
- dbus-path-dbus dbus-interface-dbus)
+ :system dbus-service-dbus
+ dbus-path-dbus dbus-interface-dbus "ListActivatableNames")
(dbus-error)))
(defun dbus-list-names (bus)
for services."
(condition-case nil
(dbus-call-method
- bus "ListNames" dbus-service-dbus dbus-path-dbus dbus-interface-dbus)
+ bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListNames")
(dbus-error)))
(defun dbus-list-known-names (bus)
owners service names at all."
(condition-case nil
(dbus-call-method
- bus "ListQueuedOwners" dbus-service-dbus
- dbus-path-dbus dbus-interface-dbus service)
+ bus dbus-service-dbus dbus-path-dbus
+ dbus-interface-dbus "ListQueuedOwners" service)
(dbus-error)))
(defun dbus-get-name-owner (bus service)
The result is either a string, or nil if there is no name owner."
(condition-case nil
(dbus-call-method
- bus "GetNameOwner" dbus-service-dbus
- dbus-path-dbus dbus-interface-dbus service)
+ bus dbus-service-dbus dbus-path-dbus
+ dbus-interface-dbus "GetNameOwner" service)
(dbus-error)))
(defun dbus-introspect (bus service path)
\(dbus-introspect
:system \"org.freedesktop.Hal\"
- \"/org/freedesktop/Hal/devices/computer\"))"
+ \"/org/freedesktop/Hal/devices/computer\")"
(condition-case nil
(dbus-call-method
- bus "Introspect" service path dbus-interface-introspectable)
+ bus service path dbus-interface-introspectable "Introspect")
(dbus-error)))
(if nil ;; Must be reworked. Shall we offer D-Bus signatures at all?
projects / emacs.git / commitdiff