static PyObject *
create_tcl_commands(PyObject * self, PyObject * args)
{
PyObject * app_or_interpaddr;
Tcl_Interp * interp;
if (!PyArg_ParseTuple(args, "O", &app_or_interpaddr))
return NULL;
if (PyInt_Check(app_or_interpaddr))
{
interp = (Tcl_Interp*)PyInt_AsLong(app_or_interpaddr);
}
else
{
interp = ((TkappObject*)app_or_interpaddr)->interp;
}
Tcl_CreateCommand(interp, "paxwidget", paxwidget_cmd,
(ClientData)Tk_MainWindow(interp), NULL);
Tcl_CreateCommand(interp, "call_py_method", call_py_method,
(ClientData)Tk_MainWindow(interp), NULL);
Py_INCREF(Py_None);
return Py_None;
}
int
Blt_GetWindowFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Window *windowPtr)
{
char *string;
string = Tcl_GetString(objPtr);
if (string[0] == '.') {
Tk_Window tkwin;
tkwin = Tk_NameToWindow(interp, string, Tk_MainWindow(interp));
if (tkwin == NULL) {
return TCL_ERROR;
}
if (Tk_WindowId(tkwin) == None) {
Tk_MakeWindowExist(tkwin);
}
*windowPtr = (Tk_IsTopLevel(tkwin)) ? Blt_GetWindowId(tkwin) :
Tk_WindowId(tkwin);
} else if (strcmp(string, "root") == 0) {
*windowPtr = Tk_RootWindow(Tk_MainWindow(interp));
} else {
static TkWinWindow tkWinWindow;
int id;
if (Tcl_GetIntFromObj(interp, objPtr, &id) != TCL_OK) {
return TCL_ERROR;
}
tkWinWindow.handle = (HWND)id;
tkWinWindow.winPtr = NULL;
tkWinWindow.type = TWD_WINDOW;
*windowPtr = (Window)&tkWinWindow;
}
return TCL_OK;
}
pure_expr *tk_main(void)
{
char *result = NULL;
if (tk_start(&result)) {
while (interp && Tk_MainWindow(interp) && Tcl_DoOneEvent(0)) ;
if (interp && !Tk_MainWindow(interp)) tk_stop();
return pure_tuplel(0);
} else
return tk_error(result);
}
int
TkplatformtestInit(
Tcl_Interp *interp) /* Interpreter to add commands to. */
{
/*
* Add commands for platform specific tests on MacOS here.
*/
Tcl_CreateObjCommand(interp, "testclipboard", TestclipboardObjCmd,
(ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testwinevent", TestwineventCmd,
(ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
}
/* ARGSUSED */
static int
BeepCmd(
ClientData clientData, /* Main window associated with interpreter.*/
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
int percent;
if (objc > 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
Tcl_GetString(objv[0]), " ?volumePercent?\"", (char *)NULL);
return TCL_ERROR;
}
percent = 50; /* Default setting */
if (objc == 2) {
if (Tcl_GetIntFromObj(interp, objv[1], &percent) != TCL_OK) {
return TCL_ERROR;
}
if (percent < -100) {
percent = -100;
} else if (percent > 100) {
percent = 100;
}
}
XBell(Tk_Display(Tk_MainWindow(interp)), percent);
return TCL_OK;
}
static PyObject *
name_to_window(PyObject * self, PyObject * args)
{
PyObject * app_or_interpaddr;
Tcl_Interp * interp;
Tk_Window tkwin;
char * name;
if (!PyArg_ParseTuple(args, "sO", &name, &app_or_interpaddr))
return NULL;
if (PyInt_Check(app_or_interpaddr))
{
interp = (Tcl_Interp*)PyInt_AsLong(app_or_interpaddr);
}
else
{
interp = ((TkappObject*)app_or_interpaddr)->interp;
}
tkwin = Tk_NameToWindow(interp, name, (ClientData)Tk_MainWindow(interp));
if (!tkwin)
{
PyErr_SetString(PyExc_ValueError, Tcl_GetStringResult(interp));
return NULL;
}
return TkWin_FromTkWindow(interp, tkwin);
}
bool
ParadynTkGUI::TryFirstCallGraphWindow( void )
{
if (haveSeenFirstCallGraphWindow)
return true;
Tk_Window topLevelTkWindow = Tk_MainWindow( interp );
Tk_Window theTkWindow = Tk_NameToWindow(interp,".callGraph.nontop.main.all",
topLevelTkWindow);
assert(theTkWindow);
if (Tk_WindowId(theTkWindow) == 0)
return false; // sigh...still invalid (that's why this routine is needed)
theCallGraphPrograms =
new callGraphs(".callGraph.titlearea.left.menu.mbar.program.m",
".callGraph.nontop.main.bottsb",
".callGraph.nontop.main.leftsb",
".callGraph.nontop.labelarea.current",
".callGraph.nontop.currprogramarea.label2",
interp, theTkWindow);
assert(theCallGraphPrograms);
initiateCallGraphRedraw(interp, true);
haveSeenFirstCallGraphWindow = true;
return true;
}
ClientData
Tk_GetImageMasterData(
Tcl_Interp *interp, /* Interpreter in which the image was
* created. */
const char *name, /* Name of image. */
const Tk_ImageType **typePtrPtr)
/* Points to location to fill in with pointer
* to type information for image. */
{
TkWindow *winPtr = (TkWindow *) Tk_MainWindow(interp);
Tcl_HashEntry *hPtr;
ImageMaster *masterPtr;
hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, name);
if (hPtr == NULL) {
*typePtrPtr = NULL;
return NULL;
}
masterPtr = Tcl_GetHashValue(hPtr);
if (masterPtr->deleted) {
*typePtrPtr = NULL;
return NULL;
}
*typePtrPtr = masterPtr->typePtr;
return masterPtr->masterData;
}
static int
AppInit(Tcl_Interp *interp)
{
Tk_Window mainWindow = Tk_MainWindow(interp);
/*
* 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 (Pltk_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
/*
* Call Tcl_CreateCommand for application-specific commands, if
* they weren't already created by the init procedures called above.
*/
Tcl_CreateCommand(interp, "myplot", (Tcl_CmdProc*) myplotCmd,
(ClientData) mainWindow, (Tcl_CmdDeleteProc*) NULL);
return TCL_OK;
}
bool
ParadynTkGUI::TryFirstWhereAxisWindow( void )
{
if (haveSeenFirstWhereAxisWindow)
return true;
Tk_Window topLevelTkWindow = Tk_MainWindow( interp );
Tk_Window theTkWindow = Tk_NameToWindow(interp, ".whereAxis.nontop.main.all",
topLevelTkWindow);
assert(theTkWindow);
if (Tk_WindowId(theTkWindow) == 0)
return false; // sigh...still invalid (that's why this routine is needed)
haveSeenFirstWhereAxisWindow = true;
theAbstractions = new abstractions("",
".whereAxis.top.mbar.nav.m",
".whereAxis.nontop.main.bottsb",
".whereAxis.nontop.main.leftsb",
".whereAxis.nontop.find.entry",
interp, theTkWindow);
assert(theAbstractions);
return true;
}
/*
* Our class command procedure. This is different from usual class command
* procs as we actually use the SheetCmd() procedure and then carefully
* subvert their actions to our own uses.
*/
static int NamesCmd(ClientData clientData, Tcl_Interp *interp,
int argc, char **argv) {
Tk_Window tkwin;
edNames *en;
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " pathName ?options?\"", (char *)NULL);
return TCL_ERROR;
}
/*
* Allocate
*/
if (NULL == (en = (edNames *)xmalloc(sizeof(edNames)))) {
return TCL_ERROR;
}
/*
* Call common sheet initialisation code
*/
tkwin = SheetCmdCommon(interp, Tk_MainWindow(interp),
configSpecs, (tkSheet *)en,
argv[1], "EdNames");
if (NULL == tkwin) {
xfree(en);
return TCL_ERROR;
}
/*
* Initialised rest of edNames structure.
*/
en->xx = NULL;
en->xScrollCmd = NULL;
TKSHEET(en)->extensionData = (ClientData)en;
TKSHEET(en)->extension = EdNamesSheetExtension;
/*
* Register our instance of the widget class
*/
Tcl_CreateCommand(interp, Tk_PathName(tkwin),
NamesWidgetCmd, (ClientData)en,
(Tcl_CmdDeleteProc *)NULL);
/*
* And process our arguments - send them to Configure
*/
if (NamesConfigure(interp, en, argc-2, argv+2, 0) != TCL_OK) {
Tk_DestroyWindow(tkwin);
return TCL_ERROR;
}
Tcl_SetResult(interp, Tk_PathName(tkwin), TCL_VOLATILE);
return TCL_OK;
}
static int
ImgBmapCmd(
ClientData clientData, /* Information about the image master. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *const bmapOptions[] = {"cget", "configure", NULL};
BitmapMaster *masterPtr = clientData;
int index;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], bmapOptions, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
switch (index) {
case 0: /* cget */
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "option");
return TCL_ERROR;
}
return Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs,
(char *) masterPtr, Tcl_GetString(objv[2]), 0);
case 1: /* configure */
if (objc == 2) {
return Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
configSpecs, (char *) masterPtr, NULL, 0);
} else if (objc == 3) {
return Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
configSpecs, (char *) masterPtr,
Tcl_GetString(objv[2]), 0);
} else {
return ImgBmapConfigureMaster(masterPtr, objc-2, objv+2,
TK_CONFIG_ARGV_ONLY);
}
default:
Tcl_Panic("bad const entries to bmapOptions in ImgBmapCmd");
return TCL_OK;
}
}
int
TkplatformtestInit(
Tcl_Interp *interp) /* Interpreter to add commands to. */
{
/*
* Add commands for platform specific tests on MacOS here.
*/
Tcl_CreateObjCommand(interp, "testclipboard", TestclipboardObjCmd,
(ClientData) Tk_MainWindow(interp), NULL);
Tcl_CreateObjCommand(interp, "testwinevent", TestwineventObjCmd,
(ClientData) Tk_MainWindow(interp), NULL);
Tcl_CreateObjCommand(interp, "testfindwindow", TestfindwindowObjCmd,
(ClientData) Tk_MainWindow(interp), NULL);
Tcl_CreateObjCommand(interp, "testgetwindowinfo", TestgetwindowinfoObjCmd,
(ClientData) Tk_MainWindow(interp), NULL);
Tcl_CreateObjCommand(interp, "testwinlocale", TestwinlocaleObjCmd,
(ClientData) Tk_MainWindow(interp), NULL);
return TCL_OK;
}
bool
ParadynTkGUI::TryFirstShgWindow( void )
{
// called in shgTcl.C
// like whereAxis's and barChart's techniques...
// Tk_WindowId() returns 0 until the tk window has been mapped for the first
// time, which takes a surprisingly long time. Therefore, this hack is needed.
if (haveSeenFirstShgWindow)
return true;
Tk_Window topLevelTkWindow = Tk_MainWindow( interp );
Tk_Window theTkWindow = Tk_NameToWindow(interp, ".shg.nontop.main.all",
topLevelTkWindow);
assert(theTkWindow);
if (Tk_WindowId(theTkWindow) == 0)
return false; // this happens in practice...that's why this routine is needed
haveSeenFirstShgWindow = true;
/* *********************************************************** */
// Why don't we construct "theShgPhases" earlier (perhaps at startup)?
// Why do we wait until the shg window has been opened?
// Because the constructor requires window names as arguments.
theShgPhases = new shgPhases(".shg.titlearea.left.menu.mbar.phase.m",
".shg.nontop.main.bottsb",
".shg.nontop.main.leftsb",
".shg.nontop.labelarea.current",
".shg.nontop.textarea.text",
".shg.nontop.buttonarea.left.search",
".shg.nontop.buttonarea.middle.pause",
".shg.nontop.currphasearea.label2",
interp, theTkWindow);
assert(theShgPhases);
// Now is as good a time as any to define the global phase.
const int GlobalPhaseId = 0; // a hardcoded constant
(void)theShgPhases->defineNewSearch(GlobalPhaseId,
"Global Phase");
// Also add the "current phase", if applicable.
// We check "latest_detected_new_phase_id", set by ui_newPhaseDetected (UImain.C)
if (latest_detected_new_phase_id >= 0) {
theShgPhases->defineNewSearch(latest_detected_new_phase_id,
latest_detected_new_phase_name);
}
initiateShgRedraw(interp, true);
return true;
}
void
ParadynTkGUI::CloseTkConnection( void )
{
#if !defined(i386_unknown_nt4_0)
Display* disp = Tk_Display( Tk_MainWindow(interp) );
int fd = XConnectionNumber( disp );
close( fd );
#else
// we don't need to worry about closing the Tk connection
// under Windows, because the process created by CreateProcess()
// doesn't interfere with our use of Tk
#endif // defined(i386_unknown_nt4_0)
}
int
Ucp_Init(Tcl_Interp *interp)
{
Tk_Window main;
Tcl_PkgProvide(interp, "Ucp", "3.0" ) ;
main = Tk_MainWindow(interp);
Tcl_CreateCommand(interp, "dpadm", dpadmCmd, main, NULL) ;
Tcl_CreateCommand(interp, "dcrt", dcrtCmd, main, NULL) ;
Tcl_CreateCommand(interp, "dprt", dprtCmd, main, NULL) ;
Tcl_CreateCommand(interp, "dcc", dccCmd, main, NULL) ;
return TCL_OK;
}
static Window
_GetSystemTray ()
{
char buffer[256];
Atom a;
snprintf (buffer, sizeof (buffer), "_NET_SYSTEM_TRAY_S%d",
XScreenNumberOfScreen(Tk_Screen(Tk_MainWindow(globalinterp))));
/* Get the X11 Atom */
a=XInternAtom (display, buffer, False);
/* And get the window ID associated to that atom */
return XGetSelectionOwner(display, a);
}
int
Tcl_AppInit(Tcl_Interp *interp)
{
Tk_Window main;
main = Tk_MainWindow(interp);
if (Tcl_Init(interp) == TCL_ERROR) {
PySys_WriteStderr("Tcl_Init error: %s\n", Tcl_GetStringResult(interp));
return TCL_ERROR;
}
if (Tk_Init(interp) == TCL_ERROR) {
PySys_WriteStderr("Tk_Init error: %s\n", Tcl_GetStringResult(interp));
return TCL_ERROR;
}
return TCL_OK;
}
static int
HoldBusy(
Tcl_HashTable *busyTablePtr,/* Busy hash table. */
Tcl_Interp *interp, /* Interpreter to report errors to. */
Tcl_Obj *const windowObj, /* Window name. */
int configObjc, /* Option pairs. */
Tcl_Obj *const configObjv[])
{
Tk_Window tkwin;
Tcl_HashEntry *hPtr;
Busy *busyPtr;
int isNew, result;
if (TkGetWindowFromObj(interp, Tk_MainWindow(interp), windowObj,
&tkwin) != TCL_OK) {
return TCL_ERROR;
}
hPtr = Tcl_CreateHashEntry(busyTablePtr, (char *) tkwin, &isNew);
if (isNew) {
busyPtr = CreateBusy(interp, tkwin);
if (busyPtr == NULL) {
return TCL_ERROR;
}
Tcl_SetHashValue(hPtr, busyPtr);
busyPtr->hashPtr = hPtr;
} else {
busyPtr = Tcl_GetHashValue(hPtr);
}
busyPtr->tablePtr = busyTablePtr;
result = ConfigureBusy(interp, busyPtr, configObjc, configObjv);
/*
* Don't map the busy window unless the reference window is also currently
* displayed.
*/
if (Tk_IsMapped(busyPtr->tkRef)) {
TkpShowBusyWindow(busyPtr);
} else {
TkpHideBusyWindow(busyPtr);
}
return result;
}
/*--------------------------------------------------------------------------*/
int sci_opentk(char *fname, unsigned long l)
{
Tcl_Interp *TCLinterpLocal = NULL;
CheckRhs(0, 0);
CheckLhs(1, 1);
TCLinterpLocal = Tcl_CreateInterp();
Tcl_Init(TCLinterpLocal);
Tk_Init(TCLinterpLocal);
TKmainWindow = Tk_MainWindow(TCLinterpLocal);
Tk_GeometryRequest(TKmainWindow, 200, 200);
Tk_SetWindowBackground(TKmainWindow, WhitePixelOfScreen(Tk_Screen(TKmainWindow)));
LhsVar(1) = 0;
PutLhsVar();
return 0;
}
void
Tk_DeleteImage(
Tcl_Interp *interp, /* Interpreter in which the image was
* created. */
const char *name) /* Name of image. */
{
Tcl_HashEntry *hPtr;
TkWindow *winPtr;
winPtr = (TkWindow *) Tk_MainWindow(interp);
if (winPtr == NULL) {
return;
}
hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, name);
if (hPtr == NULL) {
return;
}
DeleteImage(Tcl_GetHashValue(hPtr));
}
static bool tk_start(char **result)
{
static bool first_init = false;
Tk_Window mainw;
if (!first_init) {
first_init = true;
/* this works around a bug in some Tcl/Tk versions */
Tcl_FindExecutable(NULL);
/* finalize Tcl at program exit */
atexit(Tcl_Finalize);
}
*result = NULL;
if (interp) return true;
/* start up a new interpreter */
if (!(interp = Tcl_CreateInterp())) return false;
if (Tcl_Init(interp) != TCL_OK) {
if (check_result(interp))
set_result(result, get_result(interp));
else
set_result(result, "error initializing Tcl");
tk_stop();
return false;
}
/* create a command to invoke Pure callbacks from Tcl */
Tcl_CreateCommand(interp, "pure", (Tcl_CmdProc*)tk_pure,
(ClientData)0, NULL);
/* oddly, there are no `env' variables passed, and this one is needed */
Tcl_SetVar2(interp, "env", "DISPLAY", getenv("DISPLAY"), TCL_GLOBAL_ONLY);
if (Tk_Init(interp) != TCL_OK) {
if (check_result(interp))
set_result(result, get_result(interp));
else
set_result(result, "error initializing Tk");
tk_stop();
return false;
}
/* set up an X error handler */
mainw = Tk_MainWindow(interp);
Tk_CreateErrorHandler(Tk_Display(mainw), -1, -1, -1,
XErrorProc, (ClientData)mainw);
return true;
}
static Busy *
GetBusy(
Tcl_Interp *interp, /* Interpreter to look up main window of. */
Tcl_HashTable *busyTablePtr,/* Busy hash table */
Tcl_Obj *const windowObj) /* Path name of parent window */
{
Tcl_HashEntry *hPtr;
Tk_Window tkwin;
if (TkGetWindowFromObj(interp, Tk_MainWindow(interp), windowObj,
&tkwin) != TCL_OK) {
return NULL;
}
hPtr = Tcl_FindHashEntry(busyTablePtr, (char *) tkwin);
if (hPtr == NULL) {
Tcl_AppendResult(interp, "can't find busy window \"",
Tcl_GetString(windowObj), "\"", NULL);
return NULL;
}
return Tcl_GetHashValue(hPtr);
}
/* ARGSUSED */
static int
CutbufferCmd(
ClientData clientData, /* Main window associated with
* interpreter.*/
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
Tk_Window tkwin;
Tcl_ObjCmdProc *proc;
int result;
proc = Blt_GetOpFromObj(interp, numCbOps, cbOps, BLT_OP_ARG1,
objc, objv, 0);
if (proc == NULL) {
return TCL_ERROR;
}
tkwin = Tk_MainWindow(interp);
result = (*proc) (tkwin, interp, objc, objv);
return result;
}
int Configure (ClientData, Tcl_Interp *interp,
int, char **argv)
{
if (view.m_started)
{
Tk_Window win;
Tcl_Eval(interp, "set f $CVLkDemo::curframe");
win = Tk_NameToWindow(interp, interp->result,
Tk_MainWindow(interp));
Tk_MapWindow(win);
int w = Tk_Width(win);
int h = Tk_Height(win);
cvcamSetProperty(0, CVCAM_RNDWIDTH, (void*)&w);
cvcamSetProperty(0, CVCAM_RNDHEIGHT, (void*)&h);
view.SetSize(w,h);
}
return TCL_OK;
}
bool
grTkLoadFont()
{
Tk_Window tkwind;
int i;
char *s;
char *unable = "Unable to load font";
static char *fontnames[4] = {
TK_FONT_SMALL,
TK_FONT_MEDIUM,
TK_FONT_LARGE,
TK_FONT_XLARGE };
static char *optionnames[4] = {
"small",
"medium",
"large",
"xlarge"};
tkwind = Tk_MainWindow(magicinterp);
for (i = 0; i < 4; i++)
{
s = XGetDefault(grXdpy, "magic", optionnames[i]);
if (s) fontnames[i] = s;
if ((grTkFonts[i] = Tk_GetFont(magicinterp,
tkwind, fontnames[i])) == NULL)
{
TxError("%s %s\n", unable, fontnames[i]);
if ((grTkFonts[i] = Tk_GetFont(magicinterp,
tkwind, TK_DEFAULT_FONT)) == NULL)
{
TxError("%s %s\n", unable, TK_DEFAULT_FONT);
return FALSE;
}
}
}
return TRUE;
}
int ndutils_init(Tcl_Interp * interp)
{
Tk_Window w = Tk_MainWindow(interp);
/*Used by all three*/
Tcl_CreateCommand(interp, "ObjExistCheck", ObjExistCheck, (ClientData) w,
NULL);
/*Used by slicer*/
Tcl_CreateCommand(interp, "GetData", GetData, (ClientData) w, NULL);
Tcl_CreateCommand(interp, "GetDim", GetDim, (ClientData) w, NULL);
Tcl_CreateCommand(interp, "CreateClipPlane", CreateClipPlane,
(ClientData) w, NULL);
Tcl_CreateCommand(interp, "UpdatePicture", UpdatePicture, (ClientData) w,
NULL);
Tcl_CreateCommand(interp, "GetFocusCam", GetFocusCam, (ClientData) w,
NULL);
Tcl_CreateCommand(interp, "SliceNDice", SliceNDice, (ClientData) w,
NULL);
/*used by colormap*/
Tcl_CreateCommand(interp, "GeomExDir", GeomExDir, (ClientData) w, NULL);
Tcl_CreateCommand(interp, "setphoto", setphotoCmd, (ClientData) w, NULL);
Tcl_CreateCommand(interp, "colors", colorsCmd, (ClientData) w, NULL);
Tcl_CreateCommand(interp, "setmin", minCmd, (ClientData) w, NULL);
Tcl_CreateCommand(interp, "setmax", maxCmd, (ClientData) w, NULL);
/*used by colormap and 3dsnapshot*/
Tcl_CreateCommand(interp, "DoProjection", DoProjection, (ClientData) w,
NULL);
infile = iobfileopen(stdin);
initSlicer();
return TCL_OK;
}
PyObject *install(PyObject *s, PyObject *arg) {
Tcl_Interp *trp = get_interpreter(arg);
if(!trp) {
PyErr_SetString(PyExc_TypeError, "get_interpreter() returned NULL");
return NULL;
}
if (Tcl_InitStubs(trp, "8.1", 0) == NULL)
{
PyErr_SetString(PyExc_RuntimeError, "Tcl_InitStubs returned NULL");
return NULL;
}
if (Tk_InitStubs(trp, "8.1", 0) == NULL)
{
PyErr_SetString(PyExc_RuntimeError, "Tk_InitStubs returned NULL");
return NULL;
}
if (Tcl_PkgPresent(trp, "Togl", TOGL_VERSION, 0)) {
Py_INCREF(Py_None);
return Py_None;
}
if (Tcl_PkgProvide(trp, "Togl", TOGL_VERSION) != TCL_OK) {
PyErr_Format(PyExc_RuntimeError, "Tcl_PkgProvide failed: %s", Tcl_GetStringResult(trp));
return NULL;
}
Tcl_CreateCommand(trp, "togl", (Tcl_CmdProc *)Togl_Cmd,
(ClientData) Tk_MainWindow(trp), NULL);
if(first_time) {
Tcl_InitHashTable(&CommandTable, TCL_STRING_KEYS);
first_time = 0;
}
Py_INCREF(Py_None);
return Py_None;
}
/* Initialisation, based on tkMain.c */
value camltk_opentk(value argv) /* ML */
{
/* argv must contain argv[0], the application command name */
value tmp = Val_unit;
char *argv0;
Begin_root(tmp);
if ( argv == Val_int(0) ){
failwith("camltk_opentk: argv is empty");
}
argv0 = String_val( Field( argv, 0 ) );
if (!cltk_slave_mode) {
/* Create an interpreter, dies if error */
#if TCL_MAJOR_VERSION >= 8
Tcl_FindExecutable(String_val(argv0));
#endif
cltclinterp = Tcl_CreateInterp();
if (Tcl_Init(cltclinterp) != TCL_OK)
tk_error(cltclinterp->result);
Tcl_SetVar(cltclinterp, "argv0", String_val (argv0), TCL_GLOBAL_ONLY);
{ /* Sets argv if needed */
int argc = 0;
tmp = Field(argv, 1); /* starts from argv[1] */
while ( tmp != Val_int(0) ) {
argc++;
tmp = Field(tmp, 1);
}
if( argc != 0 ){
int i;
char *args;
char **tkargv;
char argcstr[256];
tkargv = malloc( sizeof( char* ) * argc );
tmp = Field(argv, 1); /* starts from argv[1] */
i = 0;
while ( tmp != Val_int(0) ) {
tkargv[i] = String_val(Field(tmp, 0));
tmp = Field(tmp, 1);
i++;
}
sprintf( argcstr, "%d", argc );
Tcl_SetVar(cltclinterp, "argc", argcstr, TCL_GLOBAL_ONLY);
args = Tcl_Merge(argc, tkargv); /* args must be freed by Tcl_Free */
Tcl_SetVar(cltclinterp, "argv", args, TCL_GLOBAL_ONLY);
Tcl_Free(args);
free( tkargv );
}
}
if (Tk_Init(cltclinterp) != TCL_OK)
tk_error(cltclinterp->result);
/* Retrieve the main window */
cltk_mainWindow = Tk_MainWindow(cltclinterp);
if (NULL == cltk_mainWindow)
tk_error(cltclinterp->result);
Tk_GeometryRequest(cltk_mainWindow,200,200);
}
/* Create the camlcallback command */
Tcl_CreateCommand(cltclinterp,
CAMLCB, CamlCBCmd,
(ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
/* This is required by "unknown" and thus autoload */
Tcl_SetVar(cltclinterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
/* Our hack for implementing break in callbacks */
Tcl_SetVar(cltclinterp, "BreakBindingsSequence", "0", TCL_GLOBAL_ONLY);
/* Load the traditional rc file */
{
char *home = getenv("HOME");
if (home != NULL) {
char *f = stat_alloc(strlen(home)+strlen(RCNAME)+2);
f[0]='\0';
strcat(f, home);
strcat(f, "/");
strcat(f, RCNAME);
if (0 == access(f,R_OK))
if (TCL_OK != Tcl_EvalFile(cltclinterp,f)) {
stat_free(f);
tk_error(cltclinterp->result);
};
stat_free(f);
}
}
End_roots();
return Val_unit;
}
int
Tk_CreateConsoleWindow(
Tcl_Interp *interp) /* Interpreter to use for prompting. */
{
Tcl_Channel chan;
ConsoleInfo *info;
Tk_Window mainWindow;
Tcl_Command token;
int result = TCL_OK;
int haveConsoleChannel = 1;
/* Init an interp with Tcl and Tk */
Tcl_Interp *consoleInterp = Tcl_CreateInterp();
if (Tcl_Init(consoleInterp) != TCL_OK) {
goto error;
}
if (Tk_Init(consoleInterp) != TCL_OK) {
goto error;
}
/*
* Fetch the instance data from whatever std channel is a
* console channel. If none, create fresh instance data.
*/
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
== &consoleChannelType) {
} else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
== &consoleChannelType) {
} else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
== &consoleChannelType) {
} else {
haveConsoleChannel = 0;
}
if (haveConsoleChannel) {
ChannelData *data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
info = data->info;
if (info->consoleInterp) {
/* New ConsoleInfo for a new console window */
info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
info->refCount = 0;
/* Update any console channels to make use of the new console */
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
== &consoleChannelType) {
data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
data->info->refCount--;
data->info = info;
data->info->refCount++;
}
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
== &consoleChannelType) {
data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
data->info->refCount--;
data->info = info;
data->info->refCount++;
}
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
== &consoleChannelType) {
data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
data->info->refCount--;
data->info = info;
data->info->refCount++;
}
}
} else {
info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
info->refCount = 0;
}
info->consoleInterp = consoleInterp;
info->interp = interp;
Tcl_CallWhenDeleted(consoleInterp, InterpDeleteProc, info);
info->refCount++;
Tcl_CreateThreadExitHandler(DeleteConsoleInterp, consoleInterp);
/*
* Add console commands to the interp
*/
token = Tcl_CreateObjCommand(interp, "console", ConsoleObjCmd, info,
ConsoleDeleteProc);
info->refCount++;
/*
* We don't have to count the ref held by the [consoleinterp] command
* in the consoleInterp. The ref held by the consoleInterp delete
* handler takes care of us.
*/
Tcl_CreateObjCommand(consoleInterp, "consoleinterp", InterpreterObjCmd,
info, NULL);
mainWindow = Tk_MainWindow(interp);
if (mainWindow) {
Tk_CreateEventHandler(mainWindow, StructureNotifyMask,
ConsoleEventProc, info);
info->refCount++;
}
Tcl_Preserve(consoleInterp);
result = Tcl_GlobalEval(consoleInterp, "source $tk_library/console.tcl");
if (result == TCL_ERROR) {
Tcl_SetReturnOptions(interp,
Tcl_GetReturnOptions(consoleInterp, result));
Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
}
Tcl_Release(consoleInterp);
if (result == TCL_ERROR) {
Tcl_DeleteCommandFromToken(interp, token);
mainWindow = Tk_MainWindow(interp);
if (mainWindow) {
Tk_DeleteEventHandler(mainWindow, StructureNotifyMask,
ConsoleEventProc, info);
if (--info->refCount <= 0) {
ckfree((char *) info);
}
}
goto error;
}
return TCL_OK;
error:
Tcl_AddErrorInfo(interp, "\n (creating console window)");
if (!Tcl_InterpDeleted(consoleInterp)) {
Tcl_DeleteInterp(consoleInterp);
}
return TCL_ERROR;
}
