Scheme_Object *scheme_eval_compiled_sized_string(const char *str, int len, Scheme_Env *env)
{
Scheme_Object *port, *expr;
Scheme_Config *config;
config = scheme_current_config();
port = scheme_make_sized_byte_string_input_port(str, -len); /* negative means it's constant */
if (!env)
env = scheme_get_env(NULL);
expr = scheme_internal_read(port, NULL, 1, 1, 0, 0, -1, NULL);
return _scheme_eval_compiled(expr, env);
}
Scheme_Object *scheme_eval_compiled_sized_string_with_magic(const char *str, int len, Scheme_Env *env,
Scheme_Object *magic_sym, Scheme_Object *magic_val,
int multi_ok)
{
Scheme_Object *port, *expr;
port = scheme_make_sized_byte_string_input_port(str, -len); /* negative means it's constant */
if (!env)
env = scheme_get_env(NULL);
expr = scheme_internal_read(port, NULL, 1, 1, 0, 0, -1, NULL,
magic_sym, magic_val,
NULL);
if (multi_ok)
return _scheme_eval_compiled_multi(expr, env);
else
return _scheme_eval_compiled(expr, env);
}
/**
* 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
static Scheme_Object *do_eval(void *s, int noargc, Scheme_Object **noargv)
{
return scheme_eval_string((char *)s, scheme_get_env(NULL));
}