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