Commit b1ce08da authored by Michael Albinus's avatar Michael Albinus

* 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.
parent 971de7fb
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.
......
......@@ -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}".
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment