# HG changeset patch # User Michael Albinus # Date 1197002839 0 # Node ID bcf59f3d73d76de9282ff8a96ae7495234521cf9 # Parent f10e4cb7d001bae911d6795d1ccc1e40c55df5c1 * net/dbus.el (dbus-hash-table=): Fix for new hash table key structure. (dbus-list-hash-table, dbus-name-owner-changed-handler): New defuns. (dbus-check-event, dbus-handle-event, dbus-event-bus-name) (dbus-event-service-name, dbus-event-path-name) (dbus-event-interface-name, dbus-event-member-name): Fix for new event structure. (dbus-list-activatable-names, dbus-list-names) (dbus-list-queued-owners, dbus-get-name-owner, dbus-introspect): Reorder `dbus-call-method' arguments. diff -r f10e4cb7d001 -r bcf59f3d73d7 lisp/ChangeLog --- a/lisp/ChangeLog Fri Dec 07 04:42:00 2007 +0000 +++ b/lisp/ChangeLog Fri Dec 07 04:47:19 2007 +0000 @@ -1,3 +1,17 @@ +2007-12-07 Michael Albinus + + * net/dbus.el (dbus-hash-table=): Fix for new hash table key + structure. + (dbus-list-hash-table, dbus-name-owner-changed-handler): New + defuns. + (dbus-check-event, dbus-handle-event, dbus-event-bus-name) + (dbus-event-service-name, dbus-event-path-name) + (dbus-event-interface-name, dbus-event-member-name): Fix for new + event structure. + (dbus-list-activatable-names, dbus-list-names) + (dbus-list-queued-owners, dbus-get-name-owner, dbus-introspect): + Reorder `dbus-call-method' arguments. + 2007-12-06 D. Goel * allout.el (allout-write-file-hook-handler): diff -r f10e4cb7d001 -r bcf59f3d73d7 lisp/net/dbus.el --- a/lisp/net/dbus.el Fri Dec 07 04:42:00 2007 +0000 +++ b/lisp/net/dbus.el Fri Dec 07 04:47:19 2007 +0000 @@ -53,29 +53,82 @@ "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)) + (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 (nth 2 x)) (null (nth 2 y)) ; wildcard + (string-equal (nth 2 x) (nth 2 y))) + ;; Member. + (or + (null (nth 3 x)) (null (nth 3 y)) ; wildcard + (string-equal (nth 3 x) (nth 3 y))) ;; Interface. (or - (null (cadr x)) (null (cadr y)) ; wildcard - (and - (stringp (cadr x)) (stringp (cadr y)) (string-equal (cadr x) (cadr 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 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)) + ;;; D-Bus events. @@ -83,33 +136,34 @@ "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 2 event)) + ;; Object path. (stringp (nth 3 event)) - ;; Object path. + ;; Interface. (stringp (nth 4 event)) - ;; Interface. + ;; Member. (stringp (nth 5 event)) - ;; Member. - (stringp (nth 6 event))) + ;; Handler. + (functionp (nth 6 event))) (signal 'dbus-error (list "Not a valid D-Bus event" event)))) ;;;###autoload @@ -123,7 +177,7 @@ (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) @@ -133,7 +187,7 @@ 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. @@ -141,7 +195,7 @@ 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. @@ -149,7 +203,7 @@ 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. @@ -157,7 +211,7 @@ 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. @@ -166,7 +220,7 @@ function raises a `dbus-error' signal in case the event is not well formed." (dbus-check-event event) - (nth 6 event)) + (nth 5 event)) ;;; D-Bus registered names. @@ -177,8 +231,8 @@ 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) @@ -189,7 +243,7 @@ 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) @@ -206,8 +260,8 @@ 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) @@ -215,8 +269,8 @@ 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) @@ -227,10 +281,10 @@ \(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?