/**
* Add one of the procedures that the proxy provides on the D-Bus.
*/
static void
loudbus_add_dbus_proc (Scheme_Env *env,
Scheme_Object *proxy,
gchar *dbus_name,
gchar *external_name,
int arity)
{
Scheme_Object *vals[3];
Scheme_Object *proc;
vals[0] = NULL;
vals[1] = NULL;
vals[2] = NULL;
// Prepare for potential garbage collection during allocating calls
// (e.g., scheme_make_locale_string).
MZ_GC_DECL_REG (3);
MZ_GC_VAR_IN_REG (0, vals[0]);
MZ_GC_VAR_IN_REG (1, vals[1]);
MZ_GC_VAR_IN_REG (2, vals[2]);
MZ_GC_REG ();
// Fill in the closure with the object.
vals[0] = proxy;
vals[1] = scheme_make_locale_string (dbus_name);
vals[2] = scheme_make_locale_string (external_name);
// Build the procedure. Note that we need to duplicate the
// external name because scheme_make_prim_closure_w_arity seems
// to retain a pointer to the string. (At least, it seems that way
// to me.)
proc = scheme_make_prim_closure_w_arity (loudbus_call_with_closure,
3, vals,
g_strdup (external_name),
arity, arity);
// And add it to the environment.
scheme_add_global (external_name, proc, env);
// And update the GC info.
MZ_GC_UNREG ();
} // loudbus_add_dbus_proc
/**
* Get all of the methods from a louDBus Proxy.
*/
Scheme_Object *
loudbus_methods (int argc, Scheme_Object **argv)
{
Scheme_Object *result = NULL; // The result we're building
Scheme_Object *val = NULL; // One method in the result
GDBusMethodInfo *method; // Information on one method
LouDBusProxy *proxy; // The proxy
int m; // Counter variable for methods
MZ_GC_DECL_REG (2);
MZ_GC_VAR_IN_REG (0, result);
MZ_GC_VAR_IN_REG (1, val);
// Get the proxy
proxy = scheme_object_to_proxy (argv[0]);
if (proxy == NULL)
{
scheme_wrong_type ("loudbus-methods", "LouDBusProxy *", 0, argc, argv);
} // if proxy == NULL
MZ_GC_REG ();
// Build the list.
result = scheme_null;
for (m = g_dbus_interface_info_num_methods (proxy->iinfo) - 1; m >= 0; m--)
{
method = proxy->iinfo->methods[m];
val = scheme_make_locale_string (method->name);
result = scheme_make_pair (val, result);
} // for each method
MZ_GC_UNREG ();
// And we're done.
return result;
} // loudbus_methods
/**
*Translating the gvariant to Scheme Object
*/
Scheme_Object *
gvariant_to_schemeobj (GVariant *ivalue)
{
gint32 i;
GVariant *temp;
const gchar *fstring;
gsize length = 0;
gsize size = 0;
gint32 r1 = 0;
gdouble r2 = 0;
Scheme_Object *fint;
Scheme_Object *fstringss;
Scheme_Object *fdouble;
Scheme_Object *sflist = NULL;
gchar *tmp;
//scheme_signal_error ("Not tuple yet");
tmp = g_variant_print (ivalue, FALSE);
fprintf (stderr, "gvariant_to_schemobj(%s)\n", tmp);
g_free (tmp);
size = g_variant_get_size (ivalue);
// fprintf (stderr, "Exploring the return value.\n");
/* if (ivalue == NULL)
{
fprintf (stderr, "Return value is <NULL>\n");
} // if (ivalue == NULL)
else // if (ivalue != NULL)
{
type = g_variant_get_type (ivalue);
typestring = g_variant_type_dup_string (type);
fprintf (stderr, "Got type %s\n", typestring);
g_free (typestring);
description = g_variant_print (ivalue, TRUE);
fprintf (stderr, "Got value %s\n", description);
g_free (description);
} // if (ivalue != NULL)*/
if (ivalue == NULL)
{
return scheme_void;
}
if (g_variant_is_of_type (ivalue, G_VARIANT_TYPE_INT32))
{
r1 = g_variant_get_int32 (ivalue);
fint = scheme_make_integer_value(r1);
return fint;
}// else if
else if (g_variant_is_of_type (ivalue, G_VARIANT_TYPE_STRING))
{
fprintf ( stderr, "Type_string\n");
// scheme_signal_error ("%d", size);
fstring = g_variant_get_string(ivalue, &size);
fstringss = scheme_make_locale_string(fstring);
return fstringss;
}// else if
else if (g_variant_is_of_type (ivalue, G_VARIANT_TYPE_BYTESTRING))
{
fprintf (stderr, "Bytestring\n");
scheme_signal_error("stringbyeerror");
fstring = g_variant_get_bytestring (ivalue);
fstringss = scheme_make_locale_string(fstring);
return fstringss;
}// else if
else if (g_variant_is_of_type (ivalue, G_VARIANT_TYPE_DOUBLE))
{
r2 = g_variant_get_double (ivalue);
fdouble = scheme_make_double (r2);
return fdouble;
}// else if
else if (g_variant_is_of_type (ivalue, G_VARIANT_TYPE_TUPLE))
{
int i;
Scheme_Object *result; // The list we're building
Scheme_Object *element; // One element of that list
fprintf (stderr, "Handling a tuple.\n");
result = scheme_null;
for (i = g_variant_n_children (ivalue) - 1; i >= 0; i--)
{
fprintf (stderr, "Handling child %d\n", i);
element = gvariant_to_schemeobj (g_variant_get_child_value (ivalue, i));
result = scheme_make_pair (element, result);
} // for
return result;
} // if it's a tuple
// Default. Give up
else
{
scheme_signal_error ("could not convert type");
} // default
} //gvariant_to_schemeobj
/**
* 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
/**
* Get information on one method (annotations, parameters, return
* values, etc).
*
* TODO:
* 1. Add missing documentation (see ????)
* 2. Check to make sure that the second parameter is a string. (Also
* do other error checking. See below.)
* 3. Make sure that you get annotations for parameters and return
* values (if they exist).
* 4. Add tags for the other parts of the record (if they aren't
* there already). For example, something like
* '((name gimp_image_new)
* (annotations "...")
* (inputs (width integer "width of image"))
* (outputs (image integer "id of created image")))
* If you'd prefer, input and output could also have their own
* tags.
* (inputs ((name width) (type integer) (annotations "width of image")))
* 5. Add a function to louDBus/unsafe that pretty prints this.
* (If you'd prefer, you can add it to this file. But you can't
* use printf to pretty print.)
* 6. Add information for the garbage collector. (Yup, you'll need to
* read really bad documentation on this. But try.)
*/
static Scheme_Object *
loudbus_method_info (int argc, Scheme_Object **argv)
{
Scheme_Object *val, *val2; // ????
Scheme_Object *result = NULL; // The result we're building
Scheme_Object *arglist = NULL; // The list of arguments
Scheme_Object *outarglist = NULL; // The list of return values
Scheme_Object *annolist = NULL; // The list of annotations
Scheme_Object *name = NULL; // The method's name
Scheme_Object *parampair = NULL; // ????
Scheme_Object *outparampair = NULL; // ????
GDBusMethodInfo *method; // Information on one method
GDBusAnnotationInfo *anno; // Information on the annotations
GDBusArgInfo *args, *outargs; // Information on the arguments
LouDBusProxy *proxy; // The proxy
gchar *methodName; // The method name
int m; // Counter variable for methods
// Get the proxy
proxy = scheme_object_to_proxy (argv[0]);
if (proxy == NULL)
{
scheme_wrong_type ("loudbus-methods", "LouDBusProxy *", 0, argc, argv);
} // if proxy == NULL
//Get the method name. WHAT IF WE CAN'T CONVERT TO A STRING????
methodName = scheme_object_to_string (argv[1]);
// Permit the use of dashes in method names by converting them back
// to underscores (which is what we use over DBus).
score_it_all (methodName);
//Get the method struct. WHAT IF THE METHOD DOESN'T EXIST????
method = g_dbus_interface_info_lookup_method (proxy->iinfo, methodName);
// Build the list for arguments.
arglist = scheme_null;
for (m = parray_len ((gpointer *) method->in_args) - 1; m >= 0; m--)
{
args = method->in_args[m]; //Go through the arguments.
val = scheme_make_symbol (args->name);
val2 = scheme_make_symbol (args->signature);
parampair = scheme_make_pair (val, val2);
arglist = scheme_make_pair (parampair, arglist);
} // for each argument
//Build list for output.
outarglist = scheme_null;
for (m = parray_len ((gpointer *) method->out_args) - 1; m >= 0; m--)
{
outargs = method->out_args[m];
val = scheme_make_symbol (outargs->name);
val2 = scheme_make_symbol (outargs->signature);
outparampair = scheme_make_pair (val, val2);
outarglist = scheme_make_pair (outparampair, outarglist);
} // for each output formals
// Build list of annotations
annolist = scheme_null;
for (m = parray_len ((gpointer *) method->annotations) - 1; m >= 0; m--)
{
anno = method->annotations[m]; //Go through the annotations.
val = scheme_make_locale_string (anno->value);
annolist = scheme_make_pair (val, annolist);
} // for each annotation
// Create the name entry
name = scheme_null;
name = scheme_make_pair (scheme_make_symbol(methodName), name);
name = scheme_make_pair (scheme_make_symbol("name"), name);
result = scheme_null;
result = scheme_make_pair (annolist, result);
result = scheme_make_pair (outarglist, result);
result = scheme_make_pair (arglist, result);
result = scheme_make_pair (name, result);
// And we're done.
return result;
} // loudbus_method_info
/**
* 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
