/**
* Given some kind of Scheme string value, convert it to a C string
* If scmval is not a string value, returns NULL.
*/
static char *
scheme_object_to_string (Scheme_Object *scmval)
{
char *str = NULL;
// Char strings are the normal Scheme strings. They need to be
// converted to byte strings.
if (SCHEME_CHAR_STRINGP (scmval))
{
scmval = scheme_char_string_to_byte_string_locale (scmval);
str = SCHEME_BYTE_STR_VAL (scmval);
} // if it's a char string
// Byte strings are easy, but not the typical Scheme strings.
else if (SCHEME_BYTE_STRINGP (scmval))
{
str = SCHEME_BYTE_STR_VAL (scmval);
} // if it's a byte string
// A design decision: We'll treat symbols as strings. (It certainly
// makes things easier for the client.)
else if (SCHEME_SYMBOLP (scmval))
{
str = SCHEME_SYM_VAL (scmval);
} // if it's a symbol
// Everything else is not a string
else
{
// Signal an error by setting the return value to NULL.
str = NULL;
} // if it's not a string
return str;
} // scheme_object_to_string
/**
* Convert a Scheme_Object to a string. Returns NULL if it fails.
*/
char *
tostring (Scheme_Object *obj)
{
if (SCHEME_BYTE_STRINGP (obj))
return SCHEME_BYTE_STR_VAL (obj);
else if (SCHEME_CHAR_STRINGP (obj))
return SCHEME_BYTE_STR_VAL (scheme_char_string_to_byte_string (obj));
else
return NULL;
} // tostring
/**
* Convert a Scheme_Object to a string. Returns NULL if it fails.
*/
char *
tostring (Scheme_Object *obj)
{
if (SCHEME_BYTE_STRINGP (obj))
return SCHEME_BYTE_STR_VAL (obj);
else if (SCHEME_CHAR_STRINGP (obj))
// (scheme_char_string_to_byte_string) to be able to convert it to byte string
return SCHEME_BYTE_STR_VAL (scheme_char_string_to_byte_string (obj));
else
return NULL;
} // tostring
static Scheme_Object *fromull(int argc, Scheme_Object **argv)
{
umzlonglong l;
if (!SCHEME_BYTE_STRINGP(argv[0])
|| (SCHEME_BYTE_STRTAG_VAL(argv[0]) != sizeof(umzlonglong)))
scheme_wrong_type("unsigned-long-long-bytes->integer",
"byte string of mzlonglong size",
0, argc, argv);
l = *(umzlonglong *)SCHEME_BYTE_STR_VAL(argv[0]);
return scheme_make_integer_value_from_unsigned_long_long(l);
}
static Scheme_Object *
immutablep (int argc, Scheme_Object *argv[])
{
Scheme_Object *v = argv[0];
return ((!SCHEME_INTP(v)
&& SCHEME_IMMUTABLEP(v)
&& (SCHEME_PAIRP(v)
|| SCHEME_VECTORP(v)
|| SCHEME_BYTE_STRINGP(v)
|| SCHEME_CHAR_STRINGP(v)
|| SCHEME_BOXP(v)))
? scheme_true
: scheme_false);
}
/**
* Determine whether we can convert a Scheme_Object to a string.
*/
int
stringp (Scheme_Object *obj)
{
return SCHEME_BYTE_STRINGP (obj) || SCHEME_CHAR_STRINGP (obj);
} // stringp
/**
*Translating the scheme_object to gvariant type for the client
*This step is used on sending input values onto the DBus
*/
GVariant *
scheme_obj_to_gvariant (Scheme_Object *list)
{
GVariantBuilder *builder;
GVariant *finalr;
GVariant *rvalue = NULL;
Scheme_Object *firstelement;
int length = 0;
gint32 i;
char* rstring;
double rdouble;
builder = g_variant_builder_new(G_VARIANT_TYPE_TUPLE);
length = scheme_list_length (list);
// rvalue = g_new(GVariant *, length);
if (length == 0)
{
// scheme_signal_error("length 0");
return rvalue ;
} // if
else{
while (length != 0)
{
// Get the first element of the argument
firstelement = scheme_car (list);
list = scheme_cdr(list);
length = scheme_list_length(list);
// checking the scheme_type to see whether it is an integer or not
// Eventually see if we can convert this to a switch statement.
if (SCHEME_INTP (firstelement))
{
// we saved the return value at &i
i = SCHEME_INT_VAL(firstelement);
rvalue = g_variant_new ("i",i);
g_variant_builder_add_value(builder,rvalue);
// return rvalue;
} // if it's an integer
else if (SCHEME_BYTE_STRINGP (firstelement)|| SCHEME_CHAR_STRINGP(firstelement))
{
//scheme_signal_error ("We are in Character");
//getting the string out of the scheme_object
rstring = SCHEME_BYTE_STR_VAL(list);
// we will convert it to g_variant
rvalue = g_variant_new ("(&s)", rstring);
g_variant_builder_add_value(builder, rvalue);
} // if it's a character
else if (SCHEME_TYPE (firstelement) == scheme_double_type)
{
//getting the double out of the scheme_object
rdouble = scheme_real_to_double(list);
// we will convert it to g_variant
rvalue = g_variant_new_double(rdouble);
g_variant_builder_add_value(builder, rvalue);
} // if it's a double
} // while loop
finalr = g_variant_builder_end (builder);
return finalr;
} //else
return finalr;
} // scheme_obj_to_gvariant
/**
* 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
