diff options
Diffstat (limited to 'src/dbusbind.c')
| -rw-r--r-- | src/dbusbind.c | 140 |
1 files changed, 58 insertions, 82 deletions
diff --git a/src/dbusbind.c b/src/dbusbind.c index 136cea9adb4..4bc48f3b6e9 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c | |||
| @@ -33,11 +33,10 @@ Boston, MA 02110-1301, USA. */ | |||
| 33 | /* Subroutines. */ | 33 | /* Subroutines. */ |
| 34 | Lisp_Object Qdbus_get_unique_name; | 34 | Lisp_Object Qdbus_get_unique_name; |
| 35 | Lisp_Object Qdbus_call_method; | 35 | Lisp_Object Qdbus_call_method; |
| 36 | Lisp_Object Qdbus_method_return; | 36 | Lisp_Object Qdbus_method_return_internal; |
| 37 | Lisp_Object Qdbus_send_signal; | 37 | Lisp_Object Qdbus_send_signal; |
| 38 | Lisp_Object Qdbus_register_signal; | 38 | Lisp_Object Qdbus_register_signal; |
| 39 | Lisp_Object Qdbus_register_method; | 39 | Lisp_Object Qdbus_register_method; |
| 40 | Lisp_Object Qdbus_unregister_object; | ||
| 41 | 40 | ||
| 42 | /* D-Bus error symbol. */ | 41 | /* D-Bus error symbol. */ |
| 43 | Lisp_Object Qdbus_error; | 42 | Lisp_Object Qdbus_error; |
| @@ -595,10 +594,14 @@ xd_retrieve_arg (dtype, iter) | |||
| 595 | case DBUS_TYPE_INT32: | 594 | case DBUS_TYPE_INT32: |
| 596 | case DBUS_TYPE_UINT32: | 595 | case DBUS_TYPE_UINT32: |
| 597 | { | 596 | { |
| 597 | /* Assignment to EMACS_INT stops GCC whining about limited | ||
| 598 | range of data type. */ | ||
| 598 | dbus_uint32_t val; | 599 | dbus_uint32_t val; |
| 600 | EMACS_INT val1; | ||
| 599 | dbus_message_iter_get_basic (iter, &val); | 601 | dbus_message_iter_get_basic (iter, &val); |
| 600 | XD_DEBUG_MESSAGE ("%c %d", dtype, val); | 602 | XD_DEBUG_MESSAGE ("%c %d", dtype, val); |
| 601 | return make_fixnum_or_float (val); | 603 | val1 = val; |
| 604 | return make_fixnum_or_float (val1); | ||
| 602 | } | 605 | } |
| 603 | 606 | ||
| 604 | case DBUS_TYPE_INT64: | 607 | case DBUS_TYPE_INT64: |
| @@ -833,14 +836,22 @@ usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &rest ARGS) */) | |||
| 833 | /* Append parameters to the message. */ | 836 | /* Append parameters to the message. */ |
| 834 | for (i = 5; i < nargs; ++i) | 837 | for (i = 5; i < nargs; ++i) |
| 835 | { | 838 | { |
| 836 | |||
| 837 | XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); | ||
| 838 | XD_DEBUG_MESSAGE ("Parameter%d %s", | ||
| 839 | i-4, SDATA (format2 ("%s", args[i], Qnil))); | ||
| 840 | |||
| 841 | dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]); | 839 | dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]); |
| 842 | if (XD_DBUS_TYPE_P (args[i])) | 840 | if (XD_DBUS_TYPE_P (args[i])) |
| 843 | ++i; | 841 | { |
| 842 | XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); | ||
| 843 | XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]); | ||
| 844 | XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4, | ||
| 845 | SDATA (format2 ("%s", args[i], Qnil)), | ||
| 846 | SDATA (format2 ("%s", args[i+1], Qnil))); | ||
| 847 | ++i; | ||
| 848 | } | ||
| 849 | else | ||
| 850 | { | ||
| 851 | XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); | ||
| 852 | XD_DEBUG_MESSAGE ("Parameter%d %s", i-4, | ||
| 853 | SDATA (format2 ("%s", args[i], Qnil))); | ||
| 854 | } | ||
| 844 | 855 | ||
| 845 | /* Check for valid signature. We use DBUS_TYPE_INVALID as | 856 | /* Check for valid signature. We use DBUS_TYPE_INVALID as |
| 846 | indication that there is no parent type. */ | 857 | indication that there is no parent type. */ |
| @@ -872,7 +883,8 @@ usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &rest ARGS) */) | |||
| 872 | { | 883 | { |
| 873 | /* Loop over the parameters of the D-Bus reply message. Construct a | 884 | /* Loop over the parameters of the D-Bus reply message. Construct a |
| 874 | Lisp list, which is returned by `dbus-call-method'. */ | 885 | Lisp list, which is returned by `dbus-call-method'. */ |
| 875 | while ((dtype = dbus_message_iter_get_arg_type (&iter)) != DBUS_TYPE_INVALID) | 886 | while ((dtype = dbus_message_iter_get_arg_type (&iter)) |
| 887 | != DBUS_TYPE_INVALID) | ||
| 876 | { | 888 | { |
| 877 | result = Fcons (xd_retrieve_arg (dtype, &iter), result); | 889 | result = Fcons (xd_retrieve_arg (dtype, &iter), result); |
| 878 | dbus_message_iter_next (&iter); | 890 | dbus_message_iter_next (&iter); |
| @@ -880,7 +892,7 @@ usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &rest ARGS) */) | |||
| 880 | } | 892 | } |
| 881 | else | 893 | else |
| 882 | { | 894 | { |
| 883 | /* No arguments: just return nil. */ | 895 | /* No arguments: just return nil. */ |
| 884 | } | 896 | } |
| 885 | 897 | ||
| 886 | /* Cleanup. */ | 898 | /* Cleanup. */ |
| @@ -895,12 +907,13 @@ usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &rest ARGS) */) | |||
| 895 | RETURN_UNGCPRO (Fnreverse (result)); | 907 | RETURN_UNGCPRO (Fnreverse (result)); |
| 896 | } | 908 | } |
| 897 | 909 | ||
| 898 | DEFUN ("dbus-method-return", Fdbus_method_return, Sdbus_method_return, | 910 | DEFUN ("dbus-method-return-internal", Fdbus_method_return_internal, |
| 911 | Sdbus_method_return_internal, | ||
| 899 | 3, MANY, 0, | 912 | 3, MANY, 0, |
| 900 | doc: /* Return to method SERIAL on the D-Bus BUS. | 913 | doc: /* Return for message SERIAL on the D-Bus BUS. |
| 901 | This is an internal function, it shall not be used outside dbus.el. | 914 | This is an internal function, it shall not be used outside dbus.el. |
| 902 | 915 | ||
| 903 | usage: (dbus-method-return BUS SERIAL SERVICE &rest ARGS) */) | 916 | usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */) |
| 904 | (nargs, args) | 917 | (nargs, args) |
| 905 | int nargs; | 918 | int nargs; |
| 906 | register Lisp_Object *args; | 919 | register Lisp_Object *args; |
| @@ -948,14 +961,22 @@ usage: (dbus-method-return BUS SERIAL SERVICE &rest ARGS) */) | |||
| 948 | /* Append parameters to the message. */ | 961 | /* Append parameters to the message. */ |
| 949 | for (i = 3; i < nargs; ++i) | 962 | for (i = 3; i < nargs; ++i) |
| 950 | { | 963 | { |
| 951 | |||
| 952 | XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); | ||
| 953 | XD_DEBUG_MESSAGE ("Parameter%d %s", | ||
| 954 | i-2, SDATA (format2 ("%s", args[i], Qnil))); | ||
| 955 | |||
| 956 | dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]); | 964 | dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]); |
| 957 | if (XD_DBUS_TYPE_P (args[i])) | 965 | if (XD_DBUS_TYPE_P (args[i])) |
| 958 | ++i; | 966 | { |
| 967 | XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); | ||
| 968 | XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]); | ||
| 969 | XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-2, | ||
| 970 | SDATA (format2 ("%s", args[i], Qnil)), | ||
| 971 | SDATA (format2 ("%s", args[i+1], Qnil))); | ||
| 972 | ++i; | ||
| 973 | } | ||
| 974 | else | ||
| 975 | { | ||
| 976 | XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); | ||
| 977 | XD_DEBUG_MESSAGE ("Parameter%d %s", i-2, | ||
| 978 | SDATA (format2 ("%s", args[i], Qnil))); | ||
| 979 | } | ||
| 959 | 980 | ||
| 960 | /* Check for valid signature. We use DBUS_TYPE_INVALID as | 981 | /* Check for valid signature. We use DBUS_TYPE_INVALID as |
| 961 | indication that there is no parent type. */ | 982 | indication that there is no parent type. */ |
| @@ -1064,13 +1085,22 @@ usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */) | |||
| 1064 | /* Append parameters to the message. */ | 1085 | /* Append parameters to the message. */ |
| 1065 | for (i = 5; i < nargs; ++i) | 1086 | for (i = 5; i < nargs; ++i) |
| 1066 | { | 1087 | { |
| 1067 | XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); | ||
| 1068 | XD_DEBUG_MESSAGE ("Parameter%d %s", | ||
| 1069 | i-4, SDATA (format2 ("%s", args[i], Qnil))); | ||
| 1070 | |||
| 1071 | dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]); | 1088 | dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]); |
| 1072 | if (XD_DBUS_TYPE_P (args[i])) | 1089 | if (XD_DBUS_TYPE_P (args[i])) |
| 1073 | ++i; | 1090 | { |
| 1091 | XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); | ||
| 1092 | XD_DEBUG_VALID_LISP_OBJECT_P (args[i+1]); | ||
| 1093 | XD_DEBUG_MESSAGE ("Parameter%d %s %s", i-4, | ||
| 1094 | SDATA (format2 ("%s", args[i], Qnil)), | ||
| 1095 | SDATA (format2 ("%s", args[i+1], Qnil))); | ||
| 1096 | ++i; | ||
| 1097 | } | ||
| 1098 | else | ||
| 1099 | { | ||
| 1100 | XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); | ||
| 1101 | XD_DEBUG_MESSAGE ("Parameter%d %s", i-4, | ||
| 1102 | SDATA (format2 ("%s", args[i], Qnil))); | ||
| 1103 | } | ||
| 1074 | 1104 | ||
| 1075 | /* Check for valid signature. We use DBUS_TYPE_INVALID as | 1105 | /* Check for valid signature. We use DBUS_TYPE_INVALID as |
| 1076 | indication that there is no parent type. */ | 1106 | indication that there is no parent type. */ |
| @@ -1392,56 +1422,6 @@ used for composing the returning D-Bus message. */) | |||
| 1392 | return list2 (key, list3 (service, path, handler)); | 1422 | return list2 (key, list3 (service, path, handler)); |
| 1393 | } | 1423 | } |
| 1394 | 1424 | ||
| 1395 | DEFUN ("dbus-unregister-object", Fdbus_unregister_object, | ||
| 1396 | Sdbus_unregister_object, | ||
| 1397 | 1, 1, 0, | ||
| 1398 | doc: /* Unregister OBJECT from the D-Bus. | ||
| 1399 | OBJECT must be the result of a preceding `dbus-register-signal' or | ||
| 1400 | `dbus-register-method' call. It returns t if OBJECT has been | ||
| 1401 | unregistered, nil otherwise. */) | ||
| 1402 | (object) | ||
| 1403 | Lisp_Object object; | ||
| 1404 | { | ||
| 1405 | Lisp_Object value; | ||
| 1406 | struct gcpro gcpro1; | ||
| 1407 | |||
| 1408 | /* Check parameter. */ | ||
| 1409 | if (!(CONSP (object) && (!NILP (CAR_SAFE (object))) | ||
| 1410 | && CONSP (CDR_SAFE (object)))) | ||
| 1411 | wrong_type_argument (intern ("D-Bus"), object); | ||
| 1412 | |||
| 1413 | /* Find the corresponding entry in the hash table. */ | ||
| 1414 | value = Fgethash (CAR_SAFE (object), Vdbus_registered_functions_table, Qnil); | ||
| 1415 | |||
| 1416 | /* Loop over the registered functions. */ | ||
| 1417 | while (!NILP (value)) | ||
| 1418 | { | ||
| 1419 | GCPRO1 (value); | ||
| 1420 | |||
| 1421 | /* (car value) has the structure (UNAME SERVICE PATH HANDLER). | ||
| 1422 | (cdr object) has the structure ((SERVICE PATH HANDLER) ...). */ | ||
| 1423 | if (!NILP (Fequal (CDR_SAFE (CAR_SAFE (value)), | ||
| 1424 | CAR_SAFE (CDR_SAFE (object))))) | ||
| 1425 | { | ||
| 1426 | /* Compute new hash value. */ | ||
| 1427 | value = Fdelete (CAR_SAFE (value), | ||
| 1428 | Fgethash (CAR_SAFE (object), | ||
| 1429 | Vdbus_registered_functions_table, Qnil)); | ||
| 1430 | if (NILP (value)) | ||
| 1431 | Fremhash (CAR_SAFE (object), Vdbus_registered_functions_table); | ||
| 1432 | else | ||
| 1433 | Fputhash (CAR_SAFE (object), value, | ||
| 1434 | Vdbus_registered_functions_table); | ||
| 1435 | RETURN_UNGCPRO (Qt); | ||
| 1436 | } | ||
| 1437 | UNGCPRO; | ||
| 1438 | value = CDR_SAFE (value); | ||
| 1439 | } | ||
| 1440 | |||
| 1441 | /* Return. */ | ||
| 1442 | return Qnil; | ||
| 1443 | } | ||
| 1444 | |||
| 1445 | 1425 | ||
| 1446 | void | 1426 | void |
| 1447 | syms_of_dbusbind () | 1427 | syms_of_dbusbind () |
| @@ -1455,9 +1435,9 @@ syms_of_dbusbind () | |||
| 1455 | staticpro (&Qdbus_call_method); | 1435 | staticpro (&Qdbus_call_method); |
| 1456 | defsubr (&Sdbus_call_method); | 1436 | defsubr (&Sdbus_call_method); |
| 1457 | 1437 | ||
| 1458 | Qdbus_method_return = intern ("dbus-method-return"); | 1438 | Qdbus_method_return_internal = intern ("dbus-method-return-internal"); |
| 1459 | staticpro (&Qdbus_method_return); | 1439 | staticpro (&Qdbus_method_return_internal); |
| 1460 | defsubr (&Sdbus_method_return); | 1440 | defsubr (&Sdbus_method_return_internal); |
| 1461 | 1441 | ||
| 1462 | Qdbus_send_signal = intern ("dbus-send-signal"); | 1442 | Qdbus_send_signal = intern ("dbus-send-signal"); |
| 1463 | staticpro (&Qdbus_send_signal); | 1443 | staticpro (&Qdbus_send_signal); |
| @@ -1471,10 +1451,6 @@ syms_of_dbusbind () | |||
| 1471 | staticpro (&Qdbus_register_method); | 1451 | staticpro (&Qdbus_register_method); |
| 1472 | defsubr (&Sdbus_register_method); | 1452 | defsubr (&Sdbus_register_method); |
| 1473 | 1453 | ||
| 1474 | Qdbus_unregister_object = intern ("dbus-unregister-object"); | ||
| 1475 | staticpro (&Qdbus_unregister_object); | ||
| 1476 | defsubr (&Sdbus_unregister_object); | ||
| 1477 | |||
| 1478 | Qdbus_error = intern ("dbus-error"); | 1454 | Qdbus_error = intern ("dbus-error"); |
| 1479 | staticpro (&Qdbus_error); | 1455 | staticpro (&Qdbus_error); |
| 1480 | Fput (Qdbus_error, Qerror_conditions, | 1456 | Fput (Qdbus_error, Qerror_conditions, |