void *tcl_gateway( void )
{
char **argp, *(args[102]);
Tcl_CmdInfo *info;
Tcl_Interp *interp;
char temp[1000], *d;
int i, rc;
assert( arg_count_reg <= 100 );
info = (Tcl_CmdInfo *)PTR_TO_DATAPTR(LEXREF0(0));
interp = (Tcl_Interp *)OBJ_TO_RAW_PTR(LEXREF0(1));
d = temp;
argp = args;
*argp++ = (char *)string_text( LEXREF0(2) );
for (i=0; i<arg_count_reg; i++)
{
obj arg;
arg = reg_ref(i);
if (STRING_P(arg))
{
*argp++ = (char *)string_text(arg);
}
else if (OBJ_ISA_FIXNUM(arg))
{
*argp++ = d;
sprintf( d, "%d", fx2int(arg) );
d += strlen(d) + 1;
}
else if (SYMBOL_P(arg))
{
*argp++ = (char *)symbol_text(arg);
}
else
{
scheme_error( "tcl_gateway: ~s invalid", 1, arg );
}
}
*argp++ = NULL;
Tcl_ResetResult( interp );
rc = info->proc( info->clientData,
interp,
arg_count_reg + 1,
args );
if (rc)
{
REG0 = make_string( interp->result );
REG1 = int2fx( rc );
RETURN(2);
}
else
{
if (interp->result[0])
REG0 = make_string( interp->result );
else
REG0 = TRUE_OBJ;
RETURN1();
}
}
Tcl_CmdInfo *eul_tk_create_widget(char *type, char *name, LispRef listArgs)
{
struct infoargs infoArgs;
ParseArguments2(&infoArgs, type, name, listArgs);
Tcl_CmdInfo cmdInfo = FindCreationFn(type);
int result = cmdInfo.proc
(
cmdInfo.clientData,
interp,
infoArgs.argc,
infoArgs.argv
);
Tcl_CmdInfo *newCmdInfo = (Tcl_CmdInfo *)gc_malloc(sizeof(Tcl_CmdInfo));
*newCmdInfo = (Tcl_CmdInfo){0, NULL, 0, NULL, 0, NULL, 0, NULL};
// It isn't clear what should be returned on error so return an empty
// structure allocated on free-store
if (result == TCL_ERROR)
{
return newCmdInfo;
}
result = Tcl_GetCommandInfo
(
interp,
Tcl_GetString(Tcl_GetObjResult(interp)),
newCmdInfo
);
return newCmdInfo;
}