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);
}
}
/*! \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;
}
/********************************************************************
* 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);
}
}
}
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);
}
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
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;
}
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;
}
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;
}
/* ADDRS is a list of socket addresses; if 'from' address type matches
one of them, it is used to store the information so that we can avoid
allocation. If no addresses match the incoming type, and ADDRS is
a complete list, the information of 'from' is discarded. If no addresses
match the incoming type, and the last cdr of ADDRS is #t (this case
includes ADDRS == #t), a new sockaddr is allocated and returned. */
ScmObj Scm_SocketRecvFromX(ScmSocket *sock, ScmUVector *buf,
ScmObj addrs, int flags)
{
int r;
u_int size;
struct sockaddr_storage from;
socklen_t fromlen = sizeof(from);
ScmObj addr = SCM_FALSE;
CLOSE_CHECK(sock->fd, "recv from", sock);
char *z = get_message_buffer(buf, &size);
SCM_SYSCALL(r, recvfrom(sock->fd, z, size, flags,
(struct sockaddr*)&from, &fromlen));
if (r < 0) {
Scm_SysError("recvfrom(2) failed");
}
ScmObj cp;
SCM_FOR_EACH(cp, addrs) {
ScmObj a = SCM_CAR(cp);
if (Scm_SockAddrP(a)) {
if (SCM_SOCKADDR_FAMILY(a) == from.ss_family) {
memcpy(&SCM_SOCKADDR(a)->addr, &from, SCM_SOCKADDR(a)->addrlen);
addr = a;
break;
}
}
}
ScmObj Scm_CopyList(ScmObj list)
{
if (!SCM_PAIRP(list)) return list;
ScmObj start = SCM_NIL, last = SCM_NIL;
SCM_FOR_EACH(list, list) {
SCM_APPEND1(start, last, SCM_CAR(list));
}
/*! \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;
}
/* 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 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;
}
/*! \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 void
gnc_column_view_edit_size_cb(GtkButton * button, gpointer user_data)
{
gnc_column_view_edit * r = user_data;
GtkWidget * rowspin;
GtkWidget * colspin;
GtkWidget * dlg;
GladeXML *xml;
SCM current;
int length;
int dlg_ret;
xml = gnc_glade_xml_new ("report.glade", "Edit Report Size");
dlg = glade_xml_get_widget (xml, "Edit Report Size");
/* get the spinner widgets */
rowspin = glade_xml_get_widget (xml, "row_spin");
colspin = glade_xml_get_widget (xml, "col_spin");
length = scm_ilength(r->contents_list);
if (length > r->contents_selected)
{
current = scm_list_ref(r->contents_list,
scm_int2num(r->contents_selected));
gtk_spin_button_set_value(GTK_SPIN_BUTTON(colspin),
(float)scm_num2int(SCM_CADR(current),
SCM_ARG1, G_STRFUNC));
gtk_spin_button_set_value(GTK_SPIN_BUTTON(rowspin),
(float)scm_num2int(SCM_CADDR(current),
SCM_ARG1, G_STRFUNC));
dlg_ret = gtk_dialog_run(GTK_DIALOG(dlg));
gtk_widget_hide(dlg);
if (dlg_ret == GTK_RESPONSE_OK)
{
current = SCM_LIST4(SCM_CAR(current),
scm_int2num(gtk_spin_button_get_value_as_int
(GTK_SPIN_BUTTON(colspin))),
scm_int2num(gtk_spin_button_get_value_as_int
(GTK_SPIN_BUTTON(rowspin))),
SCM_BOOL_F);
scm_gc_unprotect_object(r->contents_list);
r->contents_list = scm_list_set_x(r->contents_list,
scm_int2num(r->contents_selected),
current);
scm_gc_protect_object(r->contents_list);
gnc_options_dialog_changed (r->optwin);
update_display_lists(r);
}
gtk_widget_destroy(dlg);
}
}
GSList *
gnc_scm_to_gslist_string(SCM list)
{
GSList *gslist = NULL;
while (!scm_is_null (list))
{
if (scm_is_string(SCM_CAR(list)))
{
gchar * str;
str = gnc_scm_to_locale_string (SCM_CAR(list));
if (str)
gslist = g_slist_prepend (gslist, g_strdup (str));
g_free (str);
}
list = SCM_CDR (list);
}
return g_slist_reverse (gslist);
}
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;
}
static SCM touch_node(SCM doc, SCM args) {
MAKE_NODE *node;
node = (MAKE_NODE *)SCM_SMOB_DATA(doc);
scm_lock_mutex(node->mutex);
invalidate(node);
if (scm_is_null(args)) {
scm_unlock_mutex(node->mutex);
return SCM_BOOL_T;
}
switch (node->type) {
case TYPE_DATUM:
node->payload = SCM_CAR(args);
break;
case TYPE_FILE:
free(node->filepath);
node->filepath = scm_to_locale_string(SCM_CAR(args));
break;
}
scm_unlock_mutex(node->mutex);
scm_remember_upto_here_2(doc, args);
return SCM_BOOL_T;
}
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;
}
/*
* 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 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);
}
}
ScmObj Scm_MakeCompoundCondition(ScmObj conditions)
{
ScmObj h = SCM_NIL, t = SCM_NIL;
int serious = FALSE;
int nconds = Scm_Length(conditions);
/* some boundary cases */
if (nconds < 0) {
Scm_Error("Scm_MakeCompoundCondition: list required, but got %S",
conditions);
}
if (nconds == 0) {
return compound_allocate(SCM_CLASS_COMPOUND_CONDITION, SCM_NIL);
}
if (nconds == 1) {
if (!SCM_CONDITIONP(SCM_CAR(conditions))) {
Scm_Error("make-compound-condition: given non-condition object: %S", SCM_CAR(conditions));
}
return SCM_CAR(conditions);
}
/* collect conditions and creates compound one */
ScmObj cp;
SCM_FOR_EACH(cp, conditions) {
ScmObj c = SCM_CAR(cp);
if (!SCM_CONDITIONP(c)) {
Scm_Error("make-compound-condition: given non-condition object: %S", SCM_CAR(cp));
}
if (SCM_SERIOUS_CONDITION_P(c)) {
serious = TRUE;
}
if (SCM_COMPOUND_CONDITION_P(c)) {
ScmCompoundCondition *cc = SCM_COMPOUND_CONDITION(c);
SCM_APPEND(h, t, cc->conditions);
} else {
SCM_APPEND1(h, t, c);
}
}
int scm_is_alist(SCM x) {
SCM item;
if (!scm_is_list(x))
return 0;
while (!scm_is_null(x)) {
item = SCM_CAR(x);
if (!scm_is_pair(item))
return 0;
x = SCM_CDR(x);
}
return 1;
}
int scm_list_to_imht_set(SCM scm_a, imht_set_t **result) {
int a_length = scm_to_uint32((scm_length(scm_a)));
if (!imht_set_create((3 + a_length), result)) {
return (1);
};
while (!scm_is_null(scm_a)) {
if (!imht_set_add((*result), (scm_to_int((SCM_CAR(scm_a)))))) {
imht_set_destroy((*result));
return (2);
};
scm_a = SCM_CDR(scm_a);
};
return (0);
};
ScmObj Scm_DeleteKeyword(ScmObj key, ScmObj list)
{
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)) {
/* found */
ScmObj h = SCM_NIL, t = SCM_NIL;
ScmObj tail = Scm_DeleteKeyword(key, SCM_CDR(SCM_CDR(cp)));
ScmObj cp2;
SCM_FOR_EACH(cp2, list) {
if (cp2 == cp) {
SCM_APPEND(h, t, tail);
return h;
} else {
SCM_APPEND1(h, t, SCM_CAR(cp2));
}
}
}
cp = SCM_CDR(cp);
}
static void
gnc_edit_column_view_move_down_cb(GtkButton * button, gpointer user_data)
{
gnc_column_view_edit * r = user_data;
SCM oldlist = r->contents_list;
SCM newlist = SCM_EOL;
SCM temp;
int oldlength;
int count;
oldlength = scm_ilength(r->contents_list);
if (oldlength > (r->contents_selected + 1))
{
for (count = 0; count < r->contents_selected; count++)
{
newlist = scm_cons(SCM_CAR(oldlist), newlist);
oldlist = SCM_CDR(oldlist);
}
temp = SCM_CAR(oldlist);
oldlist = SCM_CDR(oldlist);
newlist = scm_cons(temp, scm_cons(SCM_CAR(oldlist), newlist));
newlist = scm_append(scm_listify(scm_reverse(newlist), SCM_CDR(oldlist), SCM_UNDEFINED));
scm_gc_unprotect_object(r->contents_list);
r->contents_list = newlist;
scm_gc_protect_object(r->contents_list);
r->contents_selected = r->contents_selected + 1;
gnc_column_view_set_option(r->odb, "__general", "report-list",
r->contents_list);
gnc_options_dialog_changed (r->optwin);
update_display_lists(r);
}
}
