/**
* A general call. Parameters are
* 0: The LouDBusProxy
* 1: The method name (string)
* others: Parameters to the method
*/
Scheme_Object *
loudbus_call (int argc, Scheme_Object **argv)
{
LouDBusProxy *proxy;
gchar *name;
// I don't think that I need to add annotations for garbage collection
// because scheme_object_to_string is the only allocating call, and we've
// dealt with all the other Scheme objects by the time we call it.
proxy = scheme_object_to_proxy (argv[0]);
name = scheme_object_to_string (argv[1]);
// Sanity checks
if (proxy == NULL)
{
scheme_wrong_type ("loudbus-call", "LouDBusProxy *", 0, argc, argv);
} // if we could not get the proxy
if (name == NULL)
{
scheme_wrong_type ("loudbus-call", "string", 1, argc, argv);
} // if we could not get the name
// Permit the use of dashes
score_it_all (name);
return dbus_call_kernel (proxy, name, name, argc-2, argv+2);
} // loudbus_call
/**
* Call a function, using the proxy, function name, and external name
* stored in prim.
*
* argc/argv give the parameters for the function call.
*/
Scheme_Object *
loudbus_call_with_closure (int argc, Scheme_Object **argv, Scheme_Object *prim)
{
Scheme_Object *wrapped_proxy = NULL;
Scheme_Object *wrapped_dbus_name = NULL;
Scheme_Object *wrapped_external_name = NULL;
Scheme_Object *result = NULL;
LouDBusProxy *proxy = NULL;
gchar *dbus_name;
gchar *external_name;
// Probably too many things are annotated here, but better safe than
// sorry.
MZ_GC_DECL_REG (5);
MZ_GC_VAR_IN_REG (0, argv);
MZ_GC_VAR_IN_REG (1, prim);
MZ_GC_VAR_IN_REG (2, wrapped_proxy);
MZ_GC_VAR_IN_REG (3, wrapped_dbus_name);
MZ_GC_VAR_IN_REG (4, wrapped_external_name);
MZ_GC_REG ();
// Extract information from the closure.
wrapped_proxy = SCHEME_PRIM_CLOSURE_ELS (prim)[0];
wrapped_dbus_name = SCHEME_PRIM_CLOSURE_ELS (prim)[1];
wrapped_external_name = SCHEME_PRIM_CLOSURE_ELS (prim)[2];
dbus_name = scheme_object_to_string (wrapped_dbus_name);
external_name = scheme_object_to_string (wrapped_external_name);
proxy = scheme_object_to_proxy (wrapped_proxy);
// Sanity check
if (proxy == NULL)
{
MZ_GC_UNREG ();
scheme_signal_error ("Could not obtain proxy to call %s.\n",
external_name);
} // if (proxy == NULL)
// And do the dirty work
result = dbus_call_kernel (proxy,
dbus_name, external_name,
argc, argv);
MZ_GC_UNREG ();
return result;
} // loudbus_call_with_closure
/**
* Convert a Scheme object to a GVariant that will serve as one of
* the parameters of a call go g_dbus_proxy_call_.... Returns NULL
* if it is unable to do the conversion.
*/
static GVariant *
scheme_object_to_parameter (Scheme_Object *obj, gchar *type)
{
gchar *str; // A temporary string
switch (type[0])
{
// Arrays
case 'a':
return scheme_object_to_array (obj, type);
// Doubles
case 'd':
if (SCHEME_DBLP (obj))
return g_variant_new ("d", SCHEME_DBL_VAL (obj));
else if (SCHEME_FLTP (obj))
return g_variant_new ("d", (double) SCHEME_FLT_VAL (obj));
else if (SCHEME_INTP (obj))
return g_variant_new ("d", (double) SCHEME_INT_VAL (obj));
else
return NULL;
// 32 bit integers
case 'i':
if (SCHEME_INTP (obj))
return g_variant_new ("i", (int) SCHEME_INT_VAL (obj));
else if (SCHEME_DBLP (obj))
return g_variant_new ("i", (int) SCHEME_DBL_VAL (obj));
else
return NULL;
// Strings
case 's':
str = scheme_object_to_string (obj);
if (str == NULL)
return NULL;
return g_variant_new ("s", str);
// 32 bit unsigned integers
case 'u':
if (SCHEME_INTP (obj))
return g_variant_new ("u", (unsigned int) SCHEME_INT_VAL (obj));
else
return NULL;
// Everything else is currently unsupported
default:
return NULL;
} // switch
} // scheme_object_to_parameter
/**
* 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
/**
* Convert a Scheme object to a GVariant that will serve as one of
* the parameters of a call go g_dbus_proxy_call_.... Returns NULL
* if it is unable to do the conversion.
*/
static GVariant *
scheme_object_to_parameter (Scheme_Object *obj, gchar *type)
{
gchar *str; // A temporary string
// Special case: Array of bytes
if (g_strcmp0 (type, "ay") == 0)
{
if (SCHEME_BYTE_STRINGP (obj))
{
return g_variant_new_fixed_array (G_VARIANT_TYPE_BYTE,
SCHEME_BYTE_STR_VAL (obj),
SCHEME_BYTE_STRLEN_VAL (obj),
sizeof (guchar));
} // if it's a byte string
} // array of bytes
// Handle normal cases
switch (type[0])
{
// Arrays
case 'a':
return scheme_object_to_array (obj, type);
// Doubles
case 'd':
if (SCHEME_DBLP (obj))
return g_variant_new ("d", SCHEME_DBL_VAL (obj));
else if (SCHEME_FLTP (obj))
return g_variant_new ("d", (double) SCHEME_FLT_VAL (obj));
else if (SCHEME_INTP (obj))
return g_variant_new ("d", (double) SCHEME_INT_VAL (obj));
else if (SCHEME_RATIONALP (obj))
return g_variant_new ("d", (double) scheme_rational_to_double (obj));
else
return NULL;
// 32 bit integers
case 'i':
if (SCHEME_INTP (obj))
return g_variant_new ("i", (int) SCHEME_INT_VAL (obj));
else if (SCHEME_DBLP (obj))
return g_variant_new ("i", (int) SCHEME_DBL_VAL (obj));
else if (SCHEME_FLTP (obj))
return g_variant_new ("i", (int) SCHEME_FLT_VAL (obj));
else if (SCHEME_RATIONALP (obj))
return g_variant_new ("i", (int) scheme_rational_to_double (obj));
else
return NULL;
// Strings
case 's':
str = scheme_object_to_string (obj);
if (str == NULL)
return NULL;
return g_variant_new ("s", str);
// 32 bit unsigned integers
case 'u':
if (SCHEME_INTP (obj))
return g_variant_new ("u", (unsigned int) SCHEME_INT_VAL (obj));
else
return NULL;
// Everything else is currently unsupported
default:
return NULL;
} // switch
} // scheme_object_to_parameter
/**
* Create a new proxy.
*/
static Scheme_Object *
loudbus_proxy (int argc, Scheme_Object **argv)
{
gchar *service = NULL; // A string giving the service
gchar *path = NULL; // A string giving the path to the object
gchar *interface = NULL; // A string giving the interface
LouDBusProxy *proxy = NULL; // The proxy we build
Scheme_Object *result = NULL; // The proxy wrapped as a Scheme object
GError *error = NULL; // A place to hold errors
service = scheme_object_to_string (argv[0]);
// Annotations for garbage collection
MZ_GC_DECL_REG (5);
MZ_GC_VAR_IN_REG (0, argv);
MZ_GC_VAR_IN_REG (1, service);
MZ_GC_VAR_IN_REG (2, path);
MZ_GC_VAR_IN_REG (3, interface);
MZ_GC_VAR_IN_REG (4, result);
MZ_GC_REG ();
// Extract parameters
service = scheme_object_to_string (argv[0]);
path = scheme_object_to_string (argv[1]);
interface = scheme_object_to_string (argv[2]);
// Check parameters
if (service == NULL)
{
MZ_GC_UNREG ();
scheme_wrong_type ("loudbus-proxy", "string", 0, argc, argv);
}
if (path == NULL)
{
MZ_GC_UNREG ();
scheme_wrong_type ("loudbus-proxy", "string", 1, argc, argv);
}
if (interface == NULL)
{
MZ_GC_UNREG ();
scheme_wrong_type ("loudbus-proxy", "string", 2, argc, argv);
}
// Do the actual work in building the proxy.
proxy = loudbus_proxy_new (service, path, interface, &error);
if (proxy == NULL)
{
if (error == NULL)
{
MZ_GC_UNREG ();
scheme_signal_error ("loudbus-proxy: "
"Could not create proxy for an unknown reason.");
}
else
{
MZ_GC_UNREG ();
scheme_signal_error ("loudbus-proxy: "
"Could not create proxy because %s",
error->message);
}
} // if (proxy == NULL)
// Wrap the proxy into a Scheme type
result = scheme_make_cptr (proxy, LOUDBUS_PROXY_TAG);
// Log info during development
LOG ("loudbus_proxy: Built proxy %p, Scheme object %p", proxy, result);
// Find out information on what we just built.
SCHEME_LOG ("result is", result);
SCHEME_LOG ("result type is", SCHEME_CPTR_TYPE (result));
// Register the finalizer
scheme_register_finalizer (result, loudbus_proxy_finalize, NULL, NULL, NULL);
// And we're done
MZ_GC_UNREG ();
return result;
} // loudbus_proxy
/**
* 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
/**
* Import all of the methods from a LouDBusProxy.
*/
Scheme_Object *
loudbus_import (int argc, Scheme_Object **argv)
{
Scheme_Env *env = NULL; // The environment
GDBusMethodInfo *method; // Information on one method
LouDBusProxy *proxy; // The proxy
int m; // Counter variable for methods
int n; // The total number of methods
int arity; // The arity of a method
gchar *prefix = NULL; // The prefix we use
gchar *external_name; // The name we use in Scheme
int dashes; // Convert underscores to dashes?
// Annotations and other stuff for garbage collection.
MZ_GC_DECL_REG (3);
MZ_GC_VAR_IN_REG (0, argv);
MZ_GC_VAR_IN_REG (1, env);
MZ_GC_VAR_IN_REG (2, prefix);
MZ_GC_REG ();
// Get the proxy
proxy = scheme_object_to_proxy (argv[0]);
if (proxy == NULL)
{
MZ_GC_UNREG ();
scheme_wrong_type ("loudbus-import", "LouDBusProxy *", 0, argc, argv);
} // if (proxy == NULL)
// Get the prefix
prefix = scheme_object_to_string (argv[1]);
if (prefix == NULL)
{
MZ_GC_UNREG ();
scheme_wrong_type ("loudbus-import", "string", 1, argc, argv);
} // if (prefix == NULL)
// Get the flag
if (! SCHEME_BOOLP (argv[2]))
{
MZ_GC_UNREG ();
scheme_wrong_type ("loudbus-import", "Boolean", 2, argc, argv);
} // if (!SCHEME_BOOLB (argv[2])
dashes = SCHEME_TRUEP (argv[2]);
// Get the current environment, since we're mutating it.
env = scheme_get_env (scheme_current_config ());
// Process the methods
n = g_dbus_interface_info_num_methods (proxy->iinfo);
for (m = 0; m < n; m++)
{
method = proxy->iinfo->methods[m];
arity = g_dbus_method_info_num_formals (method);
external_name = g_strdup_printf ("%s%s", prefix, method->name);
if (external_name != NULL)
{
if (dashes)
{
dash_it_all (external_name);
} // if (dashes)
// And add the procedure
LOG ("loudbus-import: adding %s as %s", method->name, external_name);
loudbus_add_dbus_proc (env, argv[0],
method->name, external_name,
arity);
// Clean up
g_free (external_name);
} // if (external_name != NULL)
} // for each method
// And we're done.
MZ_GC_UNREG ();
return scheme_void;
} // loudbus_import