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; }