comparison lisp/net/dbus.el @ 87050:7d80e0f3d8f8

* net/dbus.el (dbus-hash-table=): New defun. (dbus-hash-table-test) New hash table test function, used in `dbus-registered-functions-table'. (dbus-*-event, dbus-event-*): Rewritten, due to new structure of `dbus-event'.
author Michael Albinus <michael.albinus@gmx.de>
date Tue, 04 Dec 2007 21:21:09 +0000
parents cbc23e728425
children f767f1ba8301
comparison
equal deleted inserted replaced
87049:cbcfa9b4201e 87050:7d80e0f3d8f8
44 "The interface exported by the object with `dbus-service-dbus' and `dbus-path-dbus'.") 44 "The interface exported by the object with `dbus-service-dbus' and `dbus-path-dbus'.")
45 45
46 (defconst dbus-interface-introspectable "org.freedesktop.DBus.Introspectable" 46 (defconst dbus-interface-introspectable "org.freedesktop.DBus.Introspectable"
47 "The interface supported by introspectable objects.") 47 "The interface supported by introspectable objects.")
48 48
49
50 ;;; Hash table of registered functions.
51
52 (defun dbus-hash-table= (x y)
53 "Compares keys X and Y in the hash table of registered functions for D-Bus.
54 See `dbus-registered-functions-table' for a description of the hash table."
55 (and
56 (listp x) (listp y)
57 ;; Bus symbol, either :system or :session.
58 (symbolp (car x)) (symbolp (car y)) (equal (car x) (car y))
59 ;; Interface.
60 (stringp (cadr x)) (stringp (cadr y)) (string-equal (cadr x) (cadr y))
61 ;; Member.
62 (stringp (caddr x)) (stringp (caddr y)) (string-equal (caddr x) (caddr y))))
63
64 (define-hash-table-test 'dbus-hash-table-test
65 'dbus-hash-table= 'sxhash)
66
67 (setq dbus-registered-functions-table
68 (make-hash-table :test 'dbus-hash-table-test))
69
70
71 ;;; D-Bus events.
72
49 (defun dbus-check-event (event) 73 (defun dbus-check-event (event)
50 "Checks whether EVENT is a well formed D-Bus event. 74 "Checks whether EVENT is a well formed D-Bus event.
51 EVENT is a list which starts with symbol `dbus-event': 75 EVENT is a list which starts with symbol `dbus-event':
52 76
53 (dbus-event SYMBOL SERVICE PATH &rest ARGS) 77 (dbus-event HANDLER BUS SERVICE PATH INTERFACE MEMBER &rest ARGS)
54 78
55 SYMBOL is the interned Lisp symbol which has been generated 79 HANDLER is the function which has been registered for this
56 during signal registration. SERVICE and PATH are the unique name 80 signal. BUS identifies the D-Bus the signal is coming from. It
57 and the object path of the D-Bus object emitting the signal. 81 is either the symbol `:system' or the symbol `:session'. SERVICE
58 ARGS are the arguments passed to the corresponding handler. 82 and PATH are the name and the object path of the D-Bus object
83 emitting the signal. INTERFACE and MEMBER denote the signal
84 which has been sent. ARGS are the arguments passed to HANDLER,
85 when it is called during event handling in `dbus-handle-event'.
59 86
60 This function raises a `dbus-error' signal in case the event is 87 This function raises a `dbus-error' signal in case the event is
61 not well formed." 88 not well formed."
62 (when dbus-debug (message "DBus-Event %s" event)) 89 (when dbus-debug (message "DBus-Event %s" event))
63 (unless (and (listp event) 90 (unless (and (listp event)
64 (eq (car event) 'dbus-event) 91 (eq (car event) 'dbus-event)
65 (symbolp (cadr event)) 92 ;; Handler.
66 (stringp (car (cddr event))) 93 (functionp (nth 1 event))
67 (stringp (cadr (cddr event)))) 94 ;; Bus symbol.
95 (symbolp (nth 2 event))
96 ;; Service.
97 (stringp (nth 3 event))
98 ;; Object path.
99 (stringp (nth 4 event))
100 ;; Interface.
101 (stringp (nth 5 event))
102 ;; Member.
103 (stringp (nth 6 event)))
68 (signal 'dbus-error (list "Not a valid D-Bus event" event)))) 104 (signal 'dbus-error (list "Not a valid D-Bus event" event))))
69 105
70 ;;;###autoload 106 ;;;###autoload
71 (defun dbus-handle-event (event) 107 (defun dbus-handle-event (event)
72 "Handle events from the D-Bus. 108 "Handle events from the D-Bus.
73 EVENT is a D-Bus event, see `dbus-check-event'. This function 109 EVENT is a D-Bus event, see `dbus-check-event'. HANDLER, being
74 raises a `dbus-error' signal in case the event is not well 110 part of the event, is called with arguments ARGS."
75 formed."
76 (interactive "e") 111 (interactive "e")
77 (dbus-check-event event) 112 ;; We don't want to raise an error, because this function is called
78 (when (functionp (cadr event)) (apply (cadr event) (cddr (cddr event))))) 113 ;; in the event handling loop.
114 (condition-case nil
115 (progn
116 (dbus-check-event event)
117 (apply (cadr event) (nthcdr 7 event)))
118 (dbus-error)))
79 119
80 (defun dbus-event-bus-name (event) 120 (defun dbus-event-bus-name (event)
81 "Return the bus name the event is coming from. 121 "Return the bus name the event is coming from.
82 The result is either the symbol `:system' or the symbol `:session'. 122 The result is either the symbol `:system' or the symbol `:session'.
83 EVENT is a D-Bus event, see `dbus-check-event'. This function 123 EVENT is a D-Bus event, see `dbus-check-event'. This function
84 raises a `dbus-error' signal in case the event is not well 124 raises a `dbus-error' signal in case the event is not well
85 formed." 125 formed."
86 (dbus-check-event event) 126 (dbus-check-event event)
87 (save-match-data 127 (nth 2 event))
88 (intern (car (split-string (symbol-name (cadr event)) "\\.")))))
89 128
90 (defun dbus-event-service-name (event) 129 (defun dbus-event-service-name (event)
91 "Return the unique name of the D-Bus object the event is coming from. 130 "Return the name of the D-Bus object the event is coming from.
92 The result is a string. EVENT is a D-Bus event, see `dbus-check-event'. 131 The result is a string. EVENT is a D-Bus event, see `dbus-check-event'.
93 This function raises a `dbus-error' signal in case the event is 132 This function raises a `dbus-error' signal in case the event is
94 not well formed." 133 not well formed."
95 (dbus-check-event event) 134 (dbus-check-event event)
96 (car (cddr event))) 135 (nth 3 event))
97 136
98 (defun dbus-event-path-name (event) 137 (defun dbus-event-path-name (event)
99 "Return the object path of the D-Bus object the event is coming from. 138 "Return the object path of the D-Bus object the event is coming from.
100 The result is a string. EVENT is a D-Bus event, see `dbus-check-event'. 139 The result is a string. EVENT is a D-Bus event, see `dbus-check-event'.
101 This function raises a `dbus-error' signal in case the event is 140 This function raises a `dbus-error' signal in case the event is
102 not well formed." 141 not well formed."
103 (dbus-check-event event) 142 (dbus-check-event event)
104 (cadr (cddr event))) 143 (nth 4 event))
105 144
106 (defun dbus-event-interface-name (event) 145 (defun dbus-event-interface-name (event)
107 "Return the interface name of the D-Bus object the event is coming from. 146 "Return the interface name of the D-Bus object the event is coming from.
108 The result is a string. EVENT is a D-Bus event, see `dbus-check-event'. 147 The result is a string. EVENT is a D-Bus event, see `dbus-check-event'.
109 This function raises a `dbus-error' signal in case the event is 148 This function raises a `dbus-error' signal in case the event is
110 not well formed." 149 not well formed."
111 (dbus-check-event event) 150 (dbus-check-event event)
112 (save-match-data 151 (nth 5 event))
113 (string-match "^[^.]+\\.\\(.+\\)\\.[^.]+$" (symbol-name (cadr event)))
114 (match-string 1 (symbol-name (cadr event)))))
115 152
116 (defun dbus-event-member-name (event) 153 (defun dbus-event-member-name (event)
117 "Return the member name the event is coming from. 154 "Return the member name the event is coming from.
118 It is either a signal name or a method name. The result is is a 155 It is either a signal name or a method name. The result is is a
119 string. EVENT is a D-Bus event, see `dbus-check-event'. This 156 string. EVENT is a D-Bus event, see `dbus-check-event'. This
120 function raises a `dbus-error' signal in case the event is not 157 function raises a `dbus-error' signal in case the event is not
121 well formed." 158 well formed."
122 (dbus-check-event event) 159 (dbus-check-event event)
123 (save-match-data 160 (nth 6 event))
124 (car (nreverse (split-string (symbol-name (cadr event)) "\\."))))) 161
162
163 ;;; D-Bus registered names.
125 164
126 (defun dbus-list-activatable-names () 165 (defun dbus-list-activatable-names ()
127 "Return the D-Bus service names which can be activated as list. 166 "Return the D-Bus service names which can be activated as list.
128 The result is a list of strings, which is nil when there are no 167 The result is a list of strings, which is nil when there are no
129 activatable service names at all." 168 activatable service names at all."