static int command_proc(command_context_t* ctx, Tcl_Interp* interp, int argc, char** argv){ dfsch_object_t *head; dfsch_object_t *cur; dfsch_object_t *res; int i; int ret; head = cur = dfsch_multicons(argc-1); for(i = 1; i < argc; ++i){ DFSCH_FAST_CAR(cur) = dfsch_make_string_cstr(argv[i]); cur = DFSCH_FAST_CDR(cur); } DFSCH_SCATCH_BEGIN { res = dfsch_apply(ctx->proc, head); Tcl_SetResult(interp, dfsch_object_2_string(res, -1, 0), TCL_VOLATILE); ret = TCL_OK; } DFSCH_SCATCH { ret = TCL_ERROR; } DFSCH_SCATCH_END; return ret; }
DFSCH_DEFINE_PRIMITIVE(display, NULL){ dfsch_object_t* port; dfsch_object_t* object; char *buf; DFSCH_OBJECT_ARG(args, object); DFSCH_OBJECT_ARG_OPT(args, port, dfsch_current_output_port()); DFSCH_ARG_END(args); buf = dfsch_object_2_string(object, 1000, 0); dfsch_port_write_buf(port, buf, strlen(buf)); return NULL; }
static char* convert_arg(dfsch_object_t* obj){ if (dfsch_keyword_p(obj)){ char* str = dfsch_symbol(obj); if (strlen(str) == 1){ return dfsch_saprintf("-%s", str); } else { return dfsch_saprintf("--%s", str); } } else if (dfsch_string_p(obj)) { return dfsch_string_to_cstr(obj); } else { return dfsch_object_2_string(obj, 10, 1); } }
char* dfsch_tcl_quote_list(dfsch_object_t* list){ dfsch_str_list_t* sl = dfsch_sl_create(); dfsch_object_t* i; while (DFSCH_PAIR_P(list)){ dfsch_sl_append(sl, " "); i = DFSCH_FAST_CAR(list); if (dfsch_string_p(i)){ dfsch_sl_append(sl, dfsch_tcl_quote(dfsch_string_to_cstr(i))); } else if (dfsch_keyword_p(i)){ dfsch_sl_append(sl, dfsch_saprintf("-%s", dfsch_symbol(i))); } else if (DFSCH_PAIR_P(i)){ dfsch_sl_append(sl, dfsch_tcl_quote(dfsch_tcl_quote_list(i))); } else { dfsch_sl_append(sl, dfsch_tcl_quote(dfsch_object_2_string(i, 10, 1))); } list = DFSCH_FAST_CDR(list); } return dfsch_sl_value(sl); }