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 void
gnc_edit_column_view_move_up_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 ((r->contents_selected > 0) && (oldlength > r->contents_selected))
{
for (count = 1; 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);
}
}
/* FIXME: needs comment: */
void
scm_scmval_print(LONGEST svalue, struct ui_file *stream, int format,
int deref_ref, int recurse, enum val_prettyprint pretty)
{
taloop:
switch (7 & (int)svalue)
{
case 2:
case 6:
print_longest(stream, (format ? format : 'd'), 1, (svalue >> 2));
break;
case 4:
if (SCM_ICHRP(svalue))
{
svalue = SCM_ICHR(svalue);
scm_printchar((int)svalue, stream);
break;
}
else if (SCM_IFLAGP(svalue)
&& ((size_t)SCM_ISYMNUM(svalue)
< (sizeof(scm_isymnames) / sizeof(char *))))
{
fputs_filtered(SCM_ISYMCHARS(svalue), stream);
break;
}
else if (SCM_ILOCP(svalue))
{
fprintf_filtered(stream, "#@%ld%c%ld",
(long)SCM_IFRAME(svalue),
(SCM_ICDRP(svalue) ? '-' : '+'),
(long)SCM_IDIST(svalue));
break;
}
else
goto idef;
break;
case 1:
/* gloc */
svalue = SCM_CAR (svalue - 1);
goto taloop;
default:
idef:
scm_ipruk ("immediate", svalue, stream);
break;
case 0:
switch (SCM_TYP7 (svalue))
{
case scm_tcs_cons_gloc:
if (SCM_CDR (SCM_CAR (svalue) - 1L) == 0)
{
#if 0
SCM name;
#endif /* 0 */
fputs_filtered ("#<latte ", stream);
#if 1
fputs_filtered ("???", stream);
#else
name = ((SCM n *) (STRUCT_TYPE (exp)))[struct_i_name];
scm_lfwrite (CHARS (name),
(sizet) sizeof (char),
(sizet) LENGTH (name),
port);
#endif /* 1 */
fprintf_filtered (stream, " #X%s>", paddr_nz (svalue));
break;
}
/* -Wimplicit-fallthrough vs. -Wdeclaration-after-statement: */
goto imcar_noncase_label;
imcar_noncase_label:
case scm_tcs_cons_imcar:
case scm_tcs_cons_nimcar:
fputs_filtered ("(", stream);
scm_scmlist_print (svalue, stream, format,
deref_ref, recurse + 1, pretty);
fputs_filtered (")", stream);
break;
case scm_tcs_closures:
fputs_filtered ("#<CLOSURE ", stream);
scm_scmlist_print (SCM_CODE (svalue), stream, format,
deref_ref, recurse + 1, pretty);
fputs_filtered (">", stream);
break;
case scm_tc7_string:
{
size_t len = SCM_LENGTH(svalue);
CORE_ADDR addr = (CORE_ADDR)SCM_CDR(svalue);
size_t i;
size_t done = 0UL;
size_t buf_size;
gdb_byte buffer[64];
int truncate = (print_max && (len > print_max));
if (truncate)
len = print_max;
fputs_filtered ("\"", stream);
for (; done < len; done += buf_size)
{
buf_size = min((len - done), 64);
read_memory((addr + done), buffer, (int)buf_size);
for (i = 0; i < buf_size; ++i)
switch (buffer[i])
{
case '\"':
case '\\':
fputs_filtered("\\", stream);
goto the_default_label;
the_default_label:
default:
fprintf_filtered(stream, "%c", buffer[i]);
}
}
fputs_filtered((truncate ? "...\"" : "\""), stream);
break;
}
break;
case scm_tcs_symbols:
{
const size_t len = min(SCM_LENGTH(svalue), MAX_ALLOCA_SIZE);
char *str = (char *)alloca(min(len, MAX_ALLOCA_SIZE));
read_memory(SCM_CDR(svalue), (gdb_byte *)str, (int)(len + 1));
/* Should handle weird characters, FIXME: do it. */
str[len] = '\0';
fputs_filtered(str, stream);
break;
}
case scm_tc7_vector:
{
long len = SCM_LENGTH(svalue);
int i;
LONGEST elements = SCM_CDR(svalue);
fputs_filtered ("#(", stream);
for (i = 0; i < len; ++i)
{
if (i > 0)
fputs_filtered (" ", stream);
scm_scmval_print (scm_get_field (elements, i), stream, format,
deref_ref, recurse + 1, pretty);
}
fputs_filtered (")", stream);
}
break;
#if 0
case tc7_lvector:
{
SCM result;
SCM hook;
hook = scm_get_lvector_hook (exp, LV_PRINT_FN);
if (hook == BOOL_F)
{
scm_puts ("#<locked-vector ", port);
scm_intprint (CDR (exp), 16, port);
scm_puts (">", port);
}
else
{
result
= scm_apply (hook,
scm_listify (exp, port,
(writing ? BOOL_T : BOOL_F),
SCM_UNDEFINED),
EOL);
if (result == BOOL_F)
goto punk;
}
break;
}
break;
case tc7_bvect:
case tc7_ivect:
case tc7_uvect:
case tc7_fvect:
case tc7_dvect:
case tc7_cvect:
scm_raprin1 (exp, port, writing);
break;
#endif /* 0 */
case scm_tcs_subrs:
{
int index = (int)(SCM_CAR(svalue) >> 8);
#if 1
char str[20];
snprintf(str, sizeof(str), "#%d", index);
#else
char *str = (index ? SCM_CHARS(scm_heap_org + index) : "");
# define SCM_CHARS(x) ((char *)(SCM_CDR(x)))
char *str = CHARS(SNAME(exp));
#endif /* 1 */
fprintf_filtered(stream, "#<primitive-procedure %s>",
str);
}
break;
#if 0
#ifdef CCLO
case tc7_cclo:
scm_puts ("#<compiled-closure ", port);
scm_iprin1 (CCLO_SUBR (exp), port, writing);
scm_putc ('>', port);
break;
#endif
case tc7_contin:
fprintf_filtered (stream, "#<continuation %d @ #X%lx >",
LENGTH (svalue),
(long) CHARS (svalue));
break;
case tc7_port:
i = PTOBNUM (exp);
if (i < scm_numptob
&& scm_ptobs[i].print
&& (scm_ptobs[i].print) (exp, port, writing))
break;
goto punk;
case tc7_smob:
i = SMOBNUM (exp);
if (i < scm_numsmob && scm_smobs[i].print
&& (scm_smobs[i].print) (exp, port, writing))
break;
goto punk;
#endif
default:
#if 0
punk:
#endif
scm_ipruk ("type", svalue, stream);
}
break;
}
}
static void
gnc_column_view_edit_add_cb(GtkButton * button, gpointer user_data)
{
gnc_column_view_edit * r = user_data;
SCM make_report = scm_c_eval_string("gnc:make-report");
SCM mark_report = scm_c_eval_string("gnc:report-set-needs-save?!");
SCM template_name;
SCM new_report;
SCM newlist = SCM_EOL;
SCM oldlist = r->contents_list;
int count;
int oldlength, id;
if (scm_is_list(r->available_list) &&
(scm_ilength(r->available_list) > r->available_selected))
{
template_name = scm_list_ref(r->available_list,
scm_int2num(r->available_selected));
new_report = scm_call_1(make_report, template_name);
id = scm_num2int(new_report, SCM_ARG1, G_STRFUNC);
scm_call_2(mark_report, gnc_report_find(id), SCM_BOOL_T);
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);
}
newlist = scm_append
(scm_listify(scm_reverse(scm_cons(SCM_LIST4(new_report,
scm_int2num(1),
scm_int2num(1),
SCM_BOOL_F),
newlist)),
oldlist,
SCM_UNDEFINED));
}
else
{
newlist = scm_append
(scm_listify(oldlist,
SCM_LIST1(SCM_LIST4(new_report,
scm_int2num(1),
scm_int2num(1),
SCM_BOOL_F)),
SCM_UNDEFINED));
r->contents_selected = oldlength;
}
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
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;
}
