/*! \brief Evaluate a Scheme expression safely.
* \par Function Description
*
* Often a libgeda program (or libgeda itself) will need to call out
* to Scheme code, for example to load a Scheme configuration file.
* If an error or exception caused by such code goes uncaught, it
* locks up the Scheme interpreter, stopping any further Scheme code
* from being run until the program is restarted.
*
* This function is equivalent to scm_eval (), with the important
* difference that any errors or exceptions caused by the evaluated
* expression \a exp are caught and reported via the libgeda logging
* mechanism. If an error occurs during evaluation, this function
* returns SCM_BOOL_F. If \a module_or_state is undefined, uses the
* current interaction environment.
*
* \param exp Expression to evaluate
* \param module_or_state Environment in which to evaluate \a exp
*
* \returns Evaluation results or SCM_BOOL_F if exception caught.
*/
SCM g_scm_eval_protected (SCM exp, SCM module_or_state)
{
SCM stack = SCM_BOOL_T;
SCM body_data;
SCM result;
if (module_or_state == SCM_UNDEFINED) {
body_data = scm_list_2 (exp, scm_interaction_environment ());
} else {
body_data = scm_list_2 (exp, module_or_state);
}
result = scm_c_catch (SCM_BOOL_T,
protected_body_eval, /* catch body */
&body_data, /* body data */
protected_post_unwind_handler, /* post handler */
&stack, /* post data */
protected_pre_unwind_handler, /* pre handler */
&stack /* pre data */
);
scm_remember_upto_here_2 (body_data, stack);
return result;
}
bool call_guile_keypress(char key, bool ctrl, bool mod1) {
return scm_to_bool (scm_eval (scm_list_n (scm_from_locale_symbol ("on-key-press"),
scm_from_char(key),
scm_from_bool(ctrl),
scm_from_bool(mod1),
SCM_UNDEFINED
), scm_interaction_environment()));
}
bool call_guile_buttonpress(unsigned int button, bool ctrl, int x, int y) {
return scm_to_bool (scm_eval (scm_list_n (scm_from_locale_symbol ("on-button-press"),
scm_from_int(button),
scm_from_bool(ctrl),
scm_from_int(x),
scm_from_int(y),
SCM_UNDEFINED
), scm_interaction_environment()));
}
/*! \brief Runs a object hook with a single OBJECT.
* \par Function Description
* Runs a hook called \a name, which should expect a list of #OBJECT
* smobs as its argument, with a single-element list containing only \a obj.
*
* \see g_run_hook_object_list()
*
* \param name name of hook to run.
* \param obj #OBJECT argument for hook.
*/
void
g_run_hook_object (GschemToplevel *w_current, const char *name, OBJECT *obj)
{
scm_dynwind_begin (0);
g_dynwind_window (w_current);
SCM expr = scm_list_3 (run_hook_sym,
g_get_hook_by_name (name),
scm_list_2 (list_sym, edascm_from_object (obj)));
g_scm_eval_protected (expr, scm_interaction_environment ());
scm_dynwind_end ();
scm_remember_upto_here_1 (expr);
}
void run_hook(const char *hook_name, SCM args)
{
SCM hook_symb = scm_from_utf8_symbol(hook_name);
SCM hook = scm_eval(hook_symb, scm_interaction_environment());
if (scm_is_false(scm_defined_p(hook_symb, SCM_UNDEFINED))) {
fprintf(stderr, "error: %s undefined\n", hook_name);
return;
}
else if (scm_is_false(scm_hook_p(hook))) {
fprintf(stderr, "error: %s is not a hook!\n", hook_name);
return;
}
if (scm_is_false(scm_hook_empty_p(hook)))
scm_run_hook(hook, args);
}
/*! \brief Runs a object hook for a list of objects.
* \par Function Description
* Runs a hook called \a name, which should expect a list of #OBJECT
* smobs as its argument, with \a obj_lst as the argument list.
*
* \see g_run_hook_object()
*
* \param name name of hook to run.
* \param obj_lst list of #OBJECT smobs as hook argument.
*/
void
g_run_hook_object_list (GschemToplevel *w_current, const char *name,
GList *obj_lst)
{
SCM lst = SCM_EOL;
GList *iter;
scm_dynwind_begin (0);
g_dynwind_window (w_current);
for (iter = obj_lst; iter != NULL; iter = g_list_next (iter)) {
lst = scm_cons (edascm_from_object ((OBJECT *) iter->data), lst);
}
SCM expr = scm_list_3 (run_hook_sym,
g_get_hook_by_name (name),
scm_cons (list_sym,
scm_reverse_x (lst, SCM_EOL)));
g_scm_eval_protected (expr, scm_interaction_environment ());
scm_dynwind_end ();
scm_remember_upto_here_1 (expr);
}
