/***************************************************************************
* test function
***************************************************************************/
int test() {
int code;
Tcl_Interp *interp;
interp = Tcl_CreateInterp();
Tk_Window tkwin;
tkwin=Tk_CreateMainWindow(interp,"unix:0.0","appName","className");
Tk_Window button;
button=Tk_CreateWindowFromPath(interp,tkwin,".appName","unix:0.0");
Tk_Window what;
what = Tk_NameToWindow(interp,".appName",tkwin);
what = Tk_NameToWindow(interp,".",tkwin);
Tk_MainLoop();
Tk_DestroyWindow(tkwin);
}
void install_tcltk (void) {
printf ("Video interface: TCL/TK\n");
interp=Tcl_CreateInterp ();
if (Tcl_Init (interp)==TCL_ERROR) {
printf ("Error in tcl interpreter init\n");
exit (1);
}
if (Tcl_EvalFile (interp,"/usr/lib/tcl/init.tcl")==TCL_ERROR) {
printf ("init.tcl script error <%s>\n",interp->result);
exit (1);
}
window=Tk_CreateMainWindow (interp,NULL,"rbd","rbd");
if (Tcl_EvalFile (interp,"/usr/lib/tk/tk.tcl")==TCL_ERROR) {
printf ("tk.tcl script error <%s>\n",interp->result);
exit (1);
}
}
jump_addr gui_call( void )
{
Tcl_Interp *interp;
int rc = 0;
COUNT_ARGS_AT_LEAST(1);
if (EQ(REG0,FALSE_OBJ))
{
COUNT_ARGS(1);
interp = Tcl_CreateInterp();
REG0 = RAW_PTR_TO_OBJ( interp );
}
else if (arg_count_reg > 2 && EQ(REG1,int2fx(4)))
{
obj info;
COUNT_ARGS(3);
interp = (Tcl_Interp *)OBJ_TO_RAW_PTR(REG0);
/* this hook creates a Scheme procedure
for calling the given Tcl command
The arguments to the scheme procedure had
better be strings, fixnums, or symbols.
*/
info = bvec_alloc( sizeof(Tcl_CmdInfo), byte_vector_class );
/*printf( "seeking info on `%s'\n", string_text(REG2) );*/
if (!Tcl_GetCommandInfo( interp,
(char *)string_text(REG2),
(Tcl_CmdInfo *)PTR_TO_DATAPTR(info) ))
{
REG0 = make_string( "command not found" );
REG1 = int2fx(1);
RETURN(1);
}
REG0 = make2(closure_class,
make4(bindingenvt_class,
NIL_OBJ,
info,
RAW_PTR_TO_OBJ(interp),
REG2 ),
make2(template_class,
JUMP_ADDR_TO_OBJ(tcl_gateway),
ZERO));
RETURN1();
}
else
{
COUNT_ARGS(2);
interp = (Tcl_Interp *)OBJ_TO_RAW_PTR(REG0);
if (EQ(REG1,int2fx(0)))
{
switch_hw_regs_back_to_os();
main_tk_win = Tk_CreateMainWindow( interp, NULL, "rs", "RScheme" );
if (!main_tk_win)
{
switch_hw_regs_into_scheme();
goto tcl_error;
}
printf( "main window = %#x\n", main_tk_win );
/*
Tk_GeometryRequest( main_tk_win, 200, 200 );
*/
Tcl_SetVar(interp, "tcl_interactive","0", TCL_GLOBAL_ONLY);
Tcl_CreateCommand(interp,
"scheme-callback",
the_callback,
(ClientData)0,
NULL);
switch_hw_regs_into_scheme();
if ((rc = Tcl_Init(interp)) == TCL_ERROR) {
goto tcl_error;
}
if ((rc = Tk_Init(interp)) == TCL_ERROR) {
goto tcl_error;
}
}
else if (EQ(REG1,int2fx(2)))
{
Tk_MakeWindowExist( main_tk_win );
RETURN0();
}
else if (EQ(REG1,int2fx(1)))
{
evts = NIL_OBJ;
switch_hw_regs_back_to_os();
Tk_DoOneEvent(TK_ALL_EVENTS|TK_DONT_WAIT);
switch_hw_regs_into_scheme();
REG0 = evts;
RETURN(1);
}
else if (EQ(REG1,int2fx(3)))
{
evts = NIL_OBJ;
/* flush events */
switch_hw_regs_back_to_os();
while (Tk_DoOneEvent(TK_ALL_EVENTS|TK_DONT_WAIT));
switch_hw_regs_into_scheme();
REG0 = evts;
RETURN(1);
}
else
{
assert( STRING_P(REG1) );
rc = Tcl_Eval( interp, (char *)string_text(REG1) );
}
REG0 = make_string( interp->result );
}
RETURN(1);
tcl_error:
REG0 = make_string( interp->result );
REG1 = int2fx(rc);
RETURN(2);
}
