C++ scm_c_eval_string函数代码示例

int
libgncmod_report_system_gnc_module_init(int refcount)
{
    /* load the engine (we depend on it) */
    if (!gnc_module_load("gnucash/engine", 0))
    {
        return FALSE;
    }

    if (!gnc_module_load("gnucash/app-utils", 0))
    {
        return FALSE;
    }
    scm_init_sw_report_system_module();

    scm_c_eval_string("(use-modules (gnucash report report-system))");

    /* if this is the first time the module's being loaded, initialize
     * the relative date system */
    if (refcount == 0)
    {
        scm_c_eval_string("(gnc:reldate-initialize)");
    }

    return TRUE;
}

/********************************************************************
 * update_report_list
 *
 * this procedure does the real work of displaying a sorted list of
 * available custom reports
 ********************************************************************/
static void
update_report_list(GtkListStore *store, CustomReportDialog *crd)
{
    SCM get_rpt_guids = scm_c_eval_string("gnc:custom-report-template-guids");
    SCM template_menu_name = scm_c_eval_string("gnc:report-template-menu-name/report-guid");
    SCM rpt_guids;
    int i;
    GtkTreeIter iter;
    GtkTreeModel *model = GTK_TREE_MODEL (store);
    gboolean valid_iter;

    gtk_tree_sortable_set_sort_column_id(GTK_TREE_SORTABLE(store), COL_NAME, GTK_SORT_ASCENDING);

    crd->reportlist = scm_call_0(get_rpt_guids);
    rpt_guids = crd->reportlist;

    /* Empty current liststore */
    valid_iter = gtk_tree_model_get_iter_first (model, &iter);
    while (valid_iter)
    {
        GValue value = { 0, };
        GncGUID *row_guid;
        g_value_init ( &value, G_TYPE_POINTER);
        gtk_tree_model_get_value (model, &iter, COL_NUM, &value);
        row_guid = (GncGUID *) g_value_get_pointer (&value);
        guid_free (row_guid);
        g_value_unset (&value);
        valid_iter = gtk_tree_model_iter_next (model, &iter);
    }
    gtk_list_store_clear(store);

    if (scm_is_list(rpt_guids))
    {
        /* for all the report guids in the list, store them, with a reference,
        	 in the gtkliststore */
        for (i = 0; !scm_is_null(rpt_guids); i++)
        {
            GncGUID *guid = guid_malloc ();
            gchar *guid_str = scm_to_utf8_string (SCM_CAR(rpt_guids));
            gchar *name = gnc_scm_to_utf8_string (scm_call_2(template_menu_name, SCM_CAR(rpt_guids), SCM_BOOL_F));

            if (string_to_guid (guid_str, guid))
            {
                gtk_list_store_append(store, &iter);
                gtk_list_store_set(store, &iter,
                                   COL_NAME, name,
                                   COL_NUM, guid,
                                   -1);
            }
            g_free (name);
            g_free (guid_str);

            rpt_guids = SCM_CDR(rpt_guids);
        }
    }
}

static void
inner_main_add_price_quotes(void *closure, int argc, char **argv)
{
    SCM mod, add_quotes, scm_book, scm_result = SCM_BOOL_F;
    QofSession *session = NULL;

    scm_c_eval_string("(debug-set! stack 200000)");

    mod = scm_c_resolve_module("gnucash price-quotes");
    scm_set_current_module(mod);

    load_gnucash_modules();

    qof_event_suspend();
    scm_c_eval_string("(gnc:price-quotes-install-sources)");

    if (!gnc_quote_source_fq_installed())
    {
        g_print("%s", _("No quotes retrieved. Finance::Quote isn't "
                        "installed properly.\n"));
        goto fail;
    }

    add_quotes = scm_c_eval_string("gnc:book-add-quotes");
    session = gnc_get_current_session();
    if (!session) goto fail;

    qof_session_begin(session, add_quotes_file, FALSE, FALSE);
    if (qof_session_get_error(session) != ERR_BACKEND_NO_ERR) goto fail;

    qof_session_load(session, NULL);
    if (qof_session_get_error(session) != ERR_BACKEND_NO_ERR) goto fail;

    scm_book = gnc_book_to_scm(qof_session_get_book(session));
    scm_result = scm_call_2(add_quotes, SCM_BOOL_F, scm_book);

    qof_session_save(session, NULL);
    if (qof_session_get_error(session) != ERR_BACKEND_NO_ERR) goto fail;

    qof_session_destroy(session);
    if (!scm_is_true(scm_result))
    {
        g_warning("Failed to add quotes to %s.", add_quotes_file);
        goto fail;
    }

    qof_event_resume();
    gnc_shutdown(0);
    return;
fail:
    if (session && qof_session_get_error(session) != ERR_BACKEND_NO_ERR)
        g_warning("Session Error: %s", qof_session_get_error_message(session));
    qof_event_resume();
    gnc_shutdown(1);
}

int
libgncmodfoo_gnc_module_init(int refcount)
{
    /* publish the wrapped Scheme bindings for libfoo */
    scm_init_sw_foo_module();
    scm_c_eval_string("(use-modules (sw_foo))");

    /* use the Scheme "foo" module */
    scm_c_eval_string("(use-modules (gnucash foo))");

    return TRUE;
}

int
libgncmod_bar_gnc_module_init(int refcount)
{
    /* publish the wrapped Scheme bindings for libbar */
    scm_init_sw_bar_module();
    scm_c_eval_string("(use-modules (sw_bar))");

    /* use the Scheme "bar" module */
    scm_c_eval_string("(use-modules (gnucash bar))");

    return TRUE;
}

int
libgncmod_business_gnome_gnc_module_init(int refcount)
{
    /* load app-utils: we depend on it -- and it depends on the engine */
    if (!gnc_module_load ("gnucash/app-utils", 0))
    {
        return FALSE;
    }
    /* We also depend on gnome-utils and gnome-search modules */
    if (!gnc_module_load ("gnucash/gnome-utils", 0))
    {
        return FALSE;
    }
    if (!gnc_module_load ("gnucash/gnome-search", 0))
    {
        return FALSE;
    }
    if (!gnc_module_load ("gnucash/report/report-gnome", 0))
    {
        return FALSE;
    }

    scm_c_eval_string("(use-modules (gnucash business-gnome))");
    scm_c_eval_string("(use-modules (gnucash report business-reports))");

    if (refcount == 0)
    {
        /* Register the Owner search type */
        gnc_search_core_register_type (GNC_OWNER_MODULE_NAME,
                                       (GNCSearchCoreNew) gnc_search_owner_new);
        gnc_business_urls_initialize ();
        gnc_business_options_gnome_initialize ();

        gnc_plugin_manager_add_plugin (gnc_plugin_manager_get (),
                                       gnc_plugin_business_new ());

        gnc_hook_add_dangler(HOOK_BOOK_OPENED,
                             (GFunc)gnc_invoice_remind_bills_due_cb, NULL);
        gnc_hook_add_dangler(HOOK_BOOK_OPENED,
                             (GFunc)gnc_invoice_remind_invoices_due_cb, NULL);

        /* Add to preferences under Business */
        /* The parameters are; glade file, items to add from glade file - last being the dialog, preference tab name */
        gnc_preferences_add_page("business-prefs.glade", "liststore_printinvoice,days_in_adj,cust_days_in_adj,business_prefs",
                                 _("Business"));
    }

    return TRUE;
}

/*
 * This gets called if scm_apply throws an error.
 *
 * We use gh_scm2newstr to convert from Guile string to Scheme string. The
 * GH interface is deprecated, but doing it in scm takes more code. We'll
 * convert later if we have to.
 */
static SCM
gnm_guile_catcher (void *data, SCM tag, SCM throw_args)
{
	char const *header = _("Guile error");
	SCM smob;
	SCM func;
	SCM res;
	char *guilestr = NULL;
	char *msg;
	GnmValue *v;

	func = scm_c_eval_string ("gnm:error->string");
	if (scm_procedure_p (func)) {
		res = scm_apply (func, tag,
				 scm_cons (throw_args, scm_listofnull));
		if (scm_string_p (res))
			guilestr = gh_scm2newstr (res, NULL);
	}

	if (guilestr != NULL) {
		char *buf = g_strdup_printf ("%s: %s", header, guilestr);
		free (guilestr);
		v = value_new_error (NULL, buf);
		g_free (buf);
	} else {
		v = value_new_error (NULL, header);
	}

	smob = make_new_smob (v);
	value_release (v);
	return smob;
}

static void
lmod(char * mn)
{
    char * form = g_strdup_printf("(use-modules %s)\n", mn);
    scm_c_eval_string(form);
    g_free(form);
}

static void
run_tests (void)
{
    Query *q;
    SCM val2str;
    int i;

    val2str = scm_c_eval_string ("gnc:value->string");
    g_return_if_fail (scm_is_procedure (val2str));

    for (i = 0; i < 1000; i++)
    {
        q = get_random_query ();
        test_query (q, val2str);
        qof_query_destroy (q);
        fflush(stdout);
    }

    {
        q = get_random_query ();
        test_query (q, val2str);
        qof_query_destroy (q);
        fflush(stdout);
    }

}

G_MODULE_EXPORT void
go_plugin_init (GOPlugin *p, GOCmdContext *cc)
{
	char *name, *dir;

	*ret_error = NULL;

	 scm_init_guile ();

	/* Initialize just in case. */
	eval_pos = NULL;

	init_value_type ();

	scm_c_define_gsubr ("gnumeric-funcall", 2, 0, 0, scm_gnumeric_funcall);
	scm_c_define_gsubr ("register-function", 5, 0, 0, scm_register_function);

	dir = gnm_sys_data_dir ("guile");
	name = g_strconcat (dir, "gnumeric_startup.scm", NULL);
	scm_apply (scm_c_eval_string ("(lambda (filename)"
				  "  (if (access? filename R_OK)"
				  "    (load filename)"
				  "    (display (string-append \"could not read Guile plug-in init file\" filename \"\n\"))))"),
		  scm_cons (scm_makfrom0str (name), SCM_EOL),
		  SCM_EOL);
	g_free (name);
	g_free (dir);
	/* Don't try to deactivate the plugin */
	gnm_plugin_use_ref (PLUGIN);
}

int
libgncmod_qif_import_gnc_module_init(int refcount)
{
    if (!gnc_module_load("gnucash/engine", 0))
    {
        return FALSE;
    }

    if (!gnc_module_load("gnucash/app-utils", 0))
    {
        return FALSE;
    }

    if (!gnc_module_load("gnucash/gnome-utils", 0))
    {
        return FALSE;
    }

    /* If the recount == 0 then register the qif-import-druid for the new-user
     * dialog.
     */
    if (refcount == 0)
    {
        gnc_new_user_dialog_register_qif_druid
        ((void (*)())gnc_ui_qif_import_druid_make);
    }

    scm_c_eval_string("(use-modules (gnucash import-export qif-import))");

    gnc_plugin_qif_import_create_plugin();

    return TRUE;
}

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

SCM
gfec_apply(SCM proc, SCM arglist, gfec_error_handler error_handler)
{
    SCM result = SCM_UNDEFINED;
    SCM func = scm_c_eval_string("gnc:apply-with-error-handling");
    if (scm_is_procedure(func))
    {
        char *err_msg = NULL;
        SCM call_result, error;
        call_result = scm_call_2 (func, proc, arglist);

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

/* We assume that data is actually a char**. The way we return results
 * from this function is to malloc a fresh string, and store it in
 * this pointer. It is the caller's responsibility to do something
 * smart with this freshly allocated storage. the caller can determine
 * whether there was an error by initializing the char* passed in to
 * NULL. If there is an error, the char string will not be NULL on
 * return. */
static SCM
gfec_catcher(void *data, SCM tag, SCM throw_args)
{
    SCM func;
    SCM result;
    const char *msg = NULL;

    func = scm_c_eval_string("gnc:error->string");
    if (scm_is_procedure(func))
    {
        result = scm_call_2(func, tag, throw_args);
        if (scm_is_string(result))
        {
            char * str;

            scm_dynwind_begin (0); 
            str = scm_to_locale_string (result);
            msg = g_strdup (str);
            scm_dynwind_free (str); 
            scm_dynwind_end (); 
        }
    }

    if (msg == NULL)
    {
        msg = "Error running guile function.";
    }

    *(char**)data = strdup(msg);

    return SCM_UNDEFINED;
}

static SCM
gfec_string_helper(void *data)
{
    char *string = data;

    return scm_c_eval_string(string);
}