int
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#ifdef TCL_TEST
if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
(Tcl_PackageInitProc *) NULL);
if (TclObjTest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#endif /* TCL_TEST */
/*
* Call the init procedures for included packages. Each call should
* look like this:
*
* if (Mod_Init(interp) == TCL_ERROR) {
* return TCL_ERROR;
* }
*
* where "Mod" is the name of the module.
*/
if (Itcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Itcl", Itcl_Init, Itcl_SafeInit);
/*
* This is itclsh, so import all [incr Tcl] commands by
* default into the global namespace. Fix up the autoloader
* to do the same.
*/
if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
"::itcl::*", /* allowOverwrite */ 1) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_Eval(interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* }") != TCL_OK) {
return TCL_ERROR;
}
/*
* Call Tcl_CreateCommand for application-specific commands, if
* they weren't already created by the init procedures called above.
* Each call would loo like this:
*
* Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
*/
/*
* Specify a user-specific startup script to invoke if the application
* is run interactively. On the Mac we can specifiy either a TEXT resource
* which contains the script or the more UNIX like file location
* may also used. (I highly recommend using the resource method.)
*/
Tcl_SetVar(interp, "tcl_rcRsrcName", "itclshrc", TCL_GLOBAL_ONLY);
/* Tcl_SetVar(interp, "tcl_rcFileName", "~/.itclshrc", TCL_GLOBAL_ONLY); */
return TCL_OK;
}
int
Cad_AppInit(Tcl_Interp *interp)
{
/* Locate the BRL-CAD-specific Tcl scripts, set the auto_path */
tclcad_auto_path(interp);
/* Initialize [incr Tcl] */
/* NOTE: Calling "package require Itcl" here is apparently
* insufficient without other changes elsewhere. The Combination
* Editor in mged fails with an iwidgets class already loaded
* error if we don't perform Itcl_Init() here.
*/
if (Itcl_Init(interp) == TCL_ERROR) {
bu_log("Itcl_Init ERROR:\n%s\n", Tcl_GetStringResult(interp));
return TCL_ERROR;
}
#ifdef BWISH
/* Initialize [incr Tk] */
if (Itk_Init(interp) == TCL_ERROR) {
bu_log("Itk_Init ERROR:\n%s\n", Tcl_GetStringResult(interp));
return TCL_ERROR;
}
#endif
#ifdef IMPORT_ITCL
/* Import [incr Tcl] commands into the global namespace. */
if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
"::itcl::*", /* allowOverwrite */ 1) != TCL_OK) {
bu_log("Tcl_Import ERROR:\n%s\n", Tcl_GetStringResult(interp));
return TCL_ERROR;
}
#endif /* IMPORT_ITCL */
#ifdef BWISH
# ifdef IMPORT_ITK
/* Import [incr Tk] commands into the global namespace */
if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
"::itk::*", /* allowOverwrite */ 1) != TCL_OK) {
bu_log("Tcl_Import ERROR:\n%s\n", Tcl_GetStringResult(interp));
return TCL_ERROR;
}
# endif /* IMPORT_ITK */
/* Initialize the Iwidgets package */
if (Tcl_Eval(interp, "package require Iwidgets") != TCL_OK) {
bu_log("Tcl_Eval ERROR:\n%s\n", Tcl_GetStringResult(interp));
return TCL_ERROR;
}
# ifdef IMPORT_IWIDGETS
/* Import iwidgets into the global namespace */
if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
"::iwidgets::*", /* allowOverwrite */ 1) != TCL_OK) {
bu_log("Tcl_Import ERROR:\n%s\n", Tcl_GetStringResult(interp));
return TCL_ERROR;
}
# endif /* IMPORT_IWIDGETS */
#endif /* BWISH */
# ifdef IMPORT_ITCL
if (Tcl_Eval(interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* }") != TCL_OK) {
bu_log("Tcl_Eval ERROR:\n%s\n", Tcl_GetStringResult(interp));
return TCL_ERROR;
}
# endif
#ifdef BWISH
# ifdef IMPORT_ITCL
if (Tcl_Eval(interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::tk::* }") != TCL_OK) {
bu_log("Tcl_Eval ERROR:\n%s\n", Tcl_GetStringResult(interp));
return TCL_ERROR;
}
# endif
# ifdef IMPORT_ITK
if (Tcl_Eval(interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itk::* }") != TCL_OK) {
bu_log("Tcl_Eval ERROR:\n%s\n", Tcl_GetStringResult(interp));
return TCL_ERROR;
}
# endif
/* Initialize libdm */
if (Dm_Init(interp) == TCL_ERROR) {
bu_log("Dm_Init ERROR:\n%s\n", Tcl_GetStringResult(interp));
return TCL_ERROR;
}
/* Initialize libfb */
if (Fb_Init(interp) == TCL_ERROR) {
bu_log("Fb_Init ERROR:\n%s\n", Tcl_GetStringResult(interp));
return TCL_ERROR;
}
#endif
/* Initialize libbu */
if (Bu_Init(interp) == TCL_ERROR) {
bu_log("Bu_Init ERROR:\n%s\n", Tcl_GetStringResult(interp));
return TCL_ERROR;
}
/* Initialize libbn */
if (Bn_Init(interp) == TCL_ERROR) {
bu_log("Bn_Init ERROR:\n%s\n", Tcl_GetStringResult(interp));
return TCL_ERROR;
}
/* Initialize librt */
if (Rt_Init(interp) == TCL_ERROR) {
bu_log("Rt_Init ERROR:\n%s\n", Tcl_GetStringResult(interp));
return TCL_ERROR;
}
/* Initialize libtclcad's GED Object */
if (Go_Init(interp) == TCL_ERROR) {
bu_log("Go_Init ERROR:\n%s\n", Tcl_GetStringResult(interp));
return TCL_ERROR;
}
/* Initialize command history object */
Cho_Init(interp);
return TCL_OK;
}
static AP_Result tk_new(AP_World *w, AP_Obj interp_name)
{
AP_Result result;
Tcl_Interp *interp;
result = built_interp(w, &interp, &interp_name);
// Similar to 2009 note above, this cause Tk_Init to fail (tk.tcl not found)
#if 0
{
Tcl_DString path;
const char *elements[3];
Tcl_DStringInit(&path);
elements[0] = library_dir;
#ifdef macintosh
elements[1] = "Tool Command Language";
#else
elements[1] = "lib";
#endif
elements[2] = "tk" TK_VERSION;
Tcl_JoinPath(3, elements, &path);
Tcl_SetVar(interp, (char *)"tk_library", path.string, TCL_GLOBAL_ONLY);
Tcl_DStringFree(&path);
}
#endif
if (result == AP_SUCCESS) {
int r = Tk_Init(interp);
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
return AP_EXCEPTION;
}
#ifdef ITCL
r = Itk_Init(interp);
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
return AP_EXCEPTION;
}
Tcl_StaticPackage(interp, (char *)"Itk", Itk_Init, (Tcl_PackageInitProc *) NULL);
r = Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
(char *)"::itk::*", /* allowOverwrite */ 1);
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
return AP_EXCEPTION;
}
r = Tcl_Eval(interp, (char *)"auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* ::itk::* }");
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
return AP_EXCEPTION;
}
#endif
/*Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);*/
#ifdef macintosh
//TkMacInitAppleEvents(interp);
//TkMacInitMenus(interp);
//Tcl_SetVar(interp, "tcl_rcRsrcName", "tclshrc", TCL_GLOBAL_ONLY);
#endif
}
return result;
}
/*
* Initialize mged, configure the path, set up the tcl interpreter.
*/
void
mged_setup(Tcl_Interp **interpreter)
{
int try_auto_path = 0;
int init_tcl = 1;
int init_itcl = 1;
struct bu_vls str = BU_VLS_INIT_ZERO;
const char *name = bu_argv0_full_path();
/* locate our run-time binary (must be called before Tcl_CreateInterp()) */
if (name) {
Tcl_FindExecutable(name);
} else {
Tcl_FindExecutable("mged");
}
if (!interpreter ) {
bu_log("mged_setup Error - interpreter is NULL!\n");
return;
}
if (*interpreter != NULL)
Tcl_DeleteInterp(*interpreter);
/* Create the interpreter */
*interpreter = Tcl_CreateInterp();
/* a two-pass init loop. the first pass just tries default init
* routines while the second calls tclcad_auto_path() to help it
* find other, potentially uninstalled, resources.
*/
while (1) {
/* not called first time through, give Tcl_Init() a chance */
if (try_auto_path) {
/* Locate the BRL-CAD-specific Tcl scripts, set the auto_path */
tclcad_auto_path(*interpreter);
}
/* Initialize Tcl */
Tcl_ResetResult(*interpreter);
if (init_tcl && Tcl_Init(*interpreter) == TCL_ERROR) {
if (!try_auto_path) {
try_auto_path = 1;
continue;
}
bu_log("Tcl_Init ERROR:\n%s\n", Tcl_GetStringResult(*interpreter));
break;
}
init_tcl = 0;
/* Initialize [incr Tcl] */
Tcl_ResetResult(*interpreter);
/* NOTE: Calling "package require Itcl" here is apparently
* insufficient without other changes elsewhere. The
* Combination Editor in mged fails with an iwidgets class
* already loaded error if we don't perform Itcl_Init() here.
*/
if (init_itcl && Itcl_Init(*interpreter) == TCL_ERROR) {
if (!try_auto_path) {
Tcl_Namespace *nsp;
try_auto_path = 1;
/* Itcl_Init() leaves initialization in a bad state
* and can cause retry failures. cleanup manually.
*/
Tcl_DeleteCommand(*interpreter, "::itcl::class");
nsp = Tcl_FindNamespace(*interpreter, "::itcl", NULL, 0);
if (nsp)
Tcl_DeleteNamespace(nsp);
continue;
}
bu_log("Itcl_Init ERROR:\n%s\n", Tcl_GetStringResult(*interpreter));
break;
}
init_itcl = 0;
/* don't actually want to loop forever */
break;
} /* end iteration over Init() routines that need auto_path */
Tcl_ResetResult(*interpreter);
/* if we haven't loaded by now, load auto_path so we find our tclscripts */
if (!try_auto_path) {
/* Locate the BRL-CAD-specific Tcl scripts */
tclcad_auto_path(*interpreter);
}
/*XXX FIXME: Should not be importing Itcl into the global namespace */
/* Import [incr Tcl] commands into the global namespace. */
if (Tcl_Import(*interpreter, Tcl_GetGlobalNamespace(*interpreter), "::itcl::*", /* allowOverwrite */ 1) != TCL_OK) {
bu_log("Tcl_Import ERROR: %s\n", Tcl_GetStringResult(*interpreter));
Tcl_ResetResult(*interpreter);
}
/* Initialize libbu */
if (Bu_Init(*interpreter) == TCL_ERROR) {
bu_log("Bu_Init ERROR:\n%s\n", Tcl_GetStringResult(*interpreter));
Tcl_ResetResult(*interpreter);
}
/* Initialize libbn */
if (Bn_Init(*interpreter) == TCL_ERROR) {
bu_log("Bn_Init ERROR:\n%s\n", Tcl_GetStringResult(*interpreter));
Tcl_ResetResult(*interpreter);
}
/* Initialize librt */
if (Rt_Init(*interpreter) == TCL_ERROR) {
bu_log("Rt_Init ERROR:\n%s\n", Tcl_GetStringResult(*interpreter));
Tcl_ResetResult(*interpreter);
}
/* Initialize libged */
if (Go_Init(*interpreter) == TCL_ERROR) {
bu_log("Ged_Init ERROR:\n%s\n", Tcl_GetStringResult(*interpreter));
Tcl_ResetResult(*interpreter);
}
BU_ALLOC(view_state->vs_gvp, struct ged_view);
ged_view_init(view_state->vs_gvp);
view_state->vs_gvp->gv_callback = mged_view_callback;
view_state->vs_gvp->gv_clientData = (void *)view_state;
MAT_DELTAS_GET_NEG(view_state->vs_orig_pos, view_state->vs_gvp->gv_center);
if (gedp) {
/* release any allocated memory */
ged_free(gedp);
} else {
BU_ALLOC(gedp, struct ged);
}
GED_INIT(gedp, NULL);
/* register commands */
cmd_setup();
history_setup();
mged_global_variable_setup(*interpreter);
mged_variable_setup(*interpreter);
/* Tcl needs to write nulls onto subscripted variable names */
bu_vls_printf(&str, "%s(state)", MGED_DISPLAY_VAR);
Tcl_SetVar(*interpreter, bu_vls_addr(&str), state_str[STATE], TCL_GLOBAL_ONLY);
/* Set defaults for view status variables */
bu_vls_trunc(&str, 0);
bu_vls_printf(&str, "set mged_display(.topid_0.ur,ang) {ang=(0.00 0.00 0.00)};\
set mged_display(.topid_0.ur,aet) {az=35.00 el=25.00 tw=0.00};\
set mged_display(.topid_0.ur,size) sz=1000.000;\
set mged_display(.topid_0.ur,center) {cent=(0.000 0.000 0.000)};\
set mged_display(units) mm");
Tcl_Eval(*interpreter, bu_vls_addr(&str));
Tcl_ResetResult(*interpreter);
bu_vls_free(&str);
}
static AP_Result built_interp(AP_World *w, Tcl_Interp **interpretor, AP_Obj *interp_name)
{
Tcl_Interp *interp;
char name[128];
const char *namep;
Tcl_HashEntry *entry;
int is_new, pre_named;
AP_Type type;
int r;
type = AP_ObjType(w, *interp_name);
if (type != AP_VARIABLE && type != AP_ATOM) {
AP_SetStandardError(w, AP_TYPE_ERROR,
AP_NewSymbolFromStr(w, "atom_or_variable"), *interp_name);
goto error;
}
pre_named = (type == AP_ATOM);
#ifdef macintosh
// Tcl_MacSetEventProc(MyConvertEvent);
// SIOUXSetEventVector(MyHandleOneEvent);
#endif
interp = Tcl_CreateInterp();
if (!interp) {
AP_SetStandardError(w, AP_RESOURCE_ERROR, AP_NewSymbolFromStr(w, "tcl_memory"));
goto error;
}
/*
The following was causing a coredump on Mac OS X 10.5, and isn't necessary when
using the OS's Tcl/TK. Turned off for the moment.
TODO figure out why this is crashing on 10.5 - CEH 2009
*/
#if 0
{
Tcl_DString path;
const char *elements[3];
Tcl_DStringInit(&path);
elements[0] = library_dir;
#ifdef macintosh
elements[1] = "Tool Command Language";
#else
elements[1] = "lib";
#endif
elements[2] = "tcl" TCL_VERSION;
Tcl_JoinPath(3, (char **)elements, &path);
Tcl_SetVar(interp, (char *)"tcl_library", path.string, TCL_GLOBAL_ONLY);
Tcl_DStringSetLength(&path, 0);
Tcl_JoinPath(2, (char **)elements, &path);
Tcl_SetVar(interp, (char *)"tcl_pkgPath", path.string, TCL_GLOBAL_ONLY|TCL_LIST_ELEMENT);
Tcl_SetVar(interp, (char *)"autopath", (char *)"", TCL_GLOBAL_ONLY);
Tcl_DStringFree(&path);
}
#endif
r = Tcl_Init(interp);
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
goto error_delete;
}
#ifdef ITCL
r = Itcl_Init(interp);
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
goto error_delete;
}
Tcl_StaticPackage(interp, (char *)"Itcl", Itcl_Init, Itcl_SafeInit);
r = Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
(char *)"::itcl::*", /* allowOverwrite */ 1);
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
goto error_delete;
}
r = Tcl_Eval(interp,
(char *)"auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* }");
if (r != TCL_OK) {
TclToPrologResult(w, NULL, interp, r);
goto error_delete;
}
#endif
if (pre_named) {
namep = AP_GetAtomStr(w, *interp_name);
} else {
interp_count++;
sprintf(name, "tcl_interp%d", interp_count);
/* handle error */
namep = name;
}
entry = Tcl_CreateHashEntry(&tcl_interp_name_table, namep, &is_new);
if (!entry) {
AP_SetStandardError(w, AP_RESOURCE_ERROR, AP_NewSymbolFromStr(w, "tcl_memory"));
goto error_delete;
}
if (!is_new) {
AP_SetStandardError(w, AP_PERMISSION_ERROR,
AP_NewSymbolFromStr(w, "create"),
AP_NewSymbolFromStr(w, "tcl_interpreter"), *interp_name);
goto error_delete;
}
Tcl_SetHashValue(entry, interp);
if (ALSProlog_Package_Init(interp, w) != TCL_OK) {
AP_SetError(w, AP_NewSymbolFromStr(w, "tcl_create_command_error"));
goto error_delete;
}
*interpretor = interp;
return (pre_named) ? AP_SUCCESS : AP_Unify(w, *interp_name, AP_NewUIAFromStr(w, namep));
error_delete:
Tcl_DeleteInterp(interp);
error:
return AP_EXCEPTION;
}