/**
* Convert a g_variant to a Scheme return value.
*/
static Scheme_Object *
g_variant_to_scheme_result (GVariant *gv)
{
const GVariantType *type; // The type of the GVariant
// Special case: Singleton tuple.
type = g_variant_get_type (gv);
if ( (g_variant_type_is_tuple (type))
&& (g_variant_n_children (gv) == 1) )
return g_variant_to_scheme_object (g_variant_get_child_value (gv, 0));
// Normal case
else
return g_variant_to_scheme_object (gv);
} // g_variant_to_scheme_result
/**
* Create a list of available services.
*/
static Scheme_Object *
loudbus_services (int argc, Scheme_Object **argv)
{
GDBusProxy *proxy;
GError *error = NULL;
GVariant *result;
//Build the proxy.
proxy = g_dbus_proxy_new_for_bus_sync (G_BUS_TYPE_SESSION,
G_DBUS_PROXY_FLAGS_NONE,
NULL,
"org.freedesktop.DBus",
"/",
"org.freedesktop.DBus",
NULL,
&error);
// Check for an error
if (proxy == NULL)
{
if (error != NULL)
{
scheme_signal_error ("Could not create proxy because %s",
error->message);
} // if (error != NULL)
else // if (error == NULL)
{
scheme_signal_error ("Could not create proxy for unknown reasons.");
} // if (error == NULL)
return scheme_void;
} // if (proxy == NULL)
// Get a list of available services.
result = g_dbus_proxy_call_sync (proxy,
"ListNames",
NULL,
0,
-1,
NULL,
&error);
// Check whether an error occurred.
if (result == NULL)
{
if (error != NULL)
{
scheme_signal_error ("Could not list services because: %s",
error->message);
} // if (error != NULL)
else // if (error == NULL)
{
scheme_signal_error ("Could not list services for unknown reason");
} // if (error == NULL)
return scheme_void;
} // if (error == NULL)
// Return the created list.
return g_variant_to_scheme_object (result);
} // loudbus_services
/**
* Get a list of available objects.
* TODO:
* 1. Check that this works at all. (Nope.)
* 2. Check that this gets the full path. (Didn't we decide that
* you needed to recursively find elements?)
* 3. Add error checking for the call to g_variant_to_scheme_result.
* 4. Clean up after yourself. You've created a proxy. Get rid of
* it so it doesn't sit there clogging memory. (See loudbus_proxy_free
* for details.)
*/
static Scheme_Object *
loudbus_objects (int argc, Scheme_Object **argv)
{
GDBusProxy *proxy; // Proxy for connecting to server
GError *error; // Potential error
GVariant *params; // Parameters to function call
GVariant *result; // Result of request for info
gchar *service; // Name of the service
service = scheme_object_to_string (argv[0]);
// Check parameter
if (service == NULL)
{
scheme_wrong_type ("loudbus-proxy", "string", 0, argc, argv);
} // if (service == NULL)
// Create the proxy that we'll use to get information on the service.
LOG ("Creatign proxy for %s", service);
proxy = g_dbus_proxy_new_for_bus_sync (G_BUS_TYPE_SESSION,
G_DBUS_PROXY_FLAGS_NONE,
NULL,
service,
"",
"",
NULL,
&error);
// Call the function to get the objects. (This looks wrong.)
params = g_variant_new("()");
result = g_dbus_proxy_call_sync (proxy,
"",
params,
0,
-1,
NULL,
&error);
// Check the result.
// TODO
// And we're done.
return g_variant_to_scheme_object (result);
} // loudbus_objects
/**
* The kernel of the various mechanisms for calling D-Bus functions.
*/
static Scheme_Object *
dbus_call_kernel (LouDBusProxy *proxy,
gchar *dbus_name,
gchar *external_name,
int argc,
Scheme_Object **argv)
{
GDBusMethodInfo *method;
// Information on the actual method
int arity; // The arity of that method
GVariant *actuals; // The actual parameters
GVariant *gresult; // The result from the function call as a GVariant
Scheme_Object *sresult;
// That Scheme result as a Scheme object
GError *error; // Possible error from call
// Grab the method information.
method = g_dbus_interface_info_lookup_method (proxy->iinfo, dbus_name);
if (method == NULL)
{
scheme_signal_error ("no such method: %s", dbus_name);
} // if the method is invalid
// Get the arity
arity = g_dbus_method_info_num_formals (method);
if (arity != argc)
{
scheme_signal_error ("%s expected %d params, received %d",
external_name, arity, argc);
} // if the arity is incorrect
// Build the actuals
actuals = scheme_objects_to_parameter_tuple (external_name,
argc,
argv,
method->in_args);
if (actuals == NULL)
{
scheme_signal_error ("%s: could not convert parameters",
external_name);
} // if (actuals == NULL)
// Call the function.
error = NULL;
gresult = g_dbus_proxy_call_sync (proxy->proxy,
dbus_name,
actuals,
0,
-1,
NULL,
&error);
if (gresult == NULL)
{
if (error != NULL)
{
scheme_signal_error ("%s: call failed because %s",
external_name, error->message);
} // if (error != NULL)
else
{
scheme_signal_error ("%s: call failed for unknown reason",
external_name);
} // if something went wrong, but there's no error
} // if (gresult == NULL)
// Convert to Scheme form
sresult = g_variant_to_scheme_object (gresult);
if (sresult == NULL)
{
scheme_signal_error ("%s: could not convert return values",
external_name);
} // if (sresult == NULL)
// And we're done.
return sresult;
} // dbus_call_kernel
/**
* Convert a GVariant to a Scheme object. Returns NULL if there's a
* problem.
*/
static Scheme_Object *
g_variant_to_scheme_object (GVariant *gv)
{
const GVariantType *type; // The type of the GVariant
const gchar *typestring; // A string that describes the type
int i; // A counter variable
int len; // Length of arrays and tuples
Scheme_Object *lst = NULL; // A list that we build as a result
Scheme_Object *sval = NULL; // One value
Scheme_Object *result = NULL; // One result to return.
// Special case: We'll treat NULL as void.
if (gv == NULL)
{
return scheme_void;
} // if (gv == NULL)
// Get the type
type = g_variant_get_type (gv);
typestring = g_variant_get_type_string (gv);
// ** Handle most of the basic types **
// Integer
if (g_variant_type_equal (type, G_VARIANT_TYPE_INT32))
{
// We don't refer to any Scheme objects across allocating calls,
// so no need for GC code.
int i;
i = g_variant_get_int32 (gv);
result = scheme_make_integer (i);
return result;
} // if it's an integer
// Double
if (g_variant_type_equal (type, G_VARIANT_TYPE_DOUBLE))
{
double d;
d = g_variant_get_double (gv);
result = scheme_make_double (d);
return result;
} // if it's a double
// String
if (g_variant_type_equal (type, G_VARIANT_TYPE_STRING))
{
// We don't refer to any Scheme objects across allocating calls,
// so no need for GC code.
const gchar *str;
str = g_variant_get_string (gv, NULL);
result = scheme_make_locale_string (str);
return result;
} // if it's a string
// ** Handle some special cases **
// We treat arrays of bytes as bytestrings
if (g_strcmp0 (typestring, "ay") == 0)
{
gsize size;
guchar *data;
data = (guchar *) g_variant_get_fixed_array (gv, &size, sizeof (guchar));
return scheme_make_sized_byte_string ((char *) data, size, 1);
} // if it's an array of bytes
// ** Handle the compound types **
// Tuple or Array
if ( (g_variant_type_is_tuple (type))
|| (g_variant_type_is_array (type)) )
{
// Find out how many values to put into the list.
len = g_variant_n_children (gv);
// Here, we are referring to stuff across allocating calls, so we
// need to be careful.
MZ_GC_DECL_REG (2);
MZ_GC_VAR_IN_REG (0, lst);
MZ_GC_VAR_IN_REG (1, sval);
MZ_GC_REG ();
// Start with the empty list.
lst = scheme_null;
// Step through the items, right to left, adding them to the list.
for (i = len-1; i >= 0; i--)
{
sval = g_variant_to_scheme_object (g_variant_get_child_value (gv, i));
lst = scheme_make_pair (sval, lst);
} // for
// Okay, we've made it through the list, now we can clean up.
MZ_GC_UNREG ();
if ((g_variant_type_is_array (type)))
{
//If type is array, convert to vector
scheme_list_to_vector ((char*)lst);
}//If array
// And we're done.
return lst;
} // if it's a tuple or an array
// Unknown. Give up.
scheme_signal_error ("Unknown type %s", typestring);
return scheme_void;
} // g_variant_to_scheme_object
/**
* Convert a GVariant to a Scheme object. Returns NULL if there's a
* problem.
*/
static Scheme_Object *
g_variant_to_scheme_object (GVariant *gv)
{
const GVariantType *type; // The type of the GVariant
int i; // A counter variable
int len; // Length of arrays and tuples
Scheme_Object *lst = NULL; // A list that we build as a result
Scheme_Object *sval = NULL; // One value
Scheme_Object *result = NULL; // One result to return.
// Special case: We'll treat NULL as void.
if (gv == NULL)
{
return scheme_void;
} // if (gv == NULL)
// Get the type
type = g_variant_get_type (gv);
// ** Handle most of the basic types **
// Integer
if (g_variant_type_equal (type, G_VARIANT_TYPE_INT32))
{
// We don't refer to any Scheme objects across allocating calls,
// so no need for GC code.
int i;
i = g_variant_get_int32 (gv);
result = scheme_make_integer (i);
return result;
} // if it's an integer
// String
if (g_variant_type_equal (type, G_VARIANT_TYPE_STRING))
{
// We don't refer to any Scheme objects across allocating calls,
// so no need for GC code.
const gchar *str;
str = g_variant_get_string (gv, NULL);
result = scheme_make_locale_string (str);
return result;
} // if it's a string
// ** Handle the compound types **
// Tuple or Array
if ( (g_variant_type_is_tuple (type))
|| (g_variant_type_is_array (type)) )
{
// Find out how many values to put into the list.
len = g_variant_n_children (gv);
// Here, we are referring to stuff across allocating calls, so we
// need to be careful.
MZ_GC_DECL_REG (2);
MZ_GC_VAR_IN_REG (0, lst);
MZ_GC_VAR_IN_REG (1, sval);
MZ_GC_REG ();
// Start with the empty list.
lst = scheme_null;
// Step through the items, right to left, adding them to the list.
for (i = len-1; i >= 0; i--)
{
sval = g_variant_to_scheme_object (g_variant_get_child_value (gv, i));
lst = scheme_make_pair (sval, lst);
} // for
// Okay, we've made it through the list, now we can clean up.
MZ_GC_UNREG ();
// And we're done.
return lst;
} // if it's a tuple or an array
// Unknown. Give up.
return NULL;
} // g_variant_to_scheme_object
