static void
scm_scmlist_print (LONGEST svalue, struct ui_file *stream, int format,
int deref_ref, int recurse, enum val_prettyprint pretty)
{
unsigned int more = print_max;
if (recurse > 6)
{
fputs_filtered ("...", stream);
return;
}
scm_scmval_print (SCM_CAR (svalue), stream, format,
deref_ref, recurse + 1, pretty);
svalue = SCM_CDR (svalue);
for (; SCM_NIMP (svalue); svalue = SCM_CDR (svalue))
{
if (SCM_NECONSP (svalue))
break;
fputs_filtered (" ", stream);
if (--more == 0)
{
fputs_filtered ("...", stream);
return;
}
scm_scmval_print (SCM_CAR (svalue), stream, format,
deref_ref, recurse + 1, pretty);
}
if (SCM_NNULLP (svalue))
{
fputs_filtered (" . ", stream);
scm_scmval_print (svalue, stream, format,
deref_ref, recurse + 1, pretty);
}
}
static SCM
decode_scm_col_list (GttGhtml *ghtml, SCM col_list)
{
SCM col_name;
char * tok = NULL;
/* reset the parser */
ghtml->ninvl_cols = 0;
ghtml->ntask_cols = 0;
while (!scm_is_null (col_list))
{
col_name = SCM_CAR (col_list);
/* either a 'symbol or a "quoted string" */
if (!scm_is_symbol(col_name) && !scm_is_string (col_name))
{
col_list = SCM_CDR (col_list);
continue;
}
tok = scm_to_locale_string (col_name);
decode_column (ghtml, tok);
free (tok);
col_list = SCM_CDR (col_list);
}
return SCM_UNSPECIFIED;
}
/*! \brief Exports the keymap in scheme to a GLib GArray.
* \par Function Description
* This function converts the list of key sequence/action pairs
* returned by the scheme function \c dump-current-keymap into an
* array of C structures.
*
* The returned value must be freed by caller.
*
* \return A GArray with keymap data.
*/
GArray*
g_keys_dump_keymap (void)
{
SCM dump_proc = scm_c_lookup ("dump-current-keymap");
SCM scm_ret;
GArray *ret = NULL;
struct keyseq_action_t {
gchar *keyseq, *action;
};
dump_proc = scm_variable_ref (dump_proc);
g_return_val_if_fail (SCM_NFALSEP (scm_procedure_p (dump_proc)), NULL);
scm_ret = scm_call_0 (dump_proc);
g_return_val_if_fail (SCM_CONSP (scm_ret), NULL);
ret = g_array_sized_new (FALSE,
FALSE,
sizeof (struct keyseq_action_t),
(guint)scm_ilength (scm_ret));
for (; scm_ret != SCM_EOL; scm_ret = SCM_CDR (scm_ret)) {
SCM scm_keymap_entry = SCM_CAR (scm_ret);
struct keyseq_action_t keymap_entry;
g_return_val_if_fail (SCM_CONSP (scm_keymap_entry) &&
scm_is_symbol (SCM_CAR (scm_keymap_entry)) &&
scm_is_string (SCM_CDR (scm_keymap_entry)), ret);
keymap_entry.action = g_strdup (SCM_SYMBOL_CHARS (SCM_CAR (scm_keymap_entry)));
keymap_entry.keyseq = g_strdup (SCM_STRING_CHARS (SCM_CDR (scm_keymap_entry)));
ret = g_array_append_val (ret, keymap_entry);
}
return ret;
}
SWIGINTERN int
SWIG_Guile_GetArgs (SCM *dest, SCM rest,
int reqargs, int optargs,
const char *procname)
{
int i;
int num_args_passed = 0;
for (i = 0; i<reqargs; i++) {
if (!SCM_CONSP(rest))
scm_wrong_num_args(scm_from_locale_string((char *) procname));
*dest++ = SCM_CAR(rest);
rest = SCM_CDR(rest);
num_args_passed++;
}
for (i = 0; i<optargs && SCM_CONSP(rest); i++) {
*dest++ = SCM_CAR(rest);
rest = SCM_CDR(rest);
num_args_passed++;
}
for (; i<optargs; i++)
*dest++ = SCM_UNDEFINED;
if (!SCM_NULLP(rest))
scm_wrong_num_args(scm_from_locale_string((char *) procname));
return num_args_passed;
}
static void message_args_set(ScmMessageCondition *obj, ScmObj val)
{
ScmObj msglist = obj->message;
if (SCM_PAIRP(msglist) && SCM_PAIRP(SCM_CDR(msglist))) {
SCM_SET_CDR(SCM_CDR(msglist), val);
} else {
obj->message = Scm_Cons(msglist, Scm_Cons(msglist, val));
}
}
static void message_prefix_set(ScmMessageCondition *obj, ScmObj val)
{
ScmObj msglist = obj->message;
if (SCM_PAIRP(msglist) && SCM_PAIRP(SCM_CDR(msglist))) {
SCM_SET_CAR(SCM_CDR(msglist), val);
} else {
obj->message = SCM_LIST2(msglist, val);
}
}
ScmObj Scm_GetKeyword(ScmObj key, ScmObj list, ScmObj fallback)
{
ScmObj cp;
SCM_FOR_EACH(cp, list) {
if (!SCM_PAIRP(SCM_CDR(cp))) {
Scm_Error("incomplete key list: %S", list);
}
if (key == SCM_CAR(cp)) return SCM_CADR(cp);
cp = SCM_CDR(cp);
}
if (SCM_UNBOUNDP(fallback)) {
Scm_Error("value for key %S is not provided: %S", key, list);
}
return fallback;
}
GList *
gnc_scm_list_to_glist(SCM rest)
{
GList *result = NULL;
SCM scm_item;
SWIG_GetModule(NULL); /* Work-around for SWIG bug. */
SCM_ASSERT(scm_is_list(rest), rest, SCM_ARG1, "gnc_scm_list_to_glist");
while (!scm_is_null(rest))
{
void *item;
scm_item = SCM_CAR(rest);
rest = SCM_CDR(rest);
if (scm_item == SCM_BOOL_F)
{
result = g_list_prepend(result, NULL);
}
else
{
if (!SWIG_IsPointer(scm_item))
scm_misc_error("gnc_scm_list_to_glist",
"Item in list not a wcp.", scm_item);
item = (void *)SWIG_PointerAddress(scm_item);
result = g_list_prepend(result, item);
}
}
return g_list_reverse(result);
}
static SCM
scm_gnumeric_funcall (SCM funcname, SCM arglist)
{
int i, num_args;
GnmValue **argvals;
GnmValue *retval;
SCM retsmob;
GnmCellRef cell_ref = { 0, 0, 0, 0 };
SCM_ASSERT (SCM_NIMP (funcname) && SCM_STRINGP (funcname), funcname, SCM_ARG1, "gnumeric-funcall");
SCM_ASSERT (SCM_NFALSEP (scm_list_p (arglist)), arglist, SCM_ARG2, "gnumeric-funcall");
num_args = scm_ilength (arglist);
argvals = g_new (GnmValue *, num_args);
for (i = 0; i < num_args; ++i) {
argvals[i] = scm_to_value (SCM_CAR (arglist));
arglist = SCM_CDR (arglist);
}
retval = function_call_with_values (eval_pos, SCM_CHARS (funcname),
num_args,argvals);
retsmob = value_to_scm (retval, cell_ref);
value_release (retval);
return retsmob;
}
SCM
scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM alist)
{
if (!SCM_UNBNDP (filename))
{
SCM old_alist = alist;
/*
have to extract the acons, and operate on that, for
thread safety.
*/
SCM last_acons = SCM_CDR (scm_last_alist_filename);
if (scm_is_null (old_alist)
&& scm_is_eq (SCM_CDAR (last_acons), filename))
{
alist = last_acons;
}
else
{
alist = scm_acons (scm_sym_filename, filename, alist);
if (scm_is_null (old_alist))
scm_set_cdr_x (scm_last_alist_filename, alist);
}
}
SCM_RETURN_NEWSMOB3 (scm_tc16_srcprops,
SRCPROPMAKPOS (line, col),
SCM_UNPACK (copy),
SCM_UNPACK (alist));
}
GncAccountValue * gnc_scm_to_account_value_ptr (SCM valuearg)
{
GncAccountValue *res;
Account *acc = NULL;
gnc_numeric value;
swig_type_info * account_type = get_acct_type();
SCM val;
/* Get the account */
val = SCM_CAR (valuearg);
if (!SWIG_IsPointerOfType (val, account_type))
return NULL;
acc = SWIG_MustGetPtr(val, account_type, 1, 0);
/* Get the value */
val = SCM_CDR (valuearg);
value = gnc_scm_to_numeric (val);
/* Build and return the object */
res = g_new0 (GncAccountValue, 1);
res->account = acc;
res->value = value;
return res;
}
static SCM make_doc(SCM ingredients, SCM recipe) {
MAKE_NODE *node;
FILE_NODE *fnode;
SCM smob, cursor;
if (scm_is_symbol(ingredients)) {
if (ingredients == file_sym) {
node = make_node(TYPE_FILE);
node->filepath = scm_to_locale_string(recipe);
node->dirty = 1;
fnode = (FILE_NODE *)malloc(sizeof(FILE_NODE));
fnode->node = node;
fnode->mtime = 0;
fnode->next = file_nodes;
file_nodes = fnode;
}
else {
node = make_node(TYPE_DATUM);
node->dirty = 0;
node->payload = recipe;
}
SCM_RETURN_NEWSMOB(make_node_tag, node);
}
node = make_node(TYPE_CHAIN);
node->dirty = 1;
node->callback = recipe;
SCM_NEWSMOB(smob, make_node_tag, node);
cursor = ingredients;
while (cursor != SCM_EOL) {
add_ascendant(SCM_CAR(cursor), smob);
cursor = SCM_CDR(cursor);
}
scm_remember_upto_here_2(ingredients, recipe);
scm_remember_upto_here_2(smob, cursor);
return smob;
}
/*! \todo Finish function documentation!!!
* \brief
* \par Function Description
*
*/
SCM g_funcs_filesel(SCM scm_msg, SCM scm_templ, SCM scm_flags)
{
int c_flags;
char *r, *msg, *templ;
SCM v;
SCM_ASSERT (scm_is_string (scm_msg), scm_msg,
SCM_ARG1, "gschem-filesel");
SCM_ASSERT (scm_is_string (scm_templ), scm_templ,
SCM_ARG2, "gschem-filesel");
/*! \bug FIXME -- figure out the magic SCM_ASSERT for the flags */
/*! \bug FIXME -- how to deal with conflicting flags?
* Should I throw a scheme error? Just deal in the c code?
*/
for (c_flags = 0; scm_is_pair (scm_flags); scm_flags = SCM_CDR (scm_flags)) {
char *flag;
SCM scm_flag = SCM_CAR (scm_flags);
flag = scm_to_utf8_string (scm_flag);
if (strcmp (flag, "may_exist") == 0) {
c_flags |= FSB_MAY_EXIST;
} else if (strcmp (flag, "must_exist") == 0) {
c_flags |= FSB_MUST_EXIST;
} else if (strcmp (flag, "must_not_exist") == 0) {
c_flags |= FSB_SHOULD_NOT_EXIST;
} else if (strcmp (flag, "save") == 0) {
c_flags |= FSB_SAVE;
} else if (strcmp (flag, "open") == 0) {
c_flags |= FSB_LOAD;
} else {
free(flag);
scm_wrong_type_arg ("gschem-filesel", SCM_ARG3, scm_flag);
}
free(flag);
}
msg = scm_to_utf8_string (scm_msg);
templ = scm_to_utf8_string (scm_templ);
r = generic_filesel_dialog (msg, templ, c_flags);
free(msg);
free(templ);
v = scm_from_utf8_string (r);
g_free (r);
return v;
}
static scm_sizet
mu_scm_body_free (SCM body_smob)
{
struct mu_body *mbp = (struct mu_body *) SCM_CDR (body_smob);
if (mbp->buffer)
free (mbp->buffer);
free (mbp);
return sizeof (struct mu_body);
}
static ScmObj message_args_get(ScmMessageCondition *obj)
{
ScmObj msglist = obj->message;
if (SCM_PAIRP(msglist) && SCM_PAIRP(SCM_CDR(msglist))) {
return SCM_CDDR(msglist);
} else {
return SCM_NIL;
}
}
static ScmObj message_prefix_get(ScmMessageCondition *obj)
{
ScmObj msglist = obj->message;
if (SCM_PAIRP(msglist) && SCM_PAIRP(SCM_CDR(msglist))) {
return SCM_CADR(msglist);
} else {
return msglist;
}
}
/********************************************************************
* 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);
}
}
}
/* FIXME: needs comment: */
static void
scm_ipruk(const char *hdr, LONGEST ptr, struct ui_file *stream)
{
fprintf_filtered(stream, "#<unknown-%s", hdr);
#define SCM_SIZE TYPE_LENGTH(builtin_type_scm)
if (SCM_CELLP(ptr))
fprintf_filtered(stream, " (0x%lx . 0x%lx) @",
(long)SCM_CAR(ptr), (long)SCM_CDR(ptr));
fprintf_filtered(stream, " 0x%s>", paddr_nz(ptr));
}
/*=gfunc in_p
*
* what: test for string in list
* general_use:
* exparg: test-string, string to look for
* exparg: string-list, list of strings to check,, list
*
* doc: Return SCM_BOOL_T if the first argument string is found
* in one of the entries in the second (list-of-strings) argument.
=*/
SCM
ag_scm_in_p(SCM obj, SCM list)
{
int len;
size_t lenz;
SCM car;
char const * pz1;
if (! AG_SCM_STRING_P(obj))
return SCM_UNDEFINED;
pz1 = scm_i_string_chars(obj);
lenz = AG_SCM_STRLEN(obj);
/*
* If the second argument is a string somehow, then treat
* this as a straight out string comparison
*/
if (AG_SCM_STRING_P(list)) {
if ( (AG_SCM_STRLEN(list) == lenz)
&& (strncmp(pz1, scm_i_string_chars(list), lenz) == 0))
return SCM_BOOL_T;
return SCM_BOOL_F;
}
len = (int)scm_ilength(list);
if (len == 0)
return SCM_BOOL_F;
/*
* Search all the lists and sub-lists passed in
*/
while (len-- > 0) {
car = SCM_CAR(list);
list = SCM_CDR(list);
/*
* This routine is listed as getting a list as the second
* argument. That means that if someone builds a list and
* hands it to us, it magically becomes a nested list.
* This unravels that.
*/
if (! AG_SCM_STRING_P(car)) {
if (ag_scm_in_p(obj, car) == SCM_BOOL_T)
return SCM_BOOL_T;
continue;
}
if ( (AG_SCM_STRLEN(car) == lenz)
&& (strncmp(pz1, scm_i_string_chars(car), lenz) == 0) )
return SCM_BOOL_T;
}
return SCM_BOOL_F;
}
static void
gnc_column_view_edit_remove_cb(GtkButton * button, gpointer user_data)
{
gnc_column_view_edit * r = user_data;
SCM newlist = SCM_EOL;
SCM oldlist = r->contents_list;
int count;
int oldlength;
if (scm_is_list(r->contents_list))
{
oldlength = scm_ilength(r->contents_list);
if (oldlength > r->contents_selected)
{
for (count = 0; count < r->contents_selected; count++)
{
newlist = scm_cons(SCM_CAR(oldlist), newlist);
oldlist = SCM_CDR(oldlist);
}
if (count <= oldlength)
{
newlist = scm_append(scm_listify(scm_reverse(newlist), SCM_CDR(oldlist), SCM_UNDEFINED));
}
}
if (r->contents_selected > 0 && oldlength == r->contents_selected + 1)
{
r->contents_selected --;
}
scm_gc_unprotect_object(r->contents_list);
r->contents_list = newlist;
scm_gc_protect_object(r->contents_list);
gnc_column_view_set_option(r->odb, "__general", "report-list",
r->contents_list);
gnc_options_dialog_changed (r->optwin);
}
update_display_lists(r);
}
static SCM
scm_i_vector2list (SCM l, long len)
{
long j;
SCM z = scm_c_make_vector (len, SCM_UNDEFINED);
for (j = 0; j < len; j++, l = SCM_CDR (l)) {
SCM_SIMPLE_VECTOR_SET (z, j, SCM_CAR (l));
}
return z;
}
static void invalidate(MAKE_NODE *node) {
SCM cursor;
node->dirty = 1;
cursor = node->ascendants;
while (cursor != SCM_EOL) {
invalidate((MAKE_NODE *)SCM_SMOB_DATA(SCM_CAR(cursor)));
cursor = SCM_CDR(cursor);
}
scm_remember_upto_here_1(cursor);
return;
}
SCM dijkstra(SCM scm_weights, SCM scm_start, SCM scm_cut_corners_p) {
int row = scm_to_int(SCM_CAR(scm_start));
int col = scm_to_int(SCM_CAR(SCM_CDR(scm_start)));
SCM dimensions = scm_array_dimensions(scm_weights);
int rows = scm_to_int(SCM_CAR(dimensions));
int cols = scm_to_int(SCM_CAR(SCM_CDR(dimensions)));
int cut_corners_p = scm_to_bool(scm_cut_corners_p);
int * weights = calloc(rows * cols, sizeof(int *));
WeightedPoint ** weighted_paths = calloc(rows, sizeof(WeightedPoint *));
scm_t_array_handle weights_handle;
scm_array_get_handle(scm_weights, &weights_handle);
int i_row, i_col;
for(i_row = 0; i_row < rows; i_row++) {
weighted_paths[i_row] = calloc(cols, sizeof(WeightedPoint));
for(i_col = 0; i_col < cols; i_col++) {
ssize_t pos = scm_array_handle_pos(&weights_handle, scm_list_2(scm_from_int(i_row), scm_from_int(i_col)));
weights[i_row * cols + i_col] = scm_to_int(scm_array_handle_ref(&weights_handle, pos));
}
}
scm_array_handle_release(&weights_handle);
find_paths(weighted_paths, (Point){col, row}, cut_corners_p, weights, rows, cols);
SCM scm_paths = scm_make_array(scm_from_int(0), dimensions);
for(i_row = 0; i_row < rows; i_row++) {
for(i_col = 0; i_col < cols; i_col++) {
scm_array_set_x(scm_paths,
scm_list_2(scm_from_int(weighted_paths[i_row][i_col].prev.y), scm_from_int(weighted_paths[i_row][i_col] .prev.x)),
scm_list_2(scm_from_int(i_row), scm_from_int(i_col)));
}
free(weighted_paths[i_row]);
}
free(weighted_paths);
free(weights);
return scm_paths;
}
int Scm_Length(ScmObj obj)
{
ScmObj slow = obj;
int len = 0;
for (;;) {
if (SCM_NULLP(obj)) break;
if (!SCM_PAIRP(obj)) return SCM_LIST_DOTTED;
obj = SCM_CDR(obj);
len++;
if (SCM_NULLP(obj)) break;
if (!SCM_PAIRP(obj)) return SCM_LIST_DOTTED;
obj = SCM_CDR(obj);
slow = SCM_CDR(slow);
if (obj == slow) return SCM_LIST_CIRCULAR;
len++;
}
return len;
}
/*! \brief Re-poll a scheme procedure for symbols.
* \par Function Description
* Calls a Scheme procedure to obtain a list of available symbols,
* and updates the source with the new list
*
* Private function used only in s_clib.c.
*/
static void refresh_scm (CLibSource *source)
{
SCM symlist;
SCM symname;
CLibSymbol *symbol;
char *tmp;
g_return_if_fail (source != NULL);
g_return_if_fail (source->type == CLIB_SCM);
/* Clear the current symbol list */
g_list_foreach (source->symbols, (GFunc) free_symbol, NULL);
g_list_free (source->symbols);
source->symbols = NULL;
symlist = scm_call_0 (source->list_fn);
if (scm_is_false (scm_list_p (symlist))) {
s_log_message (_("Failed to scan library [%1$s]: Scheme function returned non-list."),
source->name);
return;
}
while (!scm_is_null (symlist)) {
symname = SCM_CAR (symlist);
if (!scm_is_string (symname)) {
s_log_message (_("Non-string symbol name while scanning library [%1$s]"),
source->name);
} else {
symbol = g_new0 (CLibSymbol, 1);
symbol->source = source;
/* Need to make sure that the correct free() function is called
* on strings allocated by Guile. */
tmp = scm_to_utf8_string (symname);
symbol->name = g_strdup(tmp);
free (tmp);
/* Prepend because it's faster and it doesn't matter what order we
* add them. */
source->symbols = g_list_prepend (source->symbols, symbol);
}
symlist = SCM_CDR (symlist);
}
/* Now sort the list of symbols by name. */
source->symbols = g_list_sort (source->symbols,
(GCompareFunc) compare_symbol_name);
s_clib_flush_search_cache();
s_clib_flush_symbol_cache();
}
static SCM smtp_send(SCM url, SCM from, SCM recipients,
SCM username, SCM password, SCM payload) {
CURL *curl;
CURLcode res;
SCM out;
struct tracked_string s_payload;
char *s_username, *s_password, *s_url, *s_from, *buf;
struct curl_slist *s_recipients = NULL;
curl = curl_easy_init();
if (curl == NULL) {
log_msg("smtp_send: curl init failed\n");
return SCM_BOOL_F;
}
s_username = scm_to_utf8_string(username);
curl_easy_setopt(curl, CURLOPT_USERNAME, s_username);
s_password = scm_to_utf8_string(password);
curl_easy_setopt(curl, CURLOPT_PASSWORD, s_password);
s_url = scm_to_utf8_string(url);
curl_easy_setopt(curl, CURLOPT_URL, s_url);
curl_easy_setopt(curl, CURLOPT_USE_SSL, CURLUSESSL_ALL);
curl_easy_setopt(curl, CURLOPT_SSL_VERIFYPEER, 1);
curl_easy_setopt(curl, CURLOPT_SSL_VERIFYHOST, 1);
s_from = scm_to_utf8_string(from);
curl_easy_setopt(curl, CURLOPT_MAIL_FROM, s_from);
while (recipients != SCM_EOL) {
buf = scm_to_utf8_string(SCM_CAR(recipients));
s_recipients = curl_slist_append(s_recipients, buf);
free(buf);
recipients = SCM_CDR(recipients);
}
curl_easy_setopt(curl, CURLOPT_MAIL_RCPT, s_recipients);
curl_easy_setopt(curl, CURLOPT_READFUNCTION, reader);
s_payload.src = scm_to_utf8_string(payload);
s_payload.pt = s_payload.src;
curl_easy_setopt(curl, CURLOPT_READDATA, (void *)&s_payload);
curl_easy_setopt(curl, CURLOPT_UPLOAD, 1);
//curl_easy_setopt(curl, CURLOPT_VERBOSE, 1);
res = curl_easy_perform(curl);
if (res != CURLE_OK) {
log_msg("smtp_send: %s\n", curl_easy_strerror(res));
out = SCM_BOOL_F;
}
else out = SCM_BOOL_T;
curl_slist_free_all(s_recipients);
curl_easy_cleanup(curl);
free(s_payload.src);
free(s_username);
free(s_password);
free(s_url);
free(s_from);
return out;
}
/*
* Recursive routine. It calls itself for list values and calls
* "do_substitution" for string values. Each substitution will
* be done in the order found in the tree walk of list values.
* The "match" and "repl" trees *must* be identical in structure.
*/
LOCAL void
do_multi_subs(char ** ppzStr, ssize_t * pStrLen, SCM match, SCM repl)
{
char * pzStr = *ppzStr;
char * pzNxt = pzStr;
/*
* Loop for as long as our list has more entries
*/
while (! scm_is_null(match)) {
/*
* "CAR" is the current value, "CDR" is rest of list
*/
SCM matchCar = SCM_CAR(match);
SCM replCar = SCM_CAR(repl);
match = SCM_CDR(match);
repl = SCM_CDR(repl);
if (AG_SCM_STRING_P(matchCar)) {
do_substitution(pzStr, *pStrLen, matchCar, replCar,
&pzNxt, pStrLen);
// coverity[use_after_free] -- invalid alias analysis
pzStr = pzNxt;
}
else if (AG_SCM_LIST_P(matchCar))
do_multi_subs(&pzStr, pStrLen, matchCar, replCar);
else
/*
* Whatever it is it is not part of what we would expect. Bail.
*/
break;
}
*ppzStr = pzStr;
}
static SCM
guile_sock_local_address (SCM sock, SCM address)
{
svz_socket_t *xsock;
uint16_t port;
SCM pair;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
pair = scm_cons (scm_from_ulong (xsock->local_addr),
scm_from_int ((int) xsock->local_port));
if (!SCM_UNBNDP (address))
{
SCM_ASSERT (scm_is_pair (address) && scm_is_integer (SCM_CAR (address))
&& scm_is_integer (SCM_CDR (address)), address, SCM_ARG2,
FUNC_NAME);
port = scm_to_uint16 (SCM_CDR (address));
xsock->local_addr = scm_to_ulong (SCM_CAR (address));
xsock->local_port = (unsigned short) port;
}
return pair;
}
static void
gnc_style_sheet_select_dialog_fill(StyleSheetDialog * ss)
{
SCM stylesheets = scm_c_eval_string("(gnc:get-html-style-sheets)");
SCM sheet_info;
/* pack it full of content */
for (; !scm_is_null(stylesheets); stylesheets = SCM_CDR(stylesheets))
{
sheet_info = SCM_CAR(stylesheets);
gnc_style_sheet_select_dialog_add_one(ss, sheet_info, FALSE);
}
}
static int
more_specificp (SCM m1, SCM m2, SCM const *targs)
{
register SCM s1, s2;
register long i;
/*
* Note:
* m1 and m2 can have != length (i.e. one can be one element longer than the
* other when we have a dotted parameter list). For instance, with the call
* (M 1)
* with
* (define-method M (a . l) ....)
* (define-method M (a) ....)
*
* we consider that the second method is more specific.
*
* BTW, targs is an array of types. We don't need it's size since
* we already know that m1 and m2 are applicable (no risk to go past
* the end of this array).
*
*/
for (i=0, s1=SPEC_OF(m1), s2=SPEC_OF(m2); ; i++, s1=SCM_CDR(s1), s2=SCM_CDR(s2)) {
if (scm_is_null(s1)) return 1;
if (scm_is_null(s2)) return 0;
if (!scm_is_eq (SCM_CAR(s1), SCM_CAR(s2))) {
register SCM l, cs1 = SCM_CAR(s1), cs2 = SCM_CAR(s2);
for (l = CPL_OF (targs[i]); ; l = SCM_CDR(l)) {
if (scm_is_eq (cs1, SCM_CAR (l)))
return 1;
if (scm_is_eq (cs2, SCM_CAR (l)))
return 0;
}
return 0;/* should not occur! */
}
}
return 0; /* should not occur! */
}
