Mercurial > emacs

comparison src/dbusbind.c @ 87343:02e327d7d839

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
* dbusbind.c (QCdbus_type_byte, QCdbus_type_boolean) (QCdbus_type_int16, QCdbus_type_uint16, QCdbus_type_int32) (QCdbus_type_uint32, QCdbus_type_int64, QCdbus_type_uint64) (QCdbus_type_double, QCdbus_type_string, QCdbus_type_object_path) (QCdbus_type_signature, QCdbus_type_array, QCdbus_type_variant) (QCdbus_type_struct, QCdbus_type_dict_entry): New D-Bus type symbols. (XD_LISP_SYMBOL_TO_DBUS_TYPE): New macro. (XD_LISP_OBJECT_TO_DBUS_TYPE): Add compound types. (xd_retrieve_value): Removed. Functionality included in ... (xd_append_arg): New function. (Fdbus_call_method, Fdbus_send_signal): Apply it.
author Michael Albinus <michael.albinus@gmx.de>
date Wed, 19 Dec 2007 22:50:22 +0000
parents 710ac69daf1f
children 0b387233ea86
comparison
equal deleted inserted replaced
87342:ba60c18deeaa 87343:02e327d7d839
41 Lisp_Object Qdbus_error; 41 Lisp_Object Qdbus_error;
42 42
43 /* Lisp symbols of the system and session buses. */ 43 /* Lisp symbols of the system and session buses. */
44 Lisp_Object QCdbus_system_bus, QCdbus_session_bus; 44 Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
45 45
46 /* Lisp symbols of D-Bus types. */
47 Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
48 Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
49 Lisp_Object QCdbus_type_int32, QCdbus_type_uint32;
50 Lisp_Object QCdbus_type_int64, QCdbus_type_uint64;
51 Lisp_Object QCdbus_type_double, QCdbus_type_string;
52 Lisp_Object QCdbus_type_object_path, QCdbus_type_signature;
53 Lisp_Object QCdbus_type_array, QCdbus_type_variant;
54 Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
55
46 /* Hash table which keeps function definitions. */ 56 /* Hash table which keeps function definitions. */
47 Lisp_Object Vdbus_registered_functions_table; 57 Lisp_Object Vdbus_registered_functions_table;
48 58
49 /* Whether to debug D-Bus. */ 59 /* Whether to debug D-Bus. */
50 Lisp_Object Vdbus_debug; 60 Lisp_Object Vdbus_debug;
51 61
52 62
53 /* We use "xd_" and "XD_" as prefix for all internal symbols, because 63 /* We use "xd_" and "XD_" as prefix for all internal symbols, because
54 we don't want to poison other namespaces with "dbus_". */ 64 we don't want to poison other namespaces with "dbus_". */
55 65
56 /* Raise a Lisp error from a D-Bus error. */ 66 /* Raise a Lisp error from a D-Bus ERROR. */
57 #define XD_ERROR(error) \ 67 #define XD_ERROR(error) \
58 { \ 68 { \
59 char s[1024]; \ 69 char s[1024]; \
60 strcpy (s, error.message); \ 70 strcpy (s, error.message); \
61 dbus_error_free (&error); \ 71 dbus_error_free (&error); \
91 message ("%s: %s", __func__, s); \ 101 message ("%s: %s", __func__, s); \
92 } 102 }
93 #define XD_DEBUG_VALID_LISP_OBJECT_P(object) 103 #define XD_DEBUG_VALID_LISP_OBJECT_P(object)
94 #endif 104 #endif
95 105
96 /* Determine the DBusType of a given Lisp object. It is used to 106 /* Determine the DBusType of a given Lisp symbol. OBJECT must be one
107 of the predefined D-Bus type symbols. */
108 #define XD_LISP_SYMBOL_TO_DBUS_TYPE(object) \
109 (EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE \
110 : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN \
111 : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16 \
112 : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16 \
113 : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32 \
114 : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32 \
115 : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64 \
116 : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64 \
117 : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE \
118 : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING \
119 : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH \
120 : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE \
121 : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY \
122 : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT \
123 : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT \
124 : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY \
125 : DBUS_TYPE_INVALID
126
127 /* Determine the DBusType of a given Lisp OBJECT. It is used to
97 convert Lisp objects, being arguments of `dbus-call-method' or 128 convert Lisp objects, being arguments of `dbus-call-method' or
98 `dbus-send-signal', into corresponding C values appended as 129 `dbus-send-signal', into corresponding C values appended as
99 arguments to a D-Bus message. */ 130 arguments to a D-Bus message. */
100 #define XD_LISP_OBJECT_TO_DBUS_TYPE(object) \ 131 #define XD_LISP_OBJECT_TO_DBUS_TYPE(object) \
101 (EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN : \ 132 (EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \
102 (NATNUMP (object)) ? DBUS_TYPE_UINT32 : \ 133 : (SYMBOLP (object)) ? XD_LISP_SYMBOL_TO_DBUS_TYPE (object) \
103 (INTEGERP (object)) ? DBUS_TYPE_INT32 : \ 134 : (CONSP (object)) ? ((SYMBOLP (XCAR (object)) \
104 (FLOATP (object)) ? DBUS_TYPE_DOUBLE : \ 135 && !EQ (XCAR (object), Qt) \
105 (STRINGP (object)) ? DBUS_TYPE_STRING : \ 136 && !EQ (XCAR (object), Qnil)) \
106 DBUS_TYPE_INVALID 137 ? XD_LISP_SYMBOL_TO_DBUS_TYPE (XCAR (object)) \
107 138 : DBUS_TYPE_ARRAY) \
108 /* Extract C value from Lisp OBJECT. DTYPE must be a valid DBusType, 139 : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \
109 as detected by XD_LISP_OBJECT_TO_DBUS_TYPE. Compound types are not 140 : (INTEGERP (object)) ? DBUS_TYPE_INT32 \
110 supported (yet). It is used to convert Lisp objects, being 141 : (FLOATP (object)) ? DBUS_TYPE_DOUBLE \
111 arguments of `dbus-call-method' or `dbus-send-signal', into 142 : (STRINGP (object)) ? DBUS_TYPE_STRING \
112 corresponding C values appended as arguments to a D-Bus 143 : DBUS_TYPE_INVALID
113 message. */ 144
114 char * 145 /* Append C value, extracted from Lisp OBJECT, to iteration ITER.
115 xd_retrieve_value (dtype, object) 146 DTYPE must be a valid DBusType. It is used to convert Lisp
147 objects, being arguments of `dbus-call-method' or
148 `dbus-send-signal', into corresponding C values appended as
149 arguments to a D-Bus message. */
150 void
151 xd_append_arg (dtype, object, iter)
116 unsigned int dtype; 152 unsigned int dtype;
153 DBusMessageIter *iter;
117 Lisp_Object object; 154 Lisp_Object object;
118 { 155 {
119 156 char *value;
120 XD_DEBUG_VALID_LISP_OBJECT_P (object); 157
158 /* Check type of object. If this has been detected implicitely, it
159 is OK already, but there might be cases the type symbol and the
160 corresponding object do'nt match. */
121 switch (dtype) 161 switch (dtype)
122 { 162 {
163 case DBUS_TYPE_BYTE:
164 case DBUS_TYPE_UINT16:
165 case DBUS_TYPE_UINT32:
166 case DBUS_TYPE_UINT64:
167 CHECK_NATNUM (object);
168 break;
123 case DBUS_TYPE_BOOLEAN: 169 case DBUS_TYPE_BOOLEAN:
124 XD_DEBUG_MESSAGE ("%d %s", dtype, (NILP (object)) ? "false" : "true"); 170 if (!EQ (object, Qt) && !EQ (object, Qnil))
125 return (NILP (object)) ? (char *) FALSE : (char *) TRUE; 171 wrong_type_argument (intern ("booleanp"), object);
126 case DBUS_TYPE_UINT32: 172 break;
127 XD_DEBUG_MESSAGE ("%d %d", dtype, XUINT (object)); 173 case DBUS_TYPE_INT16:
128 return (char *) XUINT (object);
129 case DBUS_TYPE_INT32: 174 case DBUS_TYPE_INT32:
130 XD_DEBUG_MESSAGE ("%d %d", dtype, XINT (object)); 175 case DBUS_TYPE_INT64:
131 return (char *) XINT (object); 176 CHECK_NUMBER (object);
177 break;
132 case DBUS_TYPE_DOUBLE: 178 case DBUS_TYPE_DOUBLE:
133 XD_DEBUG_MESSAGE ("%d %d", dtype, XFLOAT (object)); 179 CHECK_FLOAT (object);
134 return (char *) XFLOAT (object); 180 break;
135 case DBUS_TYPE_STRING: 181 case DBUS_TYPE_STRING:
136 XD_DEBUG_MESSAGE ("%d %s", dtype, SDATA (object)); 182 case DBUS_TYPE_OBJECT_PATH:
137 return SDATA (object); 183 case DBUS_TYPE_SIGNATURE:
184 CHECK_STRING (object);
185 break;
186 case DBUS_TYPE_ARRAY:
187 CHECK_CONS (object);
188 /* ToDo: Check that all list elements have the same type. */
189 break;
190 case DBUS_TYPE_VARIANT:
191 CHECK_CONS (object);
192 /* ToDo: Check that there is exactly one element of basic type. */
193 break;
194 case DBUS_TYPE_STRUCT:
195 CHECK_CONS (object);
196 break;
197 case DBUS_TYPE_DICT_ENTRY:
198 /* ToDo: Check that there are exactly two elements, and the
199 first one is of basic type. */
200 CHECK_CONS (object);
201 break;
138 default: 202 default:
139 XD_DEBUG_MESSAGE ("DBus-Type %d not supported", dtype); 203 xsignal1 (Qdbus_error, build_string ("Unknown D-Bus type"));
140 return NULL; 204 }
205
206 if (CONSP (object))
207
208 /* Compound types. */
209 {
210 DBusMessageIter subiter;
211 char subtype;
212
213 if (SYMBOLP (XCAR (object))
214 && (strncmp (SDATA (XSYMBOL (XCAR (object))->xname), ":", 1) == 0))
215 object = XCDR (object);
216
217 /* Open new subiteration. */
218 switch (dtype)
219 {
220 case DBUS_TYPE_ARRAY:
221 case DBUS_TYPE_VARIANT:
222 subtype = (char) XD_LISP_OBJECT_TO_DBUS_TYPE (XCAR (object));
223 dbus_message_iter_open_container (iter, dtype, &subtype, &subiter);
224 break;
225 case DBUS_TYPE_STRUCT:
226 case DBUS_TYPE_DICT_ENTRY:
227 dbus_message_iter_open_container (iter, dtype, NULL, &subiter);
228 }
229
230 /* Loop over list elements. */
231 while (!NILP (object))
232 {
233 dtype = XD_LISP_OBJECT_TO_DBUS_TYPE (XCAR (object));
234 if (dtype == DBUS_TYPE_INVALID)
235 xsignal2 (Qdbus_error,
236 build_string ("Not a valid argument"), XCAR (object));
237
238 if (SYMBOLP (XCAR (object))
239 && (strncmp (SDATA (XSYMBOL (XCAR (object))->xname), ":", 1)
240 == 0))
241 object = XCDR (object);
242
243 xd_append_arg (dtype, XCAR (object), &subiter);
244
245 object = XCDR (object);
246 }
247
248 dbus_message_iter_close_container (iter, &subiter);
249 }
250
251 else
252
253 /* Basic type. */
254 {
255 switch (dtype)
256 {
257 case DBUS_TYPE_BYTE:
258 XD_DEBUG_MESSAGE ("%d %u", dtype, XUINT (object));
259 value = (unsigned char *) XUINT (object);
260 break;
261 case DBUS_TYPE_BOOLEAN:
262 XD_DEBUG_MESSAGE ("%d %s", dtype, (NILP (object)) ? "false" : "true");
263 value = (NILP (object))
264 ? (unsigned char *) FALSE : (unsigned char *) TRUE;
265 break;
266 case DBUS_TYPE_INT16:
267 XD_DEBUG_MESSAGE ("%d %d", dtype, XINT (object));
268 value = (char *) (dbus_int16_t *) XINT (object);
269 break;
270 case DBUS_TYPE_UINT16:
271 XD_DEBUG_MESSAGE ("%d %u", dtype, XUINT (object));
272 value = (char *) (dbus_uint16_t *) XUINT (object);
273 break;
274 case DBUS_TYPE_INT32:
275 XD_DEBUG_MESSAGE ("%d %d", dtype, XINT (object));
276 value = (char *) (dbus_int32_t *) XINT (object);
277 break;
278 case DBUS_TYPE_UINT32:
279 XD_DEBUG_MESSAGE ("%d %u", dtype, XUINT (object));
280 value = (char *) (dbus_uint32_t *) XUINT (object);
281 break;
282 case DBUS_TYPE_INT64:
283 XD_DEBUG_MESSAGE ("%d %d", dtype, XINT (object));
284 value = (char *) (dbus_int64_t *) XINT (object);
285 break;
286 case DBUS_TYPE_UINT64:
287 XD_DEBUG_MESSAGE ("%d %u", dtype, XUINT (object));
288 value = (char *) (dbus_int64_t *) XUINT (object);
289 break;
290 case DBUS_TYPE_DOUBLE:
291 XD_DEBUG_MESSAGE ("%d %f", dtype, XFLOAT (object));
292 value = (char *) (float *) XFLOAT (object);
293 break;
294 case DBUS_TYPE_STRING:
295 case DBUS_TYPE_OBJECT_PATH:
296 case DBUS_TYPE_SIGNATURE:
297 XD_DEBUG_MESSAGE ("%d %s", dtype, SDATA (object));
298 value = SDATA (object);
299 break;
300 }
301 if (!dbus_message_iter_append_basic (iter, dtype, &value))
302 xsignal2 (Qdbus_error,
303 build_string ("Unable to append argument"), object);
141 } 304 }
142 } 305 }
143 306
144 /* Retrieve C value from a DBusMessageIter structure ITER, and return 307 /* Retrieve C value from a DBusMessageIter structure ITER, and return
145 a converted Lisp object. The type DTYPE of the argument of the 308 a converted Lisp object. The type DTYPE of the argument of the
355 xsignal1 (Qdbus_error, build_string ("Unable to create a new message")); 518 xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
356 } 519 }
357 520
358 UNGCPRO; 521 UNGCPRO;
359 522
523 /* Initialize parameter list of message. */
524 dbus_message_iter_init_append (dmessage, &iter);
525
360 /* Append parameters to the message. */ 526 /* Append parameters to the message. */
361 for (i = 5; i < nargs; ++i) 527 for (i = 5; i < nargs; ++i)
362 { 528 {
363 529
364 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); 530 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
368 534
369 dtype = XD_LISP_OBJECT_TO_DBUS_TYPE (args[i]); 535 dtype = XD_LISP_OBJECT_TO_DBUS_TYPE (args[i]);
370 if (dtype == DBUS_TYPE_INVALID) 536 if (dtype == DBUS_TYPE_INVALID)
371 xsignal2 (Qdbus_error, build_string ("Not a valid argument"), args[i]); 537 xsignal2 (Qdbus_error, build_string ("Not a valid argument"), args[i]);
372 538
373 value = (char *) xd_retrieve_value (dtype, args[i]); 539 if (SYMBOLP (args[i])
374 540 && (strncmp (SDATA (XSYMBOL (args[i])->xname), ":", 1) == 0))
375 if (!dbus_message_append_args (dmessage, 541 ++i;
376 dtype, 542
377 &value, 543 xd_append_arg (dtype, args[i], &iter);
378 DBUS_TYPE_INVALID))
379 xsignal2 (Qdbus_error,
380 build_string ("Unable to append argument"), args[i]);
381 } 544 }
382 545
383 /* Send the message. */ 546 /* Send the message. */
384 dbus_error_init (&derror); 547 dbus_error_init (&derror);
385 reply = dbus_connection_send_with_reply_and_block (connection, 548 reply = dbus_connection_send_with_reply_and_block (connection,
458 { 621 {
459 Lisp_Object bus, service, path, interface, signal; 622 Lisp_Object bus, service, path, interface, signal;
460 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 623 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
461 DBusConnection *connection; 624 DBusConnection *connection;
462 DBusMessage *dmessage; 625 DBusMessage *dmessage;
626 DBusMessageIter iter;
463 unsigned int dtype; 627 unsigned int dtype;
464 int i; 628 int i;
465 char *value; 629 char *value;
466 630
467 /* Check parameters. */ 631 /* Check parameters. */
497 xsignal1 (Qdbus_error, build_string ("Unable to create a new message")); 661 xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
498 } 662 }
499 663
500 UNGCPRO; 664 UNGCPRO;
501 665
666 /* Initialize parameter list of message. */
667 dbus_message_iter_init_append (dmessage, &iter);
668
502 /* Append parameters to the message. */ 669 /* Append parameters to the message. */
503 for (i = 5; i < nargs; ++i) 670 for (i = 5; i < nargs; ++i)
504 { 671 {
505 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); 672 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
506 XD_DEBUG_MESSAGE ("Parameter%d %s", 673 XD_DEBUG_MESSAGE ("Parameter%d %s",
509 676
510 dtype = XD_LISP_OBJECT_TO_DBUS_TYPE (args[i]); 677 dtype = XD_LISP_OBJECT_TO_DBUS_TYPE (args[i]);
511 if (dtype == DBUS_TYPE_INVALID) 678 if (dtype == DBUS_TYPE_INVALID)
512 xsignal2 (Qdbus_error, build_string ("Not a valid argument"), args[i]); 679 xsignal2 (Qdbus_error, build_string ("Not a valid argument"), args[i]);
513 680
514 value = (char *) xd_retrieve_value (dtype, args[i]); 681 if (SYMBOLP (args[i])
515 682 && (strncmp (SDATA (XSYMBOL (args[i])->xname), ":", 1) == 0))
516 if (!dbus_message_append_args (dmessage, 683 ++i;
517 dtype, 684
518 &value, 685 xd_append_arg (dtype, args[i], &iter);
519 DBUS_TYPE_INVALID))
520 xsignal2 (Qdbus_error,
521 build_string ("Unable to append argument"), args[i]);
522 } 686 }
523 687
524 /* Send the message. The message is just added to the outgoing 688 /* Send the message. The message is just added to the outgoing
525 message queue. */ 689 message queue. */
526 if (!dbus_connection_send (connection, dmessage, NULL)) 690 if (!dbus_connection_send (connection, dmessage, NULL))
848 staticpro (&QCdbus_system_bus); 1012 staticpro (&QCdbus_system_bus);
849 1013
850 QCdbus_session_bus = intern (":session"); 1014 QCdbus_session_bus = intern (":session");
851 staticpro (&QCdbus_session_bus); 1015 staticpro (&QCdbus_session_bus);
852 1016
1017 QCdbus_type_byte = intern (":byte");
1018 staticpro (&QCdbus_type_byte);
1019
1020 QCdbus_type_boolean = intern (":boolean");
1021 staticpro (&QCdbus_type_boolean);
1022
1023 QCdbus_type_int16 = intern (":int16");
1024 staticpro (&QCdbus_type_int16);
1025
1026 QCdbus_type_uint16 = intern (":uint16");
1027 staticpro (&QCdbus_type_uint16);
1028
1029 QCdbus_type_int32 = intern (":int32");
1030 staticpro (&QCdbus_type_int32);
1031
1032 QCdbus_type_uint32 = intern (":uint32");
1033 staticpro (&QCdbus_type_uint32);
1034
1035 QCdbus_type_int64 = intern (":int64");
1036 staticpro (&QCdbus_type_int64);
1037
1038 QCdbus_type_uint64 = intern (":uint64");
1039 staticpro (&QCdbus_type_uint64);
1040
1041 QCdbus_type_double = intern (":double");
1042 staticpro (&QCdbus_type_double);
1043
1044 QCdbus_type_string = intern (":string");
1045 staticpro (&QCdbus_type_string);
1046
1047 QCdbus_type_object_path = intern (":object-path");
1048 staticpro (&QCdbus_type_object_path);
1049
1050 QCdbus_type_signature = intern (":signature");
1051 staticpro (&QCdbus_type_signature);
1052
1053 QCdbus_type_array = intern (":array");
1054 staticpro (&QCdbus_type_array);
1055
1056 QCdbus_type_variant = intern (":variant");
1057 staticpro (&QCdbus_type_variant);
1058
1059 QCdbus_type_struct = intern (":struct");
1060 staticpro (&QCdbus_type_struct);
1061
1062 QCdbus_type_dict_entry = intern (":dict-entry");
1063 staticpro (&QCdbus_type_dict_entry);
1064
853 DEFVAR_LISP ("dbus-registered-functions-table", &Vdbus_registered_functions_table, 1065 DEFVAR_LISP ("dbus-registered-functions-table", &Vdbus_registered_functions_table,
854 doc: /* Hash table of registered functions for D-Bus. 1066 doc: /* Hash table of registered functions for D-Bus.
855 The key in the hash table is the list (BUS INTERFACE MEMBER). BUS is 1067 The key in the hash table is the list (BUS INTERFACE MEMBER). BUS is
856 either the symbol `:system' or the symbol `:session'. INTERFACE is a 1068 either the symbol `:system' or the symbol `:session'. INTERFACE is a
857 string which denotes a D-Bus interface, and MEMBER, also a string, is 1069 string which denotes a D-Bus interface, and MEMBER, also a string, is