* net/dbus.el: Implement signal "PropertiesChanged" (from D-Bus 1.3.1).

(dbus-register-property): New optional argument EMITS-SIGNAL.
(dbus-property-handler): Send signal "PropertiesChanged" if requested.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b087fbb5b8ef32805b802a428fb604b2d115011f..2404509c920458ea4f4f93fdcccffe9435b2b07b 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2010-07-04  Michael Albinus  <michael.albinus@gmx.de>
+
+       * net/dbus.el: Implement signal "PropertiesChanged" (from D-Bus 1.3.1).
+       (dbus-register-property): New optional argument EMITS-SIGNAL.
+       (dbus-property-handler): Send signal "PropertiesChanged" if requested.
+
 2010-07-03  Chong Yidong  <cyd@stupidchicken.com>
 
        * mouse.el (mouse-drag-overlay): Variable deleted.

diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 46cbb723d76ed3a6a86f2f180286e6671c006665..8c10074b25cb7f2be64896c4bd2c8a8019a480b8 100644 (file)
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -869,7 +869,7 @@ name of the property, and its value.  If there are no properties,
        (add-to-list 'result (cons (car dict) (caadr dict)) 'append)))))
 
 (defun dbus-register-property
-  (bus service path interface property access value)
+  (bus service path interface property access value &optional emits-signal)
   "Register property PROPERTY on the D-Bus BUS.
 
 BUS is either the symbol `:system' or the symbol `:session'.
@@ -892,7 +892,9 @@ can be changed by `dbus-set-property'.
 
 The interface \"org.freedesktop.DBus.Properties\" is added to
 PATH, including a default handler for the \"Get\", \"GetAll\" and
-\"Set\" methods of this interface."
+\"Set\" methods of this interface.  When EMITS-SIGNAL is non-nil,
+the signal \"PropertiesChanged\" is sent when the property is
+changed by `dbus-set-property'."
   (unless (member access '(:read :readwrite))
     (signal 'dbus-error (list "Access type invalid" access)))
 
@@ -911,10 +913,23 @@ PATH, including a default handler for the \"Get\", \"GetAll\" and
   (dbus-register-method
    bus service path dbus-interface-properties "Set" 'dbus-property-handler)
 
+  ;; Send the PropertiesChanged signal.
+  (when emits-signal
+    (dbus-send-signal
+     bus service path dbus-interface-properties "PropertiesChanged"
+     (list (list :dict-entry property (list :variant value)))
+     '(:array)))
+
   ;; Create a hash table entry.  We use nil for the unique name,
   ;; because the property might be accessed from anybody.
   (let ((key (list bus interface property))
-       (val (list (list nil service path (cons access value)))))
+       (val
+        (list
+         (list
+          nil service path
+          (cons
+           (if emits-signal (list access :emits-signal) (list access))
+           value)))))
     (puthash key val dbus-registered-objects-table)
 
     ;; Return the object.
@@ -924,6 +939,7 @@ PATH, including a default handler for the \"Get\", \"GetAll\" and
   "Default handler for the \"org.freedesktop.DBus.Properties\" interface.
 It will be registered for all objects created by `dbus-register-object'."
   (let ((bus (dbus-event-bus-name last-input-event))
+       (service (dbus-event-service-name last-input-event))
        (path (dbus-event-path-name last-input-event))
        (method (dbus-event-member-name last-input-event))
        (interface (car args))
@@ -931,25 +947,40 @@ It will be registered for all objects created by `dbus-register-object'."
     (cond
      ;; "Get" returns a variant.
      ((string-equal method "Get")
-      (let ((val (gethash (list bus interface property)
-                         dbus-registered-objects-table)))
-       (when (string-equal path (nth 2 (car val)))
-         (list (list :variant (cdar (last (car val))))))))
+      (let ((entry (gethash (list bus interface property)
+                           dbus-registered-objects-table)))
+       (when (string-equal path (nth 2 (car entry)))
+         (list (list :variant (cdar (last (car entry))))))))
 
      ;; "Set" expects a variant.
      ((string-equal method "Set")
-      (let ((val (gethash (list bus interface property)
-                         dbus-registered-objects-table)))
-       (unless (consp (car (last (car val))))
+      (let* ((value (caar (cddr args)))
+            (entry (gethash (list bus interface property)
+                            dbus-registered-objects-table))
+            ;; The value of the hash table is a list; in case of
+            ;; properties it contains just one element (UNAME SERVICE
+            ;; PATH OBJECT).  OBJECT is a cons cell of a list, which
+            ;; contains a list of annotations (like :read,
+            ;; :read-write, :emits-signal), and the value of the
+            ;; property.
+            (object (car (last (car entry)))))
+       (unless (consp object)
          (signal 'dbus-error
                  (list "Property not registered at path" property path)))
-       (unless (equal (caar (last (car val))) :readwrite)
+       (unless (member :readwrite (car object))
          (signal 'dbus-error
                  (list "Property not writable at path" property path)))
        (puthash (list bus interface property)
-                (list (append (butlast (car val))
-                              (list (cons :readwrite (caar (cddr args))))))
+                (list (append (butlast (car entry))
+                              (list (cons (car object) value))))
                 dbus-registered-objects-table)
+       ;; Send the "PropertiesChanged" signal.
+       (when (member :emits-signal (car object))
+         (dbus-send-signal
+          bus service path dbus-interface-properties "PropertiesChanged"
+          (list (list :dict-entry property (list :variant value)))
+          '(:array)))
+       ;; Return empty reply.
        :ignore))
 
      ;; "GetAll" returns "a{sv}".