static void
game_process_event (Game *game)
{
    static ALLEGRO_EVENT event;

    al_wait_for_event(game->event_queue, &event);

    if (event.type == ALLEGRO_EVENT_DISPLAY_CLOSE)
    {
	game->running = false;
    }
    else if (event.type == ALLEGRO_EVENT_TIMER)
    {
	game_update (game);
    }
    else if (event.type == ALLEGRO_EVENT_KEY_UP)
    {
	if (scm_is_true (game->on_key_released))
	{
	    scm_call_1 (game->on_key_released, scm_from_int (event.keyboard.keycode));
	}
    }
    else if (event.type == ALLEGRO_EVENT_KEY_DOWN)
    {
	if (scm_is_true (game->on_key_pressed))
	{
	    scm_call_1 (game->on_key_pressed, scm_from_int (event.keyboard.keycode));
	}
    }
}

/********************************************************************\
 * gnc_get_credit_string                                            *
 *   return a credit string for a given account type                *
 *                                                                  *
 * Args: account_type - type of account to get credit string for    *
 * Return: g_malloc'd credit string or NULL                         *
\********************************************************************/
char *
gnc_get_credit_string(GNCAccountType account_type)
{
    const gchar *string;
    SCM result;
    SCM arg;

    initialize_scm_functions();

    if (gnc_gconf_get_bool(GCONF_GENERAL, KEY_ACCOUNTING_LABELS, NULL))
        return g_strdup(_("Credit"));

    if ((account_type < ACCT_TYPE_NONE) || (account_type >= NUM_ACCOUNT_TYPES))
        account_type = ACCT_TYPE_NONE;

    arg = scm_long2num(account_type);

    result = scm_call_1(getters.credit_string, arg);
    if (!scm_is_string(result))
        return NULL;

    string = scm_to_locale_string(result);
    if (string)
        return g_strdup(string);
    return NULL;
}

static int servlet_run(lua_State *l)
{
  SCM run_ref = (SCM)lua_touserdata(l, lua_upvalueindex(1));
  SCM s = scm_from_pointer(l, NULL);
  scm_call_1(run_ref, s);
  return 0;
}

/*! \brief Get symbol data from a Scheme-based component source.
 *  \par Function Description
 *  Get symbol data from a Scheme-based component source.  The return
 *  value should be free()'d when no longer needed.
 *
 *  Private function used only in s_clib.c.
 *
 *  \param symbol Symbol to get data for.
 *  \return Allocated buffer containing symbol data.
 */
static gchar *get_data_scm (const CLibSymbol *symbol)
{
  SCM symdata;
  char *tmp;
  gchar *result;

  g_return_val_if_fail ((symbol != NULL), NULL);
  g_return_val_if_fail ((symbol->source->type == CLIB_SCM), NULL);

  symdata = scm_call_1 (symbol->source->get_fn,
			scm_from_utf8_string (symbol->name));

  if (!scm_is_string (symdata)) {
    s_log_message (_("Failed to load symbol data [%1$s] from source [%2$s]"),
                   symbol->name, symbol->source->name);
    return NULL;
  }

  /* Need to make sure that the correct free() function is called
   * on strings allocated by Guile. */
  tmp = scm_to_utf8_string (symdata);
  result = g_strdup(tmp);
  free (tmp);

  return result;
}

static SCM
scm_c_primitive_eval (SCM exp)
{
  if (!SCM_EXPANDED_P (exp))
    exp = scm_call_1 (scm_current_module_transformer (), exp);
  return eval (scm_memoize_expression (exp), SCM_BOOL_F);
}

/********************************************************************\
 * gnc_guile_call1_to_string                                        *
 *   returns the malloc'ed string returned by the guile function    *
 *   or NULL if it can't be retrieved                               *
 *                                                                  *
 * Args: func - the guile function to call                          *
 *       arg  - the single function argument                        *
 * Returns: g_malloc'ed char * or NULL                              *
\********************************************************************/
char *
gnc_guile_call1_to_string(SCM func, SCM arg)
{
    SCM value;

    if (scm_is_procedure(func))
    {
        value = scm_call_1(func, arg);

        if (scm_is_string(value))
        {
            return gnc_scm_to_locale_string(value);
        }
        else
        {
            PERR("bad value\n");
        }
    }
    else
    {
        PERR("not a procedure\n");
    }

    return NULL;
}

static SCM
scscm_call_1_body (void *argsp)
{
  SCM *args = argsp;

  return scm_call_1 (args[0], args[1]);
}

/********************************************************************\
 * gnc_is_trans_scm                                                 *
 *   returns true if the scm object is a scheme transaction         *
 *                                                                  *
 * Args: scm - a scheme object                                      *
 * Returns: true if scm is a scheme transaction                     *
\********************************************************************/
gboolean
gnc_is_trans_scm(SCM scm)
{
    initialize_scm_functions();

    return scm_is_true(scm_call_1(predicates.is_trans_scm, scm));
}

VISIBLE SCM
scm_gsl_errno_to_symbol (SCM errval)
{
  return
    scm_call_1 (scm_c_public_ref ("sortsmill math gsl", "gsl-errno->symbol"),
                errval);
}

static void ragnarok_go()
{
  SCM main = RAG_GET_FROM_MODULE("ragnarok main" ,"main");
  SCM args = scm_program_arguments();

  scm_call_1(main ,args);
}

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;
        call_result = scm_call_1 (func, scm_from_utf8_string (str));

        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;
}

static void
gnc_plugin_business_reload_module (const gchar *name)
{
    SCM file_scm;

    file_scm = scm_makfrom0str (name);
    scm_call_1(scm_c_eval_string("gnc:reload-module"), file_scm);
}

static SCM body_proc(void *data) {
	SCM obj;
	char *linebuf = (char *)data;
	obj = scm_c_eval_string(linebuf);
	if (obj == SCM_UNSPECIFIED) return SCM_BOOL_T;
	scm_call_1(console_display, obj);
	scm_remember_upto_here_1(obj);
	return SCM_BOOL_T;
	}

SCM
weechat_guile_scm_call_1 (void *proc)
{
    struct t_guile_function *guile_function;

    guile_function = (struct t_guile_function *)proc;

    return scm_call_1 (guile_function->proc, guile_function->args);
}

/***********************************************************
 * gnc_ui_custom_report_edit_name
 *
 * open the custom report dialog and highlight the given
 * report's name for editing.
 ***********************************************************/
void
gnc_ui_custom_report_edit_name (GncMainWindow * window, SCM scm_guid)
{
    SCM is_custom_report;
    CustomReportDialog *crd = gnc_ui_custom_report_internal (window);
    GtkTreeModel *model;
    GtkTreeIter iter;
    GncGUID *guid;
    gchar *guid_str;
    gboolean valid_iter;

    is_custom_report = scm_c_eval_string ("gnc:report-template-is-custom/template-guid?");
    if (scm_is_false (scm_call_1 (is_custom_report, scm_guid)))
        return;

    guid = guid_malloc ();
    guid_str = scm_to_utf8_string (scm_guid);
    if (!string_to_guid (guid_str, guid))
        goto cleanup;

    /* Look up the row for the requested guid */
    model = gtk_tree_view_get_model (GTK_TREE_VIEW (crd->reportview));
    valid_iter = gtk_tree_model_get_iter_first (model, &iter);

    while (valid_iter)
    {
        GValue value = { 0, };
        GncGUID *row_guid;
        gtk_tree_model_get_value (model, &iter, COL_NUM, &value);
        row_guid = (GncGUID *) g_value_get_pointer (&value);

        if (guid_equal (guid, row_guid))
        {
            /* We found the row for the requested guid
             * Now let's set the report's name cell in edit mode
             * so the user can edit the name.
             */
            GtkTreePath *path;
            GtkTreeSelection *selection = gtk_tree_view_get_selection (GTK_TREE_VIEW (crd->reportview));
            gtk_tree_selection_select_iter (selection, &iter);
            path = gtk_tree_model_get_path (model, &iter);
            g_object_set(G_OBJECT(crd->namerenderer), "editable", TRUE, NULL);
            gtk_tree_view_set_cursor_on_cell (GTK_TREE_VIEW (crd->reportview),
                                              path, crd->namecol,
                                              crd->namerenderer, TRUE);
            break;
        }

        g_value_unset (&value);
        valid_iter = gtk_tree_model_iter_next (model, &iter);
    }

cleanup:
    guid_free (guid);
}

static void
timeout_free (AvahiTimeout *timeout)
{
  (void) scm_call_1 (timeout->guile_poll->free_timeout,
		     timeout->timeout_smob);

  /* We don't free the C object here.  Instead, it will get freed eventually,
     when its Scheme representative gets GC'd.  */
  scm_gc_unprotect_object (timeout->timeout_smob);

  timeout->dead = 1;
}

static void
sf_write (SCM port, const void *data, size_t size)
{
  SCM p = SCM_PACK (SCM_STREAM (port));

  /* DATA is assumed to be a locale-encoded C string, which makes it
     hard to reliably pass binary data to a soft port.  It can be
     achieved by choosing a Latin-1 locale, though, but the recommended
     approach is to use an R6RS "custom binary output port" instead.  */
  scm_call_1 (SCM_SIMPLE_VECTOR_REF (p, 1),
	      scm_from_locale_stringn ((char *) data, size));
}

static SCM pg_each_row(SCM res, SCM func) {
	struct pg_res *pgr;
	scm_assert_smob_type(pg_res_tag, res);
	pgr = (struct pg_res *)SCM_SMOB_DATA(res);
	while (pgr->cursor < pgr->tuples) {
		scm_call_1(func, build_row(pgr));
		pgr->cursor++;
		}
	PQclear(pgr->res);
	pgr->res = NULL;
	scm_remember_upto_here_2(res, func);
	return SCM_UNSPECIFIED;
	}

static void
call_scm_hook_1 (GHook *hook, gpointer data)
{
    GncScmDangler *scm = hook->data;

    ENTER("hook %p, data %p, cbarg %p", hook, data, hook->data);

    // XXX: FIXME: We really should make sure this is a session!!! */
    scm_call_1 (scm->proc,
                SWIG_NewPointerObj(data, SWIG_TypeQuery("_p_QofSession"), 0));

    LEAVE("");
}

static void
watch_free (AvahiWatch *watch)
{
  scm_call_1 (watch->guile_poll->free_watch,
	      watch->watch_smob);

  /* We don't free the C object here.  Instead, it will get freed eventually,
     when its Scheme representative gets GC'd.  */
  scm_gc_unprotect_object (watch->watch_smob);

  watch->fd = -1;
  watch->dead = 1;
}