static SCM
gfec_string_inner_handler(void *data, SCM key, SCM args)
{
char *str = (char*)data;
SCM scm_string = scm_internal_catch(SCM_BOOL_T,
gfec_string_from_locale, (void*)str,
gfec_string_inner_handler,
(void*)str);
return scm_string;
}
SCM
weechat_guile_catch (void *procedure, void *data)
{
SCM value;
value = scm_internal_catch (SCM_BOOL_T,
(scm_t_catch_body)procedure,
data,
(scm_t_catch_handler) scm_handle_by_message_noexit,
NULL);
return value;
}
SCM
gfec_eval_string(const char *str, gfec_error_handler error_handler)
{
SCM result = SCM_UNDEFINED;
SCM func = scm_c_eval_string("gnc:eval-string-with-error-handling");
if (scm_is_procedure(func))
{
char *err_msg = NULL;
SCM call_result, error = SCM_UNDEFINED;
/* Deal with the possibility that scm_from_utf8_string will
* throw, falling back to scm_from_locale_string. If that fails, log a
* warning and punt.
*/
SCM scm_string = scm_internal_catch(SCM_BOOL_T,
gfec_string_from_utf8, (void*)str,
gfec_string_inner_handler,
(void*)str);
if (!scm_string)
{
error_handler("Contents could not be interpreted as UTF-8 or the current locale/codepage.");
return result;
}
call_result = scm_call_1 (func, scm_string);
error = scm_list_ref (call_result, scm_from_uint (1));
if (scm_is_true (error))
err_msg = gnc_scm_to_utf8_string (error);
else
result = scm_list_ref (call_result, scm_from_uint (0));
if (err_msg != NULL)
{
if (error_handler)
error_handler (err_msg);
free(err_msg);
}
}
return result;
}
SCM Scm::protect(scm_t_catch_body body, void *body_data) {
return scm_internal_catch (SCM_BOOL_T,
body, body_data,
scm_handle_by_message_noexit, NULL);
}
static
void*
func_op(const char *fname, int argc, void **argv)
{
SCM scmFn, scmArgs, scmTmp;
int i;
var_store *vs;
gchar *str;
gnc_numeric n, *result;
GString *realFnName;
realFnName = g_string_sized_new( strlen(fname) + 5 );
g_string_printf( realFnName, "gnc:%s", fname );
scmFn = scm_internal_catch(SCM_BOOL_T,
(scm_t_catch_body)scm_c_eval_string, realFnName->str,
scm_handle_by_message_noexit, NULL);
g_string_free( realFnName, TRUE );
if (!scm_is_procedure(scmFn))
{
/* FIXME: handle errors correctly. */
printf( "gnc:\"%s\" is not a scm procedure\n", fname );
return NULL;
}
scmArgs = scm_listify( SCM_UNDEFINED );
for ( i = 0; i < argc; i++ )
{
/* cons together back-to-front. */
vs = (var_store*)argv[argc - i - 1];
switch ( vs->type )
{
case VST_NUMERIC:
n = *(gnc_numeric*)(vs->value);
scmTmp = scm_make_real( gnc_numeric_to_double( n ) );
break;
case VST_STRING:
str = (char*)(vs->value);
scmTmp = scm_mem2string( str, strlen(str) );
break;
default:
/* FIXME: error */
printf( "argument %d not a numeric or string [type = %d]\n",
i, vs->type );
return NULL;
break; /* notreached */
}
scmArgs = scm_cons( scmTmp, scmArgs );
}
//scmTmp = scm_apply(scmFn, scmArgs , SCM_EOL);
scmTmp = gfec_apply(scmFn, scmArgs, _exception_handler);
if (_function_evaluation_error_msg != NULL)
{
PERR("function eval error: [%s]\n", _function_evaluation_error_msg);
_function_evaluation_error_msg = NULL;
return NULL;
}
result = g_new0( gnc_numeric, 1 );
*result = double_to_gnc_numeric( scm_num2dbl(scmTmp, G_STRFUNC),
GNC_DENOM_AUTO,
GNC_HOW_DENOM_SIGFIGS(6) | GNC_HOW_RND_ROUND );
/* FIXME: cleanup scmArgs = scm_list, cons'ed cells? */
return (void*)result;
}
