예제 #1
0
/* 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;
}
예제 #2
0
파일: gfec.c 프로젝트: jralls/gnucash
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;
}
예제 #3
0
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);
    }

}
예제 #4
0
/********************************************************************\
 * 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;
}
예제 #5
0
파일: gfec.c 프로젝트: Mechtilde/gnucash
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;
}
예제 #6
0
static void
dirty_same_stylesheet(gpointer key, gpointer val, gpointer data)
{
    SCM dirty_ss = data;
    SCM rep_ss = NULL;
    SCM report = val;
    SCM func = NULL;

    func = scm_c_eval_string("gnc:report-stylesheet");
    if (scm_is_procedure(func))
        rep_ss = scm_call_1(func, report);
    else
        return;

    if (scm_is_true(scm_eq_p(rep_ss, dirty_ss)))
    {
        func = scm_c_eval_string("gnc:report-set-dirty?!");
        /* This makes _me_ feel dirty! */
        if (scm_is_procedure(func))
            scm_call_2(func, report, SCM_BOOL_T);
    }
}
예제 #7
0
/********************************************************************\
 * gnc_guile_call1_to_procedure                                     *
 *   returns the SCM handle to the procedure returned by the guile  *
 *   function, or SCM_UNDEFINED if it couldn't be retrieved.        *
 *                                                                  *
 * Args: func - the guile function to call                          *
 *       arg  - the single function argument                        *
 * Returns: SCM function handle or SCM_UNDEFINED                    *
\********************************************************************/
SCM
gnc_guile_call1_to_procedure(SCM func, SCM arg)
{
    SCM value;

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

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

    return SCM_UNDEFINED;
}
예제 #8
0
/********************************************************************\
 * gnc_copy_split_scm_onto_split                                    *
 *   copies a scheme representation of a split onto an actual split.*
 *                                                                  *
 * Args: split_scm - the scheme representation of a split           *
 *       split     - the split to copy onto                         *
 * Returns: Nothing                                                 *
\********************************************************************/
void
gnc_copy_split_scm_onto_split(SCM split_scm, Split *split,
                              QofBook * book)
{
    static swig_type_info *split_type = NULL;
    SCM result;
    SCM func;
    SCM arg;

    if (split_scm == SCM_UNDEFINED)
        return;

    if (split == NULL)
        return;

    g_return_if_fail (book);

    func = scm_c_eval_string("gnc:split-scm?");
    if (!scm_is_procedure(func))
        return;

    result = scm_call_1(func, split_scm);
    if (!scm_is_true(result))
        return;

    func = scm_c_eval_string("gnc:split-scm-onto-split");
    if (!scm_is_procedure(func))
        return;

    if (!split_type)
        split_type = SWIG_TypeQuery("_p_Split");

    arg = SWIG_NewPointerObj(split, split_type, 0);

    scm_call_3(func, split_scm, arg, gnc_book_to_scm (book));
}
예제 #9
0
static void
run_tests (int count)
{
    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 < count; i++)
    {
        q = get_random_query ();
        test_query (q, val2str);
        qof_query_destroy (q);
    }
    success ("");
}
예제 #10
0
파일: gfec.c 프로젝트: Mechtilde/gnucash
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;
}
예제 #11
0
/********************************************************************\
 * gnc_copy_split                                                   *
 *   returns a scheme representation of a split. If the split is    *
 *   NULL, SCM_UNDEFINED is returned.                               *
 *                                                                  *
 * Args: split             - the split to copy                      *
 *       use_cut_semantics - if TRUE, copy is for a 'cut' operation *
 * Returns: SCM representation of split or SCM_UNDEFINED            *
\********************************************************************/
SCM
gnc_copy_split(Split *split, gboolean use_cut_semantics)
{
    static swig_type_info *split_type = NULL;
    SCM func;
    SCM arg;

    if (split == NULL)
        return SCM_UNDEFINED;

    func = scm_c_eval_string("gnc:split->split-scm");
    if (!scm_is_procedure(func))
        return SCM_UNDEFINED;

    if (!split_type)
        split_type = SWIG_TypeQuery("_p_Split");

    arg = SWIG_NewPointerObj(split, split_type, 0);

    return scm_call_2(func, arg, SCM_BOOL(use_cut_semantics));
}
예제 #12
0
/********************************************************************\
 * gnc_copy_trans                                                   *
 *   returns a scheme representation of a transaction. If the       *
 *   transaction is NULL, SCM_UNDEFINED is returned.                *
 *                                                                  *
 * Args: trans             - the transaction to copy                *
 *       use_cut_semantics - if TRUE, copy is for a 'cut' operation *
 * Returns: SCM representation of transaction or SCM_UNDEFINED      *
\********************************************************************/
SCM
gnc_copy_trans(Transaction *trans, gboolean use_cut_semantics)
{
    static swig_type_info *trans_type = NULL;
    SCM func;
    SCM arg;

    if (trans == NULL)
        return SCM_UNDEFINED;

    func = scm_c_eval_string("gnc:transaction->transaction-scm");
    if (!scm_is_procedure(func))
        return SCM_UNDEFINED;

    if (!trans_type)
        trans_type = SWIG_TypeQuery("_p_Transaction");

    arg = SWIG_NewPointerObj(trans, trans_type, 0);

    return scm_call_2(func, arg, SCM_BOOL(use_cut_semantics));
}
예제 #13
0
/********************************************************************\
 * gnc_guile_call1_symbol_to_string                                 *
 *   returns the malloc'ed string returned by the guile function    *
 *   or NULL if it can't be retrieved. The return value of the      *
 *   function should be a symbol.                                   *
 *                                                                  *
 * Args: func - the guile function to call                          *
 *       arg  - the single function argument                        *
 * Returns: malloc'ed char * or NULL                                *
\********************************************************************/
char *
gnc_guile_call1_symbol_to_string(SCM func, SCM arg)
{
    SCM value;

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

        if (scm_is_symbol(value))
            return g_strdup(SCM_SYMBOL_CHARS(value));
        else
        {
            PERR("bad value\n");
        }
    }
    else
    {
        PERR("not a procedure\n");
    }

    return NULL;
}
static int build_owner_report (GncOwner *owner, Account *acc)
{
    SCM args;
    SCM func;
    SCM arg;

    g_return_val_if_fail (owner, -1);

    args = SCM_EOL;

    func = scm_c_eval_string ("gnc:owner-report-create");
    g_return_val_if_fail (scm_is_procedure (func), -1);

    if (acc)
    {
        swig_type_info * qtype = SWIG_TypeQuery("_p_Account");
        g_return_val_if_fail (qtype, -1);

        arg = SWIG_NewPointerObj(acc, qtype, 0);
        g_return_val_if_fail (arg != SCM_UNDEFINED, -1);
        args = scm_cons (arg, args);
    }
    else
    {
        args = scm_cons (SCM_BOOL_F, args);
    }

    arg = SWIG_NewPointerObj(owner, SWIG_TypeQuery("_p__gncOwner"), 0);
    g_return_val_if_fail (arg != SCM_UNDEFINED, -1);
    args = scm_cons (arg, args);

    /* Apply the function to the args */
    arg = scm_apply (func, args, SCM_EOL);
    g_return_val_if_fail (scm_is_exact (arg), -1);
    return scm_to_int (arg);
}
예제 #15
0
void
gnc_prices_dialog_get_quotes_clicked (GtkWidget *widget, gpointer data)
{
    PricesDialog *pdb_dialog = data;
    SCM quotes_func;
    SCM book_scm;
    SCM scm_window;

    ENTER(" ");
    quotes_func = scm_c_eval_string ("gnc:book-add-quotes");
    if (!scm_is_procedure (quotes_func))
    {
        LEAVE(" no procedure");
        return;
    }

    book_scm = gnc_book_to_scm (pdb_dialog->book);
    if (scm_is_true (scm_not (book_scm)))
    {
        LEAVE("no book");
        return;
    }

    scm_window =  SWIG_NewPointerObj(pdb_dialog->dialog,
                                     SWIG_TypeQuery("_p_GtkWidget"), 0);

    gnc_set_busy_cursor (NULL, TRUE);
    scm_call_2 (quotes_func, scm_window, book_scm);
    gnc_unset_busy_cursor (NULL);

    /* Without this, the summary bar on the accounts tab
     * won't reflect the new prices (bug #522095). */
    gnc_gui_refresh_all ();

    LEAVE(" ");
}
static int
build_aging_report (GncOwnerType owner_type)
{
    gchar *report_name = NULL;
    gchar *report_title = NULL;
    SCM args;
    SCM func;
    SCM arg;

    args = SCM_EOL;

    switch (owner_type)
    {
    case GNC_OWNER_NONE :
    case GNC_OWNER_UNDEFINED :
    case GNC_OWNER_EMPLOYEE :
    case GNC_OWNER_JOB :
    {
        return -1;
    }
    case GNC_OWNER_VENDOR :
    {
        report_name  = "gnc:payables-report-create";
        report_title = _("Vendor Listing");
        break;
    }
    case GNC_OWNER_CUSTOMER :
    {
        report_name = "gnc:receivables-report-create";
        report_title = _("Customer Listing");
        break;
    }
    }

    /* Find report generator function in guile */
    func = scm_c_eval_string (report_name);
    g_return_val_if_fail (scm_is_procedure (func), -1);

    /* Option Show zero's ? - Yes for the listing report */
    arg = SCM_BOOL_T;
    args = scm_cons (arg, args);
    g_return_val_if_fail (arg != SCM_UNDEFINED, -1);

    /* Option Report title */
    arg = scm_from_locale_string (report_title);
    args = scm_cons (arg, args);

    /* Option Account - Using False to select default account
     *
     * XXX I'm not sure if it would make sense to use another
     *     account than default */
    arg = SCM_BOOL_F;
    args = scm_cons (arg, args);
    g_return_val_if_fail (arg != SCM_UNDEFINED, -1);


    /* Apply the function to the args */
    arg = scm_apply (func, args, SCM_EOL);
    g_return_val_if_fail (scm_is_exact (arg), -1);

    return scm_to_int (arg);
}
예제 #17
0
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;
}
예제 #18
0
/********************************************************************\
 * gnc_copy_trans_scm_onto_trans_swap_accounts                      *
 *   copies a scheme representation of a transaction onto           *
 *   an actual transaction. If guid_1 and guid_2 are not NULL,      *
 *   the account guids of the splits are swapped accordingly.       *
 *                                                                  *
 * Args: trans_scm - the scheme representation of a transaction     *
 *       trans     - the transaction to copy onto                   *
 *       guid_1    - account guid to swap with guid_2               *
 *       guid_2    - account guid to swap with guid_1               *
 *       do_commit - whether to commit the edits                    *
 * Returns: Nothing                                                 *
\********************************************************************/
void
gnc_copy_trans_scm_onto_trans_swap_accounts(SCM trans_scm,
        Transaction *trans,
        const GncGUID *guid_1,
        const GncGUID *guid_2,
        gboolean do_commit,
        QofBook *book)
{
    static swig_type_info *trans_type = NULL;
    SCM result;
    SCM func;
    SCM arg;

    if (trans_scm == SCM_UNDEFINED)
        return;

    if (trans == NULL)
        return;

    g_return_if_fail (book);

    func = scm_c_eval_string("gnc:transaction-scm?");
    if (!scm_is_procedure(func))
        return;

    result = scm_call_1(func, trans_scm);
    if (!scm_is_true(result))
        return;

    func = scm_c_eval_string("gnc:transaction-scm-onto-transaction");
    if (!scm_is_procedure(func))
        return;

    if (!trans_type)
        trans_type = SWIG_TypeQuery("_p_Transaction");

    arg = SWIG_NewPointerObj(trans, trans_type, 0);

    if ((guid_1 == NULL) || (guid_2 == NULL))
    {
        SCM args = SCM_EOL;
        SCM commit;

        commit = SCM_BOOL(do_commit);

        args = scm_cons(gnc_book_to_scm (book), args);
        args = scm_cons(commit, args);
        args = scm_cons(SCM_EOL, args);
        args = scm_cons(arg, args);
        args = scm_cons(trans_scm, args);

        scm_apply(func, args, SCM_EOL);
    }
    else
    {
        gchar guidstr[GUID_ENCODING_LENGTH+1];
        SCM from, to;
        SCM map = SCM_EOL;
        SCM args = SCM_EOL;
        SCM commit;

        args = scm_cons(gnc_book_to_scm (book), args);

        commit = SCM_BOOL(do_commit);

        args = scm_cons(commit, args);

        guid_to_string_buff(guid_1, guidstr);
        from = scm_from_utf8_string(guidstr);
        guid_to_string_buff(guid_2, guidstr);
        to = scm_from_utf8_string(guidstr);

        map = scm_cons(scm_cons(from, to), map);
        map = scm_cons(scm_cons(to, from), map);

        args = scm_cons(map, args);
        args = scm_cons(arg, args);
        args = scm_cons(trans_scm, args);

        scm_apply(func, args, SCM_EOL);
    }
}