static SCM
guile_sock_no_delay (SCM sock, SCM enable)
{
svz_socket_t *xsock;
int old = 0, set = 0;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
if (xsock->proto & PROTO_TCP)
{
if (!SCM_UNBNDP (enable))
{
SCM_ASSERT (scm_is_bool (enable) || scm_is_integer (enable), enable,
SCM_ARG2, FUNC_NAME);
if ((scm_is_bool (enable) && scm_is_true (enable)) ||
(scm_is_integer (enable) && scm_to_int (enable) != 0))
set = 1;
}
if (svz_tcp_nodelay (xsock->sock_desc, set, &old) < 0)
old = 0;
else if (SCM_UNBNDP (enable))
svz_tcp_nodelay (xsock->sock_desc, old, NULL);
}
return SCM_BOOL (old);
}
/*
This function returns certain calling flags to the calling guile prog.
The calling flags are returned to Guile as a list of option/value pairs [e.g.
((verbose_mode #t) (interactive_mode #f) . . . ) ]
It is used primarily to enable refdes sorting during netlisting via
the -s flag. Note that this prog is not very flexible -- the allowed
calling flags are hard coded into the function. At some point this
should be fixed . . .
9.1.2003 -- SDB
8.2.2005 -- Carlos Nieves Onega
Different modes are now included in the backend_params list, as well as
the backend parameters given from the command line. Since the function
calling-flag? in scheme/gnetlist.scm returns false if the calling flag was
not found, it's only necessary to include the flags being true.
*/
SCM g_get_calling_flags()
{
SCM arglist = SCM_EOL;
GSList *aux;
aux = backend_params;
while (aux != NULL) {
arglist = scm_cons (scm_list_n (scm_makfrom0str (aux->data),
SCM_BOOL (TRUE),
SCM_UNDEFINED),
arglist);
aux = aux->next;
}
return (arglist);
}
int
scm_bool_obj_print(ScmObj obj, ScmObj port, int kind,
ScmObjPrintHandler handler)
{
int rslt;
scm_assert_obj_type(obj, &SCM_BOOL_TYPE_INFO);
if (SCM_BOOL(obj)->value == true)
rslt = scm_write_cstr("#t", SCM_ENC_SRC, port);
else
rslt = scm_write_cstr("#f", SCM_ENC_SRC, port);
if (rslt < 0) return -1;
return 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));
}
/********************************************************************\
* 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));
}
/********************************************************************\
* 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);
}
}