Mercurial > emacs

comparison lisp/net/dbus.el @ 109127:6b757d9cacac

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
* 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.
author Michael Albinus <albinus@detlef>
date Sun, 04 Jul 2010 11:52:57 +0200
parents 319b48a599cf
children 0f3ed79830e9
comparison
equal deleted inserted replaced
109126:aec1143e8d85 109127:6b757d9cacac
867 "GetAll" :timeout 500 interface) 867 "GetAll" :timeout 500 interface)
868 result) 868 result)
869 (add-to-list 'result (cons (car dict) (caadr dict)) 'append))))) 869 (add-to-list 'result (cons (car dict) (caadr dict)) 'append)))))
870 870
871 (defun dbus-register-property 871 (defun dbus-register-property
872 (bus service path interface property access value) 872 (bus service path interface property access value &optional emits-signal)
873 "Register property PROPERTY on the D-Bus BUS. 873 "Register property PROPERTY on the D-Bus BUS.
874 874
875 BUS is either the symbol `:system' or the symbol `:session'. 875 BUS is either the symbol `:system' or the symbol `:session'.
876 876
877 SERVICE is the D-Bus service name of the D-Bus. It must be a 877 SERVICE is the D-Bus service name of the D-Bus. It must be a
890 change their values. Properties with access type `:readwrite' 890 change their values. Properties with access type `:readwrite'
891 can be changed by `dbus-set-property'. 891 can be changed by `dbus-set-property'.
892 892
893 The interface \"org.freedesktop.DBus.Properties\" is added to 893 The interface \"org.freedesktop.DBus.Properties\" is added to
894 PATH, including a default handler for the \"Get\", \"GetAll\" and 894 PATH, including a default handler for the \"Get\", \"GetAll\" and
895 \"Set\" methods of this interface." 895 \"Set\" methods of this interface. When EMITS-SIGNAL is non-nil,
896 the signal \"PropertiesChanged\" is sent when the property is
897 changed by `dbus-set-property'."
896 (unless (member access '(:read :readwrite)) 898 (unless (member access '(:read :readwrite))
897 (signal 'dbus-error (list "Access type invalid" access))) 899 (signal 'dbus-error (list "Access type invalid" access)))
898 900
899 ;; Register SERVICE. 901 ;; Register SERVICE.
900 (unless (member service (dbus-list-names bus)) 902 (unless (member service (dbus-list-names bus))
909 (dbus-register-method 911 (dbus-register-method
910 bus service path dbus-interface-properties "GetAll" 'dbus-property-handler) 912 bus service path dbus-interface-properties "GetAll" 'dbus-property-handler)
911 (dbus-register-method 913 (dbus-register-method
912 bus service path dbus-interface-properties "Set" 'dbus-property-handler) 914 bus service path dbus-interface-properties "Set" 'dbus-property-handler)
913 915
916 ;; Send the PropertiesChanged signal.
917 (when emits-signal
918 (dbus-send-signal
919 bus service path dbus-interface-properties "PropertiesChanged"
920 (list (list :dict-entry property (list :variant value)))
921 '(:array)))
922
914 ;; Create a hash table entry. We use nil for the unique name, 923 ;; Create a hash table entry. We use nil for the unique name,
915 ;; because the property might be accessed from anybody. 924 ;; because the property might be accessed from anybody.
916 (let ((key (list bus interface property)) 925 (let ((key (list bus interface property))
917 (val (list (list nil service path (cons access value))))) 926 (val
927 (list
928 (list
929 nil service path
930 (cons
931 (if emits-signal (list access :emits-signal) (list access))
932 value)))))
918 (puthash key val dbus-registered-objects-table) 933 (puthash key val dbus-registered-objects-table)
919 934
920 ;; Return the object. 935 ;; Return the object.
921 (list key (list service path)))) 936 (list key (list service path))))
922 937
923 (defun dbus-property-handler (&rest args) 938 (defun dbus-property-handler (&rest args)
924 "Default handler for the \"org.freedesktop.DBus.Properties\" interface. 939 "Default handler for the \"org.freedesktop.DBus.Properties\" interface.
925 It will be registered for all objects created by `dbus-register-object'." 940 It will be registered for all objects created by `dbus-register-object'."
926 (let ((bus (dbus-event-bus-name last-input-event)) 941 (let ((bus (dbus-event-bus-name last-input-event))
942 (service (dbus-event-service-name last-input-event))
927 (path (dbus-event-path-name last-input-event)) 943 (path (dbus-event-path-name last-input-event))
928 (method (dbus-event-member-name last-input-event)) 944 (method (dbus-event-member-name last-input-event))
929 (interface (car args)) 945 (interface (car args))
930 (property (cadr args))) 946 (property (cadr args)))
931 (cond 947 (cond
932 ;; "Get" returns a variant. 948 ;; "Get" returns a variant.
933 ((string-equal method "Get") 949 ((string-equal method "Get")
934 (let ((val (gethash (list bus interface property) 950 (let ((entry (gethash (list bus interface property)
935 dbus-registered-objects-table))) 951 dbus-registered-objects-table)))
936 (when (string-equal path (nth 2 (car val))) 952 (when (string-equal path (nth 2 (car entry)))
937 (list (list :variant (cdar (last (car val)))))))) 953 (list (list :variant (cdar (last (car entry))))))))
938 954
939 ;; "Set" expects a variant. 955 ;; "Set" expects a variant.
940 ((string-equal method "Set") 956 ((string-equal method "Set")
941 (let ((val (gethash (list bus interface property) 957 (let* ((value (caar (cddr args)))
942 dbus-registered-objects-table))) 958 (entry (gethash (list bus interface property)
943 (unless (consp (car (last (car val)))) 959 dbus-registered-objects-table))
960 ;; The value of the hash table is a list; in case of
961 ;; properties it contains just one element (UNAME SERVICE
962 ;; PATH OBJECT). OBJECT is a cons cell of a list, which
963 ;; contains a list of annotations (like :read,
964 ;; :read-write, :emits-signal), and the value of the
965 ;; property.
966 (object (car (last (car entry)))))
967 (unless (consp object)
944 (signal 'dbus-error 968 (signal 'dbus-error
945 (list "Property not registered at path" property path))) 969 (list "Property not registered at path" property path)))
946 (unless (equal (caar (last (car val))) :readwrite) 970 (unless (member :readwrite (car object))
947 (signal 'dbus-error 971 (signal 'dbus-error
948 (list "Property not writable at path" property path))) 972 (list "Property not writable at path" property path)))
949 (puthash (list bus interface property) 973 (puthash (list bus interface property)
950 (list (append (butlast (car val)) 974 (list (append (butlast (car entry))
951 (list (cons :readwrite (caar (cddr args)))))) 975 (list (cons (car object) value))))
952 dbus-registered-objects-table) 976 dbus-registered-objects-table)
977 ;; Send the "PropertiesChanged" signal.
978 (when (member :emits-signal (car object))
979 (dbus-send-signal
980 bus service path dbus-interface-properties "PropertiesChanged"
981 (list (list :dict-entry property (list :variant value)))
982 '(:array)))
983 ;; Return empty reply.
953 :ignore)) 984 :ignore))
954 985
955 ;; "GetAll" returns "a{sv}". 986 ;; "GetAll" returns "a{sv}".
956 ((string-equal method "GetAll") 987 ((string-equal method "GetAll")
957 (let (result) 988 (let (result)