IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

Move some guile convenience routines to core utils

Browse Source 
They don't depend on any gui or engine code and are
used throughout the source

git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@22682 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Geert Janssens 2012-12-22 18:20:05 +00:00
parent 7cdd7372f5
commit 6fb7a4f7a2
4 changed files with 176 additions and 178 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

167
src/app-utils/guile-util.c
View File

@ -144,173 +144,6 @@ initialize_scm_functions()
}
/********************************************************************\
* 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 scm_to_locale_string(value);
}
else
{
PERR("bad value\n");
}
}
else
{
PERR("not a procedure\n");
}
return NULL;
}
/********************************************************************\
* 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 symbol_value;
if (scm_is_procedure(func))
{
symbol_value = scm_call_1(func, arg);
return gnc_scm_symbol_to_locale_string (symbol_value);
}
else
{
PERR("not a procedure\n");
}
return NULL;
}
/********************************************************************\
* 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;
}
/********************************************************************\
* gnc_guile_call1_to_list *
* returns the SCM handle to the list 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 list handle or SCM_UNDEFINED *
\********************************************************************/
SCM
gnc_guile_call1_to_list(SCM func, SCM arg)
{
SCM value;
if (scm_is_procedure(func))
{
value = scm_call_1(func, arg);
if (scm_is_list(value))
return value;
else
{
PERR("bad value\n");
}
}
else
{
PERR("not a procedure\n");
}
return SCM_UNDEFINED;
}
/********************************************************************\
* gnc_guile_call1_to_vector *
* returns the SCM handle to the vector 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 vector handle or SCM_UNDEFINED *
\********************************************************************/
SCM
gnc_guile_call1_to_vector(SCM func, SCM arg)
{
SCM value;
if (scm_is_procedure(func))
{
value = scm_call_1(func, arg);
if (scm_is_vector(value))
return value;
else
{
PERR("bad value\n");
}
}
else
{
PERR("not a procedure\n");
}
return SCM_UNDEFINED;
}
/********************************************************************\
gnc_scm_lookup

11
src/app-utils/guile-util.h
View File

@ -31,17 +31,6 @@
#include "Account.h"
#include "gnc-guile-utils.h"
/* Helpful functions for calling functions that return
* specific kinds of values. These functions do error
* checking to verify the result is of the correct type. */
char * gnc_guile_call1_to_string(SCM func, SCM arg);
char * gnc_guile_call1_symbol_to_string(SCM func, SCM arg);
SCM gnc_guile_call1_to_procedure(SCM func, SCM arg);
SCM gnc_guile_call1_to_list(SCM func, SCM arg);
SCM gnc_guile_list_ref(SCM list, int index);
SCM gnc_guile_call1_to_vector(SCM func, SCM arg);
/* Don't use this to get hold of symbols that are considered private
* to a given module unless the C code you're writing is considered
* part of that module. */

167
src/core-utils/gnc-guile-utils.c
View File

@ -60,3 +60,170 @@ gnc_scm_symbol_to_locale_string(SCM symbol_value)
PERR("bad value\n");
return NULL;
}
/********************************************************************\
* 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 must be freed with g_free *
\********************************************************************/
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;
}
/********************************************************************\
* 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 symbol_value;
if (scm_is_procedure(func))
{
symbol_value = scm_call_1(func, arg);
return gnc_scm_symbol_to_locale_string (symbol_value);
}
else
{
PERR("not a procedure\n");
}
return NULL;
}
/********************************************************************\
* 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;
}
/********************************************************************\
* gnc_guile_call1_to_list *
* returns the SCM handle to the list 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 list handle or SCM_UNDEFINED *
\********************************************************************/
SCM
gnc_guile_call1_to_list(SCM func, SCM arg)
{
SCM value;
if (scm_is_procedure(func))
{
value = scm_call_1(func, arg);
if (scm_is_list(value))
return value;
else
{
PERR("bad value\n");
}
}
else
{
PERR("not a procedure\n");
}
return SCM_UNDEFINED;
}
/********************************************************************\
* gnc_guile_call1_to_vector *
* returns the SCM handle to the vector 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 vector handle or SCM_UNDEFINED *
\********************************************************************/
SCM
gnc_guile_call1_to_vector(SCM func, SCM arg)
{
SCM value;
if (scm_is_procedure(func))
{
value = scm_call_1(func, arg);
if (scm_is_vector(value))
return value;
else
{
PERR("bad value\n");
}
}
else
{
PERR("not a procedure\n");
}
return SCM_UNDEFINED;
}

9
src/core-utils/gnc-guile-utils.h
View File

@ -31,4 +31,13 @@
* a guile symbol. */
gchar * gnc_scm_symbol_to_locale_string(SCM scm_string);
/* Helpful functions for calling functions that return
* specific kinds of values. These functions do error
* checking to verify the result is of the correct type. */
char * gnc_guile_call1_to_string(SCM func, SCM arg);
char * gnc_guile_call1_symbol_to_string(SCM func, SCM arg);
SCM gnc_guile_call1_to_procedure(SCM func, SCM arg);
SCM gnc_guile_call1_to_list(SCM func, SCM arg);
SCM gnc_guile_call1_to_vector(SCM func, SCM arg);
#endif