Mercurial > emacs

comparison src/dbusbind.c @ 87361:0b387233ea86

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
* dbusbind.c (XD_BASIC_DBUS_TYPE, XD_DBUS_TYPE_P, XD_NEXT_VALUE): New macros. (XD_SYMBOL_TO_DBUS_TYPE): Renamed from XD_LISP_SYMBOL_TO_DBUS_TYPE. (XD_OBJECT_TO_DBUS_TYPE): Renamed from XD_LISP_OBJECT_TO_DBUS_TYPE. Simplify. (xd_signature): New function. (xd_append_arg): Compute also signatures. Major rewrite. (xd_retrieve_arg): Make debug messages friendly. (Fdbus_call_method, Fdbus_send_signal): Extend docstring. Check for signatures of arguments.
author Michael Albinus <michael.albinus@gmx.de>
date Fri, 21 Dec 2007 22:01:43 +0000
parents 02e327d7d839
children 28bc3dd3635f
comparison
equal deleted inserted replaced
87360:c7024d3b9ea3 87361:0b387233ea86
101 message ("%s: %s", __func__, s); \ 101 message ("%s: %s", __func__, s); \
102 } 102 }
103 #define XD_DEBUG_VALID_LISP_OBJECT_P(object) 103 #define XD_DEBUG_VALID_LISP_OBJECT_P(object)
104 #endif 104 #endif
105 105
106 /* Check whether TYPE is a basic DBusType. */
107 #define XD_BASIC_DBUS_TYPE(type) \
108 ((type == DBUS_TYPE_BYTE) \
109 || (type == DBUS_TYPE_BOOLEAN) \
110 || (type == DBUS_TYPE_INT16) \
111 || (type == DBUS_TYPE_UINT16) \
112 || (type == DBUS_TYPE_INT32) \
113 || (type == DBUS_TYPE_UINT32) \
114 || (type == DBUS_TYPE_INT64) \
115 || (type == DBUS_TYPE_UINT64) \
116 || (type == DBUS_TYPE_DOUBLE) \
117 || (type == DBUS_TYPE_STRING) \
118 || (type == DBUS_TYPE_OBJECT_PATH) \
119 || (type == DBUS_TYPE_SIGNATURE))
120
106 /* Determine the DBusType of a given Lisp symbol. OBJECT must be one 121 /* Determine the DBusType of a given Lisp symbol. OBJECT must be one
107 of the predefined D-Bus type symbols. */ 122 of the predefined D-Bus type symbols. */
108 #define XD_LISP_SYMBOL_TO_DBUS_TYPE(object) \ 123 #define XD_SYMBOL_TO_DBUS_TYPE(object) \
109 (EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE \ 124 ((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE \
110 : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN \ 125 : (EQ (object, QCdbus_type_boolean)) ? DBUS_TYPE_BOOLEAN \
111 : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16 \ 126 : (EQ (object, QCdbus_type_int16)) ? DBUS_TYPE_INT16 \
112 : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16 \ 127 : (EQ (object, QCdbus_type_uint16)) ? DBUS_TYPE_UINT16 \
113 : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32 \ 128 : (EQ (object, QCdbus_type_int32)) ? DBUS_TYPE_INT32 \
114 : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32 \ 129 : (EQ (object, QCdbus_type_uint32)) ? DBUS_TYPE_UINT32 \
115 : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64 \ 130 : (EQ (object, QCdbus_type_int64)) ? DBUS_TYPE_INT64 \
116 : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64 \ 131 : (EQ (object, QCdbus_type_uint64)) ? DBUS_TYPE_UINT64 \
117 : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE \ 132 : (EQ (object, QCdbus_type_double)) ? DBUS_TYPE_DOUBLE \
118 : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING \ 133 : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING \
119 : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH \ 134 : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH \
120 : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE \ 135 : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE \
121 : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY \ 136 : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY \
122 : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT \ 137 : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT \
123 : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT \ 138 : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT \
124 : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY \ 139 : (EQ (object, QCdbus_type_dict_entry)) ? DBUS_TYPE_DICT_ENTRY \
125 : DBUS_TYPE_INVALID 140 : DBUS_TYPE_INVALID)
141
142 /* Check whether a Lisp symbol is a predefined D-Bus type symbol. */
143 #define XD_DBUS_TYPE_P(object) \
144 (SYMBOLP (object) && ((XD_SYMBOL_TO_DBUS_TYPE (object) != DBUS_TYPE_INVALID)))
126 145
127 /* Determine the DBusType of a given Lisp OBJECT. It is used to 146 /* Determine the DBusType of a given Lisp OBJECT. It is used to
128 convert Lisp objects, being arguments of `dbus-call-method' or 147 convert Lisp objects, being arguments of `dbus-call-method' or
129 `dbus-send-signal', into corresponding C values appended as 148 `dbus-send-signal', into corresponding C values appended as
130 arguments to a D-Bus message. */ 149 arguments to a D-Bus message. */
131 #define XD_LISP_OBJECT_TO_DBUS_TYPE(object) \ 150 #define XD_OBJECT_TO_DBUS_TYPE(object) \
132 (EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \ 151 ((EQ (object, Qt) || EQ (object, Qnil)) ? DBUS_TYPE_BOOLEAN \
133 : (SYMBOLP (object)) ? XD_LISP_SYMBOL_TO_DBUS_TYPE (object) \ 152 : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \
134 : (CONSP (object)) ? ((SYMBOLP (XCAR (object)) \ 153 : (INTEGERP (object)) ? DBUS_TYPE_INT32 \
135 && !EQ (XCAR (object), Qt) \ 154 : (FLOATP (object)) ? DBUS_TYPE_DOUBLE \
136 && !EQ (XCAR (object), Qnil)) \ 155 : (STRINGP (object)) ? DBUS_TYPE_STRING \
137 ? XD_LISP_SYMBOL_TO_DBUS_TYPE (XCAR (object)) \ 156 : (XD_DBUS_TYPE_P (object)) ? XD_SYMBOL_TO_DBUS_TYPE (object) \
138 : DBUS_TYPE_ARRAY) \ 157 : (CONSP (object)) ? ((XD_DBUS_TYPE_P (XCAR (object))) \
139 : (NATNUMP (object)) ? DBUS_TYPE_UINT32 \ 158 ? XD_SYMBOL_TO_DBUS_TYPE (XCAR (object)) \
140 : (INTEGERP (object)) ? DBUS_TYPE_INT32 \ 159 : DBUS_TYPE_ARRAY) \
141 : (FLOATP (object)) ? DBUS_TYPE_DOUBLE \ 160 : DBUS_TYPE_INVALID)
142 : (STRINGP (object)) ? DBUS_TYPE_STRING \ 161
143 : DBUS_TYPE_INVALID 162 /* Return a list pointer which does not have a Lisp symbol as car. */
163 #define XD_NEXT_VALUE(object) \
164 ((XD_DBUS_TYPE_P (XCAR (object))) ? XCDR (object) : object)
165
166 /* Compute SIGNATURE of OBJECT. It must have a form that it can be
167 used in dbus_message_iter_open_container. DTYPE is the DBusType
168 the object is related to. It is passed as argument, because it
169 cannot be detected in basic type objects, when they are preceded by
170 a type symbol. PARENT_TYPE is the DBusType of a container this
171 signature is embedded, or DBUS_TYPE_INVALID. It is needed for the
172 check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */
173 void
174 xd_signature(signature, dtype, parent_type, object)
175 char *signature;
176 unsigned int dtype, parent_type;
177 Lisp_Object object;
178 {
179 unsigned int subtype;
180 Lisp_Object elt;
181 char x[DBUS_MAXIMUM_SIGNATURE_LENGTH];
182
183 elt = object;
184
185 switch (dtype)
186 {
187 case DBUS_TYPE_BYTE:
188 case DBUS_TYPE_UINT16:
189 case DBUS_TYPE_UINT32:
190 case DBUS_TYPE_UINT64:
191 CHECK_NATNUM (object);
192 sprintf (signature, "%c", dtype);
193 break;
194
195 case DBUS_TYPE_BOOLEAN:
196 if (!EQ (object, Qt) && !EQ (object, Qnil))
197 wrong_type_argument (intern ("booleanp"), object);
198 sprintf (signature, "%c", dtype);
199 break;
200
201 case DBUS_TYPE_INT16:
202 case DBUS_TYPE_INT32:
203 case DBUS_TYPE_INT64:
204 CHECK_NUMBER (object);
205 sprintf (signature, "%c", dtype);
206 break;
207
208 case DBUS_TYPE_DOUBLE:
209 CHECK_FLOAT (object);
210 sprintf (signature, "%c", dtype);
211 break;
212
213 case DBUS_TYPE_STRING:
214 case DBUS_TYPE_OBJECT_PATH:
215 case DBUS_TYPE_SIGNATURE:
216 CHECK_STRING (object);
217 sprintf (signature, "%c", dtype);
218 break;
219
220 case DBUS_TYPE_ARRAY:
221 /* Check that all elements have the same D-Bus type. For
222 complex element types, we just check the container type, not
223 the whole element's signature. */
224 CHECK_CONS (object);
225
226 if (EQ (QCdbus_type_array, XCAR (elt))) /* Type symbol is optional. */
227 elt = XD_NEXT_VALUE (elt);
228 subtype = XD_OBJECT_TO_DBUS_TYPE (XCAR (elt));
229 xd_signature (x, subtype, dtype, XCAR (XD_NEXT_VALUE (elt)));
230
231 while (!NILP (elt))
232 {
233 if (subtype != XD_OBJECT_TO_DBUS_TYPE (XCAR (elt)))
234 wrong_type_argument (intern ("D-Bus"), XCAR (elt));
235 elt = XCDR (XD_NEXT_VALUE (elt));
236 }
237
238 sprintf (signature, "%c%s", dtype, x);
239 break;
240
241 case DBUS_TYPE_VARIANT:
242 /* Check that there is exactly one element. */
243 CHECK_CONS (object);
244
245 elt = XD_NEXT_VALUE (elt);
246 subtype = XD_OBJECT_TO_DBUS_TYPE (XCAR (elt));
247 xd_signature (x, subtype, dtype, XCAR (XD_NEXT_VALUE (elt)));
248
249 if (!NILP (XCDR (XD_NEXT_VALUE (elt))))
250 wrong_type_argument (intern ("D-Bus"),
251 XCAR (XCDR (XD_NEXT_VALUE (elt))));
252
253 sprintf (signature, "%c%s", dtype, x);
254 break;
255
256 case DBUS_TYPE_STRUCT:
257 /* A struct might contain any number of objects with different
258 types. No further check needed. */
259 CHECK_CONS (object);
260
261 elt = XD_NEXT_VALUE (elt);
262
263 /* Compose the signature from the elements. It is enclosed by
264 parentheses. */
265 sprintf (signature, "%c", DBUS_STRUCT_BEGIN_CHAR );
266 while (!NILP (elt))
267 {
268 subtype = XD_OBJECT_TO_DBUS_TYPE (XCAR (elt));
269 xd_signature (x, subtype, dtype, XCAR (XD_NEXT_VALUE (elt)));
270 strcat (signature, x);
271 elt = XCDR (XD_NEXT_VALUE (elt));
272 }
273 sprintf (signature, "%s%c", signature, DBUS_STRUCT_END_CHAR);
274 break;
275
276 case DBUS_TYPE_DICT_ENTRY:
277 /* Check that there are exactly two elements, and the first one
278 is of basic type. It must also be an element of an
279 array. */
280 CHECK_CONS (object);
281
282 if (parent_type != DBUS_TYPE_ARRAY)
283 wrong_type_argument (intern ("D-Bus"), object);
284
285 /* Compose the signature from the elements. It is enclosed by
286 curly braces. */
287 sprintf (signature, "%c", DBUS_DICT_ENTRY_BEGIN_CHAR);
288
289 /* First element. */
290 elt = XD_NEXT_VALUE (elt);
291 subtype = XD_OBJECT_TO_DBUS_TYPE (XCAR (elt));
292 xd_signature (x, subtype, dtype, XCAR (XD_NEXT_VALUE (elt)));
293 strcat (signature, x);
294
295 if (!XD_BASIC_DBUS_TYPE (subtype))
296 wrong_type_argument (intern ("D-Bus"), XCAR (XD_NEXT_VALUE (elt)));
297
298 /* Second element. */
299 elt = XCDR (XD_NEXT_VALUE (elt));
300 subtype = XD_OBJECT_TO_DBUS_TYPE (XCAR (elt));
301 xd_signature (x, subtype, dtype, XCAR (XD_NEXT_VALUE (elt)));
302 strcat (signature, x);
303
304 if (!NILP (XCDR (XD_NEXT_VALUE (elt))))
305 wrong_type_argument (intern ("D-Bus"),
306 XCAR (XCDR (XD_NEXT_VALUE (elt))));
307
308 /* Closing signature. */
309 sprintf (signature, "%s%c", signature, DBUS_DICT_ENTRY_END_CHAR);
310 break;
311
312 default:
313 wrong_type_argument (intern ("D-Bus"), object);
314 }
315
316 XD_DEBUG_MESSAGE ("%s", signature);
317 }
144 318
145 /* Append C value, extracted from Lisp OBJECT, to iteration ITER. 319 /* Append C value, extracted from Lisp OBJECT, to iteration ITER.
146 DTYPE must be a valid DBusType. It is used to convert Lisp 320 DTYPE must be a valid DBusType. It is used to convert Lisp
147 objects, being arguments of `dbus-call-method' or 321 objects, being arguments of `dbus-call-method' or
148 `dbus-send-signal', into corresponding C values appended as 322 `dbus-send-signal', into corresponding C values appended as
149 arguments to a D-Bus message. */ 323 arguments to a D-Bus message. */
150 void 324 void
151 xd_append_arg (dtype, object, iter) 325 xd_append_arg (dtype, object, iter)
152 unsigned int dtype; 326 unsigned int dtype;
327 Lisp_Object object;
153 DBusMessageIter *iter; 328 DBusMessageIter *iter;
154 Lisp_Object object;
155 { 329 {
330 Lisp_Object elt;
331 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
332 DBusMessageIter subiter;
156 char *value; 333 char *value;
157 334
158 /* Check type of object. If this has been detected implicitely, it 335 XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (format2 ("%s", object, Qnil)));
159 is OK already, but there might be cases the type symbol and the 336
160 corresponding object do'nt match. */ 337 if (XD_BASIC_DBUS_TYPE (dtype))
161 switch (dtype) 338 {
162 { 339 switch (dtype)
163 case DBUS_TYPE_BYTE: 340 {
164 case DBUS_TYPE_UINT16: 341 case DBUS_TYPE_BYTE:
165 case DBUS_TYPE_UINT32: 342 XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object));
166 case DBUS_TYPE_UINT64: 343 value = (unsigned char *) XUINT (object);
167 CHECK_NATNUM (object); 344 break;
168 break; 345
169 case DBUS_TYPE_BOOLEAN: 346 case DBUS_TYPE_BOOLEAN:
170 if (!EQ (object, Qt) && !EQ (object, Qnil)) 347 XD_DEBUG_MESSAGE ("%c %s", dtype, (NILP (object)) ? "false" : "true");
171 wrong_type_argument (intern ("booleanp"), object); 348 value = (NILP (object))
172 break; 349 ? (unsigned char *) FALSE : (unsigned char *) TRUE;
173 case DBUS_TYPE_INT16: 350 break;
174 case DBUS_TYPE_INT32: 351
175 case DBUS_TYPE_INT64: 352 case DBUS_TYPE_INT16:
176 CHECK_NUMBER (object); 353 XD_DEBUG_MESSAGE ("%c %d", dtype, XINT (object));
177 break; 354 value = (char *) (dbus_int16_t *) XINT (object);
178 case DBUS_TYPE_DOUBLE: 355 break;
179 CHECK_FLOAT (object); 356
180 break; 357 case DBUS_TYPE_UINT16:
181 case DBUS_TYPE_STRING: 358 XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object));
182 case DBUS_TYPE_OBJECT_PATH: 359 value = (char *) (dbus_uint16_t *) XUINT (object);
183 case DBUS_TYPE_SIGNATURE: 360 break;
184 CHECK_STRING (object); 361
185 break; 362 case DBUS_TYPE_INT32:
186 case DBUS_TYPE_ARRAY: 363 XD_DEBUG_MESSAGE ("%c %d", dtype, XINT (object));
187 CHECK_CONS (object); 364 value = (char *) (dbus_int32_t *) XINT (object);
188 /* ToDo: Check that all list elements have the same type. */ 365 break;
189 break; 366
190 case DBUS_TYPE_VARIANT: 367 case DBUS_TYPE_UINT32:
191 CHECK_CONS (object); 368 XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object));
192 /* ToDo: Check that there is exactly one element of basic type. */ 369 value = (char *) (dbus_uint32_t *) XUINT (object);
193 break; 370 break;
194 case DBUS_TYPE_STRUCT: 371
195 CHECK_CONS (object); 372 case DBUS_TYPE_INT64:
196 break; 373 XD_DEBUG_MESSAGE ("%c %d", dtype, XINT (object));
197 case DBUS_TYPE_DICT_ENTRY: 374 value = (char *) (dbus_int64_t *) XINT (object);
198 /* ToDo: Check that there are exactly two elements, and the 375 break;
199 first one is of basic type. */ 376
200 CHECK_CONS (object); 377 case DBUS_TYPE_UINT64:
201 break; 378 XD_DEBUG_MESSAGE ("%c %u", dtype, XUINT (object));
202 default: 379 value = (char *) (dbus_int64_t *) XUINT (object);
203 xsignal1 (Qdbus_error, build_string ("Unknown D-Bus type")); 380 break;
204 } 381
205 382 case DBUS_TYPE_DOUBLE:
206 if (CONSP (object)) 383 XD_DEBUG_MESSAGE ("%c %f", dtype, XFLOAT (object));
207 384 value = (char *) (float *) XFLOAT (object);
208 /* Compound types. */ 385 break;
209 { 386
210 DBusMessageIter subiter; 387 case DBUS_TYPE_STRING:
211 char subtype; 388 case DBUS_TYPE_OBJECT_PATH:
212 389 case DBUS_TYPE_SIGNATURE:
213 if (SYMBOLP (XCAR (object)) 390 XD_DEBUG_MESSAGE ("%c %s", dtype, SDATA (object));
214 && (strncmp (SDATA (XSYMBOL (XCAR (object))->xname), ":", 1) == 0)) 391 value = SDATA (object);
215 object = XCDR (object); 392 break;
393 }
394
395 if (!dbus_message_iter_append_basic (iter, dtype, &value))
396 xsignal2 (Qdbus_error,
397 build_string ("Unable to append argument"), object);
398 }
399
400 else /* Compound types. */
401 {
402
403 /* All compound types except array have a type symbol. For
404 array, it is optional. Skip it. */
405 if (!XD_BASIC_DBUS_TYPE (XD_OBJECT_TO_DBUS_TYPE (XCAR (object))))
406 object = XD_NEXT_VALUE (object);
216 407
217 /* Open new subiteration. */ 408 /* Open new subiteration. */
218 switch (dtype) 409 switch (dtype)
219 { 410 {
220 case DBUS_TYPE_ARRAY: 411 case DBUS_TYPE_ARRAY:
221 case DBUS_TYPE_VARIANT: 412 case DBUS_TYPE_VARIANT:
222 subtype = (char) XD_LISP_OBJECT_TO_DBUS_TYPE (XCAR (object)); 413 /* A variant has just one element. An array has elements of
223 dbus_message_iter_open_container (iter, dtype, &subtype, &subiter); 414 the same type. Both have been checked already, it is
415 sufficient to retrieve just the signature of the first
416 element. */
417 xd_signature (signature, XD_OBJECT_TO_DBUS_TYPE (XCAR (object)),
418 dtype, XCAR (XD_NEXT_VALUE (object)));
419 XD_DEBUG_MESSAGE ("%c %s %s", dtype, signature,
420 SDATA (format2 ("%s", object, Qnil)));
421 if (!dbus_message_iter_open_container (iter, dtype,
422 signature, &subiter))
423 xsignal3 (Qdbus_error,
424 build_string ("Cannot open container"),
425 make_number (dtype), build_string (signature));
224 break; 426 break;
427
225 case DBUS_TYPE_STRUCT: 428 case DBUS_TYPE_STRUCT:
226 case DBUS_TYPE_DICT_ENTRY: 429 case DBUS_TYPE_DICT_ENTRY:
227 dbus_message_iter_open_container (iter, dtype, NULL, &subiter); 430 XD_DEBUG_MESSAGE ("%c %s", dtype,
431 SDATA (format2 ("%s", object, Qnil)));
432 if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
433 xsignal2 (Qdbus_error,
434 build_string ("Cannot open container"),
435 make_number (dtype));
436 break;
228 } 437 }
229 438
230 /* Loop over list elements. */ 439 /* Loop over list elements. */
231 while (!NILP (object)) 440 while (!NILP (object))
232 { 441 {
233 dtype = XD_LISP_OBJECT_TO_DBUS_TYPE (XCAR (object)); 442 dtype = XD_OBJECT_TO_DBUS_TYPE (XCAR (object));
234 if (dtype == DBUS_TYPE_INVALID) 443 object = XD_NEXT_VALUE (object);
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 444
243 xd_append_arg (dtype, XCAR (object), &subiter); 445 xd_append_arg (dtype, XCAR (object), &subiter);
244 446
245 object = XCDR (object); 447 object = XCDR (object);
246 } 448 }
247 449
248 dbus_message_iter_close_container (iter, &subiter); 450 if (!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, 451 xsignal2 (Qdbus_error,
303 build_string ("Unable to append argument"), object); 452 build_string ("Cannot close container"),
453 make_number (dtype));
304 } 454 }
305 } 455 }
306 456
307 /* Retrieve C value from a DBusMessageIter structure ITER, and return 457 /* Retrieve C value from a DBusMessageIter structure ITER, and return
308 a converted Lisp object. The type DTYPE of the argument of the 458 a converted Lisp object. The type DTYPE of the argument of the
318 { 468 {
319 case DBUS_TYPE_BOOLEAN: 469 case DBUS_TYPE_BOOLEAN:
320 { 470 {
321 dbus_bool_t val; 471 dbus_bool_t val;
322 dbus_message_iter_get_basic (iter, &val); 472 dbus_message_iter_get_basic (iter, &val);
323 XD_DEBUG_MESSAGE ("%d %s", dtype, (val == FALSE) ? "false" : "true"); 473 XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true");
324 return (val == FALSE) ? Qnil : Qt; 474 return (val == FALSE) ? Qnil : Qt;
325 } 475 }
476
326 case DBUS_TYPE_INT32: 477 case DBUS_TYPE_INT32:
327 case DBUS_TYPE_UINT32: 478 case DBUS_TYPE_UINT32:
328 { 479 {
329 dbus_uint32_t val; 480 dbus_uint32_t val;
330 dbus_message_iter_get_basic (iter, &val); 481 dbus_message_iter_get_basic (iter, &val);
331 XD_DEBUG_MESSAGE ("%d %d", dtype, val); 482 XD_DEBUG_MESSAGE ("%c %d", dtype, val);
332 return make_number (val); 483 return make_number (val);
333 } 484 }
485
334 case DBUS_TYPE_STRING: 486 case DBUS_TYPE_STRING:
335 case DBUS_TYPE_OBJECT_PATH: 487 case DBUS_TYPE_OBJECT_PATH:
336 { 488 {
337 char *val; 489 char *val;
338 dbus_message_iter_get_basic (iter, &val); 490 dbus_message_iter_get_basic (iter, &val);
339 XD_DEBUG_MESSAGE ("%d %s", dtype, val); 491 XD_DEBUG_MESSAGE ("%c %s", dtype, val);
340 return build_string (val); 492 return build_string (val);
341 } 493 }
494
342 case DBUS_TYPE_ARRAY: 495 case DBUS_TYPE_ARRAY:
343 case DBUS_TYPE_VARIANT: 496 case DBUS_TYPE_VARIANT:
344 case DBUS_TYPE_STRUCT: 497 case DBUS_TYPE_STRUCT:
345 case DBUS_TYPE_DICT_ENTRY: 498 case DBUS_TYPE_DICT_ENTRY:
346 { 499 {
357 result = Fcons (xd_retrieve_arg (subtype, &subiter), result); 510 result = Fcons (xd_retrieve_arg (subtype, &subiter), result);
358 dbus_message_iter_next (&subiter); 511 dbus_message_iter_next (&subiter);
359 } 512 }
360 RETURN_UNGCPRO (Fnreverse (result)); 513 RETURN_UNGCPRO (Fnreverse (result));
361 } 514 }
515
362 default: 516 default:
363 XD_DEBUG_MESSAGE ("DBusType %d not supported", dtype); 517 XD_DEBUG_MESSAGE ("DBusType '%c' not supported", dtype);
364 return Qnil; 518 return Qnil;
365 } 519 }
366 } 520 }
367 521
368 522
437 t and nil => DBUS_TYPE_BOOLEAN 591 t and nil => DBUS_TYPE_BOOLEAN
438 number => DBUS_TYPE_UINT32 592 number => DBUS_TYPE_UINT32
439 integer => DBUS_TYPE_INT32 593 integer => DBUS_TYPE_INT32
440 float => DBUS_TYPE_DOUBLE 594 float => DBUS_TYPE_DOUBLE
441 string => DBUS_TYPE_STRING 595 string => DBUS_TYPE_STRING
442 596 list => DBUS_TYPE_ARRAY
443 Other Lisp objects are not supported as input arguments of METHOD. 597
598 All arguments can be preceded by a type symbol. For details about
599 type symbols, see Info node `(dbus)Type Conversion'.
444 600
445 `dbus-call-method' returns the resulting values of METHOD as a list of 601 `dbus-call-method' returns the resulting values of METHOD as a list of
446 Lisp objects. The type conversion happens the other direction as for 602 Lisp objects. The type conversion happens the other direction as for
447 input arguments. Additionally to the types supported for input 603 input arguments. It follows the mapping rules:
448 arguments, the D-Bus compound types DBUS_TYPE_ARRAY, DBUS_TYPE_VARIANT, 604
449 DBUS_TYPE_STRUCT and DBUS_TYPE_DICT_ENTRY are accepted. All of them 605 DBUS_TYPE_BOOLEAN => t or nil
450 are converted into a list of Lisp objects which correspond to the 606 DBUS_TYPE_BYTE => number
451 elements of the D-Bus container. Example: 607 DBUS_TYPE_UINT16 => number
608 DBUS_TYPE_INT16 => integer
609 DBUS_TYPE_UINT32 => number
610 DBUS_TYPE_INT32 => integer
611 DBUS_TYPE_UINT64 => number
612 DBUS_TYPE_INT64 => integer
613 DBUS_TYPE_DOUBLE => float
614 DBUS_TYPE_STRING => string
615 DBUS_TYPE_OBJECT_PATH => string
616 DBUS_TYPE_SIGNATURE => string
617 DBUS_TYPE_ARRAY => list
618 DBUS_TYPE_VARIANT => list
619 DBUS_TYPE_STRUCT => list
620 DBUS_TYPE_DICT_ENTRY => list
621
622 Example:
452 623
453 \(dbus-call-method 624 \(dbus-call-method
454 :session "org.gnome.seahorse" "/org/gnome/seahorse/keys/openpgp" 625 :session "org.gnome.seahorse" "/org/gnome/seahorse/keys/openpgp"
455 "org.gnome.seahorse.Keys" "GetKeyField" 626 "org.gnome.seahorse.Keys" "GetKeyField"
456 "openpgp:657984B8C7A966DD" "simple-name") 627 "openpgp:657984B8C7A966DD" "simple-name")
480 DBusMessage *reply; 651 DBusMessage *reply;
481 DBusMessageIter iter; 652 DBusMessageIter iter;
482 DBusError derror; 653 DBusError derror;
483 unsigned int dtype; 654 unsigned int dtype;
484 int i; 655 int i;
485 char *value; 656 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
486 657
487 /* Check parameters. */ 658 /* Check parameters. */
488 bus = args[0]; 659 bus = args[0];
489 service = args[1]; 660 service = args[1];
490 path = args[2]; 661 path = args[2];
527 for (i = 5; i < nargs; ++i) 698 for (i = 5; i < nargs; ++i)
528 { 699 {
529 700
530 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); 701 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
531 XD_DEBUG_MESSAGE ("Parameter%d %s", 702 XD_DEBUG_MESSAGE ("Parameter%d %s",
532 i-4, 703 i-4, SDATA (format2 ("%s", args[i], Qnil)));
533 SDATA (format2 ("%s", args[i], Qnil))); 704
534 705 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
535 dtype = XD_LISP_OBJECT_TO_DBUS_TYPE (args[i]); 706 if (XD_DBUS_TYPE_P (args[i]))
536 if (dtype == DBUS_TYPE_INVALID)
537 xsignal2 (Qdbus_error, build_string ("Not a valid argument"), args[i]);
538
539 if (SYMBOLP (args[i])
540 && (strncmp (SDATA (XSYMBOL (args[i])->xname), ":", 1) == 0))
541 ++i; 707 ++i;
708
709 /* Check for valid signature. We use DBUS_TYPE_INVALID is
710 indication that there is no parent type. */
711 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
542 712
543 xd_append_arg (dtype, args[i], &iter); 713 xd_append_arg (dtype, args[i], &iter);
544 } 714 }
545 715
546 /* Send the message. */ 716 /* Send the message. */
603 t and nil => DBUS_TYPE_BOOLEAN 773 t and nil => DBUS_TYPE_BOOLEAN
604 number => DBUS_TYPE_UINT32 774 number => DBUS_TYPE_UINT32
605 integer => DBUS_TYPE_INT32 775 integer => DBUS_TYPE_INT32
606 float => DBUS_TYPE_DOUBLE 776 float => DBUS_TYPE_DOUBLE
607 string => DBUS_TYPE_STRING 777 string => DBUS_TYPE_STRING
608 778 list => DBUS_TYPE_ARRAY
609 Other Lisp objects are not supported as arguments of SIGNAL. 779
780 All arguments can be preceded by a type symbol. For details about
781 type symbols, see Info node `(dbus)Type Conversion'.
610 782
611 Example: 783 Example:
612 784
613 \(dbus-send-signal 785 \(dbus-send-signal
614 :session "org.gnu.Emacs" "/org/gnu/Emacs" 786 :session "org.gnu.Emacs" "/org/gnu/Emacs"
624 DBusConnection *connection; 796 DBusConnection *connection;
625 DBusMessage *dmessage; 797 DBusMessage *dmessage;
626 DBusMessageIter iter; 798 DBusMessageIter iter;
627 unsigned int dtype; 799 unsigned int dtype;
628 int i; 800 int i;
629 char *value; 801 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
630 802
631 /* Check parameters. */ 803 /* Check parameters. */
632 bus = args[0]; 804 bus = args[0];
633 service = args[1]; 805 service = args[1];
634 path = args[2]; 806 path = args[2];
669 /* Append parameters to the message. */ 841 /* Append parameters to the message. */
670 for (i = 5; i < nargs; ++i) 842 for (i = 5; i < nargs; ++i)
671 { 843 {
672 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); 844 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
673 XD_DEBUG_MESSAGE ("Parameter%d %s", 845 XD_DEBUG_MESSAGE ("Parameter%d %s",
674 i-4, 846 i-4, SDATA (format2 ("%s", args[i], Qnil)));
675 SDATA (format2 ("%s", args[i], Qnil))); 847
676 848 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
677 dtype = XD_LISP_OBJECT_TO_DBUS_TYPE (args[i]); 849 if (XD_DBUS_TYPE_P (args[i]))
678 if (dtype == DBUS_TYPE_INVALID)
679 xsignal2 (Qdbus_error, build_string ("Not a valid argument"), args[i]);
680
681 if (SYMBOLP (args[i])
682 && (strncmp (SDATA (XSYMBOL (args[i])->xname), ":", 1) == 0))
683 ++i; 850 ++i;
851
852 /* Check for valid signature. We use DBUS_TYPE_INVALID is
853 indication that there is no parent type. */
854 xd_signature (signature, dtype, DBUS_TYPE_INVALID, args[i]);
684 855
685 xd_append_arg (dtype, args[i], &iter); 856 xd_append_arg (dtype, args[i], &iter);
686 } 857 }
687 858
688 /* Send the message. The message is just added to the outgoing 859 /* Send the message. The message is just added to the outgoing