comparison src/dbusbind.c @ 93420:629d4147200e

* dbusbind.c (QCdbus_timeout): New D-Bus internal symbol. (Fdbus_call_method): New parameter TIMEOUT. (dbus-send-signal): Optimize UNGCPRO call.
author Michael Albinus <michael.albinus@gmx.de>
date Sun, 30 Mar 2008 12:38:19 +0000
parents 3ef12fa772f2
children a5a4ff3b6cc3
comparison
equal deleted inserted replaced
93419:4482f387c2fe 93420:629d4147200e
41 /* D-Bus error symbol. */ 41 /* D-Bus error symbol. */
42 Lisp_Object Qdbus_error; 42 Lisp_Object Qdbus_error;
43 43
44 /* Lisp symbols of the system and session buses. */ 44 /* Lisp symbols of the system and session buses. */
45 Lisp_Object QCdbus_system_bus, QCdbus_session_bus; 45 Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
46
47 /* Lisp symbol for method call timeout. */
48 Lisp_Object QCdbus_timeout;
46 49
47 /* Lisp symbols of D-Bus types. */ 50 /* Lisp symbols of D-Bus types. */
48 Lisp_Object QCdbus_type_byte, QCdbus_type_boolean; 51 Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
49 Lisp_Object QCdbus_type_int16, QCdbus_type_uint16; 52 Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
50 Lisp_Object QCdbus_type_int32, QCdbus_type_uint32; 53 Lisp_Object QCdbus_type_int32, QCdbus_type_uint32;
722 725
723 SERVICE is the D-Bus service name to be used. PATH is the D-Bus 726 SERVICE is the D-Bus service name to be used. PATH is the D-Bus
724 object path SERVICE is registered at. INTERFACE is an interface 727 object path SERVICE is registered at. INTERFACE is an interface
725 offered by SERVICE. It must provide METHOD. 728 offered by SERVICE. It must provide METHOD.
726 729
730 If the parameter `:timeout' is given, the following integer TIMEOUT
731 specifies the maximun number of milliseconds the method call must
732 return. The default value is 25.000. If the method call doesn't return
733 in time, a D-Bus error is raised.
734
727 All other arguments ARGS are passed to METHOD as arguments. They are 735 All other arguments ARGS are passed to METHOD as arguments. They are
728 converted into D-Bus types via the following rules: 736 converted into D-Bus types via the following rules:
729 737
730 t and nil => DBUS_TYPE_BOOLEAN 738 t and nil => DBUS_TYPE_BOOLEAN
731 number => DBUS_TYPE_UINT32 739 number => DBUS_TYPE_UINT32
775 "org.freedesktop.Hal.Device" "GetPropertyString" 783 "org.freedesktop.Hal.Device" "GetPropertyString"
776 "system.kernel.machine") 784 "system.kernel.machine")
777 785
778 => "i686" 786 => "i686"
779 787
780 usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &rest ARGS) */) 788 usage: (dbus-call-method
789 BUS SERVICE PATH INTERFACE METHOD
790 &optional :timeout TIMEOUT &rest ARGS) */)
781 (nargs, args) 791 (nargs, args)
782 int nargs; 792 int nargs;
783 register Lisp_Object *args; 793 register Lisp_Object *args;
784 { 794 {
785 Lisp_Object bus, service, path, interface, method; 795 Lisp_Object bus, service, path, interface, method;
789 DBusMessage *dmessage; 799 DBusMessage *dmessage;
790 DBusMessage *reply; 800 DBusMessage *reply;
791 DBusMessageIter iter; 801 DBusMessageIter iter;
792 DBusError derror; 802 DBusError derror;
793 unsigned int dtype; 803 unsigned int dtype;
794 int i; 804 int timeout = -1;
805 int i = 5;
795 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH]; 806 char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH];
796 807
797 /* Check parameters. */ 808 /* Check parameters. */
798 bus = args[0]; 809 bus = args[0];
799 service = args[1]; 810 service = args[1];
820 /* Create the message. */ 831 /* Create the message. */
821 dmessage = dbus_message_new_method_call (SDATA (service), 832 dmessage = dbus_message_new_method_call (SDATA (service),
822 SDATA (path), 833 SDATA (path),
823 SDATA (interface), 834 SDATA (interface),
824 SDATA (method)); 835 SDATA (method));
836 UNGCPRO;
825 if (dmessage == NULL) 837 if (dmessage == NULL)
838 xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
839
840 /* Check for timeout parameter. */
841 if ((i+2 <= nargs) && (EQ ((args[i]), QCdbus_timeout)))
826 { 842 {
827 UNGCPRO; 843 CHECK_NATNUM (args[i+1]);
828 xsignal1 (Qdbus_error, build_string ("Unable to create a new message")); 844 timeout = XUINT (args[i+1]);
845 i = i+2;
829 } 846 }
830
831 UNGCPRO;
832 847
833 /* Initialize parameter list of message. */ 848 /* Initialize parameter list of message. */
834 dbus_message_iter_init_append (dmessage, &iter); 849 dbus_message_iter_init_append (dmessage, &iter);
835 850
836 /* Append parameters to the message. */ 851 /* Append parameters to the message. */
837 for (i = 5; i < nargs; ++i) 852 for (; i < nargs; ++i)
838 { 853 {
839 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]); 854 dtype = XD_OBJECT_TO_DBUS_TYPE (args[i]);
840 if (XD_DBUS_TYPE_P (args[i])) 855 if (XD_DBUS_TYPE_P (args[i]))
841 { 856 {
842 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]); 857 XD_DEBUG_VALID_LISP_OBJECT_P (args[i]);
862 877
863 /* Send the message. */ 878 /* Send the message. */
864 dbus_error_init (&derror); 879 dbus_error_init (&derror);
865 reply = dbus_connection_send_with_reply_and_block (connection, 880 reply = dbus_connection_send_with_reply_and_block (connection,
866 dmessage, 881 dmessage,
867 -1, 882 timeout,
868 &derror); 883 &derror);
869 884
870 if (dbus_error_is_set (&derror)) 885 if (dbus_error_is_set (&derror))
871 XD_ERROR (derror); 886 XD_ERROR (derror);
872 887
1069 1084
1070 /* Create the message. */ 1085 /* Create the message. */
1071 dmessage = dbus_message_new_signal (SDATA (path), 1086 dmessage = dbus_message_new_signal (SDATA (path),
1072 SDATA (interface), 1087 SDATA (interface),
1073 SDATA (signal)); 1088 SDATA (signal));
1089 UNGCPRO;
1074 if (dmessage == NULL) 1090 if (dmessage == NULL)
1075 { 1091 xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
1076 UNGCPRO;
1077 xsignal1 (Qdbus_error, build_string ("Unable to create a new message"));
1078 }
1079
1080 UNGCPRO;
1081 1092
1082 /* Initialize parameter list of message. */ 1093 /* Initialize parameter list of message. */
1083 dbus_message_iter_init_append (dmessage, &iter); 1094 dbus_message_iter_init_append (dmessage, &iter);
1084 1095
1085 /* Append parameters to the message. */ 1096 /* Append parameters to the message. */
1176 uname = dbus_message_get_sender (dmessage); 1187 uname = dbus_message_get_sender (dmessage);
1177 path = dbus_message_get_path (dmessage); 1188 path = dbus_message_get_path (dmessage);
1178 interface = dbus_message_get_interface (dmessage); 1189 interface = dbus_message_get_interface (dmessage);
1179 member = dbus_message_get_member (dmessage); 1190 member = dbus_message_get_member (dmessage);
1180 1191
1181 /* dbus-registered-functions-table requires non nil interface and member. */ 1192 /* Vdbus_registered_functions_table requires non-nil interface and member. */
1182 if ((NULL == interface) || (NULL == member)) 1193 if ((NULL == interface) || (NULL == member))
1183 goto cleanup; 1194 goto cleanup;
1184 1195
1185 XD_DEBUG_MESSAGE ("Event received: %d %s %s %s %s %s", 1196 XD_DEBUG_MESSAGE ("Event received: %d %s %s %s %s %s",
1186 mtype, uname, path, interface, member, 1197 mtype, uname, path, interface, member,
1460 staticpro (&QCdbus_system_bus); 1471 staticpro (&QCdbus_system_bus);
1461 1472
1462 QCdbus_session_bus = intern (":session"); 1473 QCdbus_session_bus = intern (":session");
1463 staticpro (&QCdbus_session_bus); 1474 staticpro (&QCdbus_session_bus);
1464 1475
1476 QCdbus_timeout = intern (":timeout");
1477 staticpro (&QCdbus_timeout);
1478
1465 QCdbus_type_byte = intern (":byte"); 1479 QCdbus_type_byte = intern (":byte");
1466 staticpro (&QCdbus_type_byte); 1480 staticpro (&QCdbus_type_byte);
1467 1481
1468 QCdbus_type_boolean = intern (":boolean"); 1482 QCdbus_type_boolean = intern (":boolean");
1469 staticpro (&QCdbus_type_boolean); 1483 staticpro (&QCdbus_type_boolean);