changeset 87159:bcf59f3d73d7

* 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.

--- 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 @@
[phone]  Michael Albinus  <[e-mail]>
+
+	* 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  <[e-mail]>
 
 	* allout.el (allout-write-file-hook-handler):

--- 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?