static void
gdbtk_command_loop (void)
{
extern FILE *instream;
/* We no longer want to use stdin as the command input stream */
instream = NULL;
if (Tcl_Eval (gdbtk_interp, "gdbtk_tcl_preloop") != TCL_OK)
{
const char *msg;
/* Force errorInfo to be set up propertly. */
Tcl_AddErrorInfo (gdbtk_interp, "");
msg = Tcl_GetVar (gdbtk_interp, "errorInfo", TCL_GLOBAL_ONLY);
#ifdef _WIN32
MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
#else
fputs_unfiltered (msg, gdb_stderr);
#endif
}
#ifdef _WIN32
close_bfds ();
#endif
Tk_MainLoop ();
}
/*
*----------------------------------------------------------------------
*
* MainEx -- Main program for Tk-based applications.
*
*----------------------------------------------------------------------
*/
void
MainEx( int argc, char** argv, Tcl_AppInitProc *appInitProc,
Tcl_Interp *pintrp, char *fileName )
{
int code;
(*appInitProc)(pintrp);
if ( Commands_Init(pintrp) != TCL_OK)
Panic (pintrp,"Can't initialise commands!");
char set_path[1000];
strcat( strcat( strcpy( set_path, "set ::image_path \"" ), module_path ), "\"" );
code = Tcl_Eval( pintrp, set_path );
if (fileName != NULL)
{
char script[1000];
strcat( strcat( strcpy( script, module_path ), "" ), fileName );
code = Tcl_EvalFile(pintrp, script);
if (code != TCL_OK)
Panic (pintrp,"Evaluate file error!");
}
else Tcl_SourceRCFile(pintrp);
Tcl_ResetResult(pintrp);
Tk_MainLoop();
Tcl_DeleteInterp(pintrp);
return;
}
void XGStart()
{
char thePDumpFile[80], thePDFRoot[80];
strncpy(thePDFRoot,theDumpFile,findlen(theDumpFile));
thePDFRoot[findlen(theDumpFile)] = '\0';
while (!theExitFlag) {
if (theRunWithXFlag == TRUE) {
SortWindows();
if(numberOfSpecials!=0)
if(Tcl_Eval(interp,"CreateSpecialDialog\n")!=TCL_OK) {
printf("Error creating Special Dialog\n");
printf("%s\n",interp->result);
}
sprintf(TclCommand,"UpdateTime %g ; DoGraphics; update idletasks\n",*theTimeStep);
/* Tcl_Eval(interp,TclCommand); put below */
if(Tcl_Eval(interp,"Tk_XGStart\n")!=TCL_OK) {
printf("Error calling Tk_XGStart\n");
}
Tcl_Eval(interp,TclCommand);
if (theNumberOfSteps != 0) {
Tcl_Eval(interp,".lbframe.run invoke\n");
}
/* Change the procedure for the HUP signal. */
signal(SIGUSR1, Signal_KillGraphicsProc);
Tk_MainLoop();
}
if (theRunWithXFlag == FALSE) {
signal(SIGUSR1, Signal_RestoreGraphicsProc);
while ((theNumberOfSteps==0 || theCurrentStep<=theNumberOfSteps) &&
(theRunWithXFlag == FALSE)) {
XGMainLoop();
if (theDumpPeriod!=0 && theCurrentStep%theDumpPeriod==0) {
sprintf(thePDumpFile,"%s%d%s",thePDFRoot,
theCurrentStep/theDumpPeriod,theDumpExtension);
if (theIDumpFlag) Dump(thePDumpFile);
else Dump(theDumpFile);
}
theCurrentStep++;
}
if ((theDumpPeriod!=0) && (theCurrentStep%theDumpPeriod==0)) {
sprintf(thePDumpFile,"%s%d%s",thePDFRoot,
theCurrentStep/theDumpPeriod,theDumpExtension);
if (theIDumpFlag) Dump(thePDumpFile);
else Dump(theDumpFile);
}
if(theCurrentStep>theNumberOfSteps && (theRunWithXFlag == FALSE)) {
XG_Quit();
}
if (theRunWithXFlag == TRUE) StartGraphics();
}
}
XG_Quit();
}
CAMLprim value camltk_tk_mainloop(void)
{
CheckInit();
if (cltk_slave_mode) return Val_unit;
if (!signal_events) {
/* Initialise signal handling */
signal_events = 1;
Tk_CreateTimerHandler(100, invoke_pending_caml_signals, NULL);
}
Tk_MainLoop();
return Val_unit;
}
void tcltk_set_graph_mode (int mode, void (*drawimage)()) {
if (Tcl_EvalFile (interp,"rbd.tcl")==TCL_ERROR) {
printf ("rbd.tcl script error <%s>\n",interp->result);
exit (1);
}
canvas=Tk_NameToWindow (interp,".c",window);
if (canvas==NULL) {
printf ("Error: <%s>\n",interp->result);
}
gen_image=drawimage;
Tcl_CreateCommand
(interp,"drawimage",draw_image,(ClientData)window,NULL);
Tk_CreateEventHandler
(canvas,ExposureMask,(Tk_EventProc *)expose_handler,(ClientData)canvas);
Tk_MainLoop ();
}
/***************************************************************************
* 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
Tk_MainEx(
int argc, /* Number of arguments. */
TCHAR **argv, /* Array of argument strings. */
Tcl_AppInitProc *appInitProc,
/* Application-specific initialization
* function to call after most initialization
* but before starting to execute commands. */
Tcl_Interp *interp)
{
Tcl_Obj *path, *argvPtr, *appName;
const char *encodingName;
int code, nullStdin = 0;
Tcl_Channel chan;
InteractiveState is;
/*
* Ensure that we are getting a compatible version of Tcl. This is really
* only an issue when Tk is loaded dynamically.
*/
if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
abort();
}
#if defined(__WIN32__) && !defined(__WIN64__) && !defined(UNICODE) && !defined(STATIC_BUILD)
if (tclStubsPtr->reserved9) {
/* We are running win32 Tk under Cygwin, so let's check
* whether the env("DISPLAY") variable or the -display
* argument is set. If so, we really want to run the
* Tk_MainEx function of libtk8.?.dll, not this one. */
if (Tcl_GetVar2(interp, "env", "DISPLAY", TCL_GLOBAL_ONLY)) {
loadCygwinTk:
if (TkCygwinMainEx(argc, argv, appInitProc, interp)) {
/* Should never reach here. */
return;
}
} else {
int i;
for (i = 1; i < argc; ++i) {
if (!_tcscmp(argv[i], TEXT("-display"))) {
goto loadCygwinTk;
}
}
}
}
#endif
Tcl_InitMemory(interp);
is.interp = interp;
is.gotPartial = 0;
Tcl_Preserve(interp);
#if defined(__WIN32__) && !defined(__CYGWIN__)
Tk_InitConsoleChannels(interp);
#endif
#ifdef MAC_OSX_TK
if (Tcl_GetStartupScript(NULL) == NULL) {
TkMacOSXDefaultStartupScript();
}
#endif
/*
* If the application has not already set a startup script, parse the
* first few command line arguments to determine the script path and
* encoding.
*/
if (NULL == Tcl_GetStartupScript(NULL)) {
size_t length;
/*
* Check whether first 3 args (argv[1] - argv[3]) look like
* -encoding ENCODING FILENAME
* or like
* FILENAME
* or like
* -file FILENAME (ancient history support only)
*/
if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
&& (TEXT('-') != argv[3][0])) {
Tcl_Obj *value = NewNativeObj(argv[2], -1);
Tcl_SetStartupScript(NewNativeObj(argv[3], -1), Tcl_GetString(value));
Tcl_DecrRefCount(value);
argc -= 3;
argv += 3;
} else if ((argc > 1) && (TEXT('-') != argv[1][0])) {
Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL);
argc--;
argv++;
} else if ((argc > 2) && (length = _tcslen(argv[1]))
&& (length > 1) && (0 == _tcsncmp(TEXT("-file"), argv[1], length))
&& (TEXT('-') != argv[2][0])) {
Tcl_SetStartupScript(NewNativeObj(argv[2], -1), NULL);
argc -= 2;
argv += 2;
}
}
path = Tcl_GetStartupScript(&encodingName);
if (path == NULL) {
appName = NewNativeObj(argv[0], -1);
} else {
appName = path;
}
Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY);
argc--;
argv++;
Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);
argvPtr = Tcl_NewListObj(0, NULL);
while (argc--) {
Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++, -1));
}
Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
/*
* Set the "tcl_interactive" variable.
*/
is.tty = isatty(0);
#if defined(MAC_OSX_TK)
/*
* On TkAqua, if we don't have a TTY and stdin is a special character file
* of length 0, (e.g. /dev/null, which is what Finder sets when double
* clicking Wish) then use the GUI console.
*/
if (!is.tty) {
struct stat st;
nullStdin = fstat(0, &st) || (S_ISCHR(st.st_mode) && !st.st_blocks);
}
#endif
Tcl_SetVar2Ex(interp, "tcl_interactive", NULL,
Tcl_NewIntObj(!path && (is.tty || nullStdin)), TCL_GLOBAL_ONLY);
/*
* Invoke application-specific initialization.
*/
if (appInitProc(interp) != TCL_OK) {
TkpDisplayWarning(Tcl_GetStringResult(interp),
"application-specific initialization failed");
}
/*
* Invoke the script specified on the command line, if any. Must fetch it
* again, as the appInitProc might have reset it.
*/
path = Tcl_GetStartupScript(&encodingName);
if (path != NULL) {
Tcl_ResetResult(interp);
code = Tcl_FSEvalFileEx(interp, path, encodingName);
if (code != TCL_OK) {
/*
* The following statement guarantees that the errorInfo variable
* is set properly.
*/
Tcl_AddErrorInfo(interp, "");
TkpDisplayWarning(Tcl_GetVar(interp, "errorInfo",
TCL_GLOBAL_ONLY), "Error in startup script");
Tcl_DeleteInterp(interp);
Tcl_Exit(1);
}
is.tty = 0;
} else {
/*
* Evaluate the .rc file, if one has been specified.
*/
Tcl_SourceRCFile(interp);
/*
* Establish a channel handler for stdin.
*/
is.input = Tcl_GetStdChannel(TCL_STDIN);
if (is.input) {
Tcl_CreateChannelHandler(is.input, TCL_READABLE, StdinProc, &is);
}
if (is.tty) {
Prompt(interp, &is);
}
}
chan = Tcl_GetStdChannel(TCL_STDOUT);
if (chan) {
Tcl_Flush(chan);
}
Tcl_DStringInit(&is.command);
Tcl_DStringInit(&is.line);
Tcl_ResetResult(interp);
/*
* Loop infinitely, waiting for commands to execute. When there are no
* windows left, Tk_MainLoop returns and we exit.
*/
Tk_MainLoop();
Tcl_DeleteInterp(interp);
Tcl_Release(interp);
Tcl_SetStartupScript(NULL, NULL);
Tcl_Exit(0);
}
/*
** This routine runs first.
*/
int main(int argc, char **argv){
Tcl_Interp *interp;
char *args;
char buf[100];
int tty;
char TCLdir[20];
char TKdir[20];
char autopath[20];
char sourceCmd[80];
#ifdef WITHOUT_TK
Tcl_Obj *resultPtr;
Tcl_Obj *commandPtr = NULL;
char buffer[1000];
int code, gotPartial, length;
Tcl_Channel inChannel, outChannel, errChannel;
#endif
/* Create a Tcl interpreter
*/
Tcl_FindExecutable(argv[0]);
interp = Tcl_CreateInterp();
if( Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1)==0 ){
return 1;
}
args = Tcl_Merge(argc-1, (CONST84 char * CONST *)argv+1);
Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
ckfree(args);
sprintf(buf, "%d", argc-1);
Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "argv0", argv[0], TCL_GLOBAL_ONLY);
tty = isatty(0);
Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
/* We have to initialize the virtual filesystem before calling
** Tcl_Init(). Otherwise, Tcl_Init() will not be able to find
** its startup script files.
*/
Zvfs_Init(interp);
Tcl_SetVar(interp, "extname", "", TCL_GLOBAL_ONLY);
Zvfs_Mount(interp, (char *)Tcl_GetNameOfExecutable(), "/");
sprintf(TCLdir, "%s/tcl", mountPt);
Tcl_SetVar2(interp, "env", "TCL_LIBRARY", TCLdir, TCL_GLOBAL_ONLY);
sprintf(TKdir, "%s/tk", mountPt);
Tcl_SetVar2(interp, "env", "TK_LIBRARY", TKdir, TCL_GLOBAL_ONLY);
/* Initialize Tcl and Tk
*/
if( Tcl_Init(interp) ) return TCL_ERROR;
sprintf(autopath, " %s", TCLdir);
Tcl_SetVar(interp, "auto_path", autopath, TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
Tcl_SetVar(interp, "tcl_libPath", TCLdir, TCL_GLOBAL_ONLY);
#ifdef WITHOUT_TK
Tcl_SetVar(interp, "extname", "tclsh", TCL_GLOBAL_ONLY);
#else
Tk_InitConsoleChannels(interp);
if ( Tk_Init(interp) ) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp,"Tk", Tk_Init, 0);
Tk_CreateConsoleWindow(interp);
#endif
/* Start up all extensions.
*/
#if defined(__WIN32__)
/* DRL - Do the standard Windows extentions */
if (Registry_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Registry", Registry_Init, 0);
if (Dde_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Dde", Dde_Init, 0);
#endif
#ifndef WITHOUT_TDOM
if (Tdom_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tdom", Tdom_Init, Tdom_SafeInit);
#endif
#ifndef WITHOUT_TLS
if (Tls_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tls", Tls_Init, Tls_SafeInit);
#endif
/*
#ifndef WITHOUT_MKZIPLIB
if (Mkziplib_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Mkziplib", Mkziplib_Init, Mkziplib_SafeInit);
#endif
*/
#ifndef WITHOUT_XOTCL
if (Xotcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Xotcl", Xotcl_Init, Xotcl_SafeInit);
/*
if (Xotclexpat_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "xotclexpat", Xotclexpat_Init, 0);
*/
/*
if (Xotclsdbm_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
*/
// Tcl_StaticPackage(interp, "xotclsdbm", Xotclsdbm_Init, Xotclsdbm_SafeInit);
/*
if (Xotclgdbm_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
*/
// Tcl_StaticPackage(interp, "xotclgdbm", Xotclgdbm_Init, Xotclgdbm_SafeInit);
#endif
#ifndef WITHOUT_TGDBM
if (Tgdbm_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tgdbm", Tgdbm_Init, 0);
#endif
#ifndef WITHOUT_THREAD
if (Thread_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Thread", Thread_Init, 0);
#endif
#if !defined(WITHOUT_TK) && !defined(WITHOUT_WINICO) && (defined(__WIN32__) || defined(_WIN32))
if (Winico_Init(interp) == TCL_ERROR) return TCL_ERROR;
Tcl_StaticPackage(interp, "Winico", Winico_Init, Winico_SafeInit);
#endif
/* Add some freeWrap commands */
if (Freewrap_Init(interp) == TCL_ERROR) return TCL_ERROR;
/* After all extensions are registered, start up the
** program by running freewrapCmds.tcl.
*/
sprintf(sourceCmd, "source %s/freewrapCmds.tcl", mountPt);
Tcl_Eval(interp, sourceCmd);
#ifndef WITHOUT_TK
/*
* Loop infinitely, waiting for commands to execute. When there
* are no windows left, Tk_MainLoop returns and we exit.
*/
Tk_MainLoop();
Tcl_DeleteInterp(interp);
Tcl_Exit(0);
#else
/*
* Process commands from stdin until there's an end-of-file. Note
* that we need to fetch the standard channels again after every
* eval, since they may have been changed.
*/
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
gotPartial = 0;
while (1) {
if (tty) {
Tcl_Obj *promptCmdPtr;
promptCmdPtr = Tcl_GetVar2Ex(interp,
(gotPartial ? "tcl_prompt2" : "tcl_prompt1"),
NULL, TCL_GLOBAL_ONLY);
if (promptCmdPtr == NULL) {
defaultPrompt:
if (!gotPartial && outChannel) {
Tcl_WriteChars(outChannel, "% ", 2);
}
} else {
code = Tcl_EvalObjEx(interp, promptCmdPtr, 0);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (code != TCL_OK) {
if (errChannel) {
Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
Tcl_WriteChars(errChannel, "\n", 1);
}
Tcl_AddErrorInfo(interp,
"\n (script that generates prompt)");
goto defaultPrompt;
}
}
if (outChannel) {
Tcl_Flush(outChannel);
}
}
if (!inChannel) {
goto done;
}
length = Tcl_GetsObj(inChannel, commandPtr);
if (length < 0) {
goto done;
}
if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) {
goto done;
}
/*
* Add the newline removed by Tcl_GetsObj back to the string.
*/
Tcl_AppendToObj(commandPtr, "\n", 1);
if (!TclObjCommandComplete(commandPtr)) {
gotPartial = 1;
continue;
}
gotPartial = 0;
code = Tcl_RecordAndEvalObj(interp, commandPtr, 0);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
errChannel = Tcl_GetStdChannel(TCL_STDERR);
Tcl_DecrRefCount(commandPtr);
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
if (code != TCL_OK) {
if (errChannel) {
Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
Tcl_WriteChars(errChannel, "\n", 1);
}
} else if (tty) {
resultPtr = Tcl_GetObjResult(interp);
Tcl_GetStringFromObj(resultPtr, &length);
if ((length > 0) && outChannel) {
Tcl_WriteObj(outChannel, resultPtr);
Tcl_WriteChars(outChannel, "\n", 1);
}
}
}
/*
* Rather than calling exit, invoke the "exit" command so that
* users can replace "exit" with some other command to do additional
* cleanup on exit. The Tcl_Eval call should never return.
*/
done:
if (commandPtr != NULL) {
Tcl_DecrRefCount(commandPtr);
}
sprintf(buffer, "exit %d", 0);
Tcl_Eval(interp, buffer);
#endif
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Tk_MainOpenSees --
*
* Main program for Wish and most other Tk-based applications.
*
* Results:
* None. This procedure never returns (it exits the process when
* it's done.
*
* Side effects:
* This procedure initializes the Tk world and then starts
* interpreting commands; almost anything could happen, depending
* on the script being interpreted.
*
*----------------------------------------------------------------------
*/
void
Tk_MainOpenSees(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp)
{
char *args, *fileName;
char buf[TCL_INTEGER_SPACE];
int code;
size_t length;
Tcl_Channel inChannel, outChannel;
Tcl_DString argString;
ThreadSpecificData *tsdPtr;
#ifdef __WIN32__
HANDLE handle;
#endif
/* fmk - beginning of modifications for OpenSees */
fprintf(stderr,"\n\n\t OpenSees -- Open System For Earthquake Engineering Simulation");
fprintf(stderr,"\n\tPacific Earthquake Engineering Research Center -- %s\n\n", OPS_VERSION);
fprintf(stderr,"\t (c) Copyright 1999 The Regents of the University of California");
fprintf(stderr,"\n\t\t\t\t All Rights Reserved \n\n\n");
fprintf(stderr,"\t(Copyright statement @ http://www.berkeley.edu/OpenSees/copyright.html)\n\n\n");
/* fmk - end of modifications for OpenSees */
/*
* Ensure that we are getting the matching version of Tcl. This is
* really only an issue when Tk is loaded dynamically.
*/
if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
abort();
}
tsdPtr = (ThreadSpecificData *)
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
Tcl_FindExecutable(argv[0]);
tsdPtr->interp = interp;
#if (defined(__WIN32__) || defined(MAC_TCL))
Tk_InitConsoleChannels(interp);
#endif
#ifdef TCL_MEM_DEBUG
Tcl_InitMemory(interp);
#endif
/*
* Parse command-line arguments. A leading "-file" argument is
* ignored (a historical relic from the distant past). If the
* next argument doesn't start with a "-" then strip it off and
* use it as the name of a script file to process.
*/
fileName = TclGetStartupScriptFileName();
if (argc > 1) {
length = strlen(argv[1]);
if ((length >= 2) && (strncmp(argv[1], "-file", length) == 0)) {
argc--;
argv++;
}
}
if (fileName == NULL) {
if ((argc > 1) && (argv[1][0] != '-')) {
fileName = argv[1];
argc--;
argv++;
}
}
OpenSeesParseArgv(argc, argv);
/*
* Make command-line arguments available in the Tcl variables "argc"
* and "argv".
*/
args = Tcl_Merge(argc-1, argv+1);
Tcl_ExternalToUtfDString(NULL, args, -1, &argString);
Tcl_SetVar(interp, "argv", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
Tcl_DStringFree(&argString);
ckfree(args);
sprintf(buf, "%d", argc-1);
if (fileName == NULL) {
Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString);
} else {
fileName = Tcl_ExternalToUtfDString(NULL, fileName, -1, &argString);
}
Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
/*
* Set the "tcl_interactive" variable.
*/
/*
* For now, under Windows, we assume we are not running as a console mode
* app, so we need to use the GUI console. In order to enable this, we
* always claim to be running on a tty. This probably isn't the right
* way to do it.
*/
#ifdef __WIN32__
handle = GetStdHandle(STD_INPUT_HANDLE);
if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)
|| (GetFileType(handle) == FILE_TYPE_UNKNOWN)) {
/*
* If it's a bad or closed handle, then it's been connected
* to a wish console window.
*/
tsdPtr->tty = 1;
} else if (GetFileType(handle) == FILE_TYPE_CHAR) {
/*
* A character file handle is a tty by definition.
*/
tsdPtr->tty = 1;
} else {
tsdPtr->tty = 0;
}
#else
tsdPtr->tty = isatty(0);
#endif
char one[2] = "1";
char zero[2] = "0";
Tcl_SetVar(interp, "tcl_interactive",
((fileName == NULL) && tsdPtr->tty) ? one : zero, TCL_GLOBAL_ONLY);
/*
* Invoke application-specific initialization.
*/
if ((*appInitProc)(interp) != TCL_OK) {
TkpDisplayWarning(Tcl_GetStringResult(interp), "Application Inititialization Failed");
}
/*
* Invoke the script specified on the command line, if any.
*/
if (fileName != NULL) {
Tcl_ResetResult(interp);
code = Tcl_EvalFile(interp, fileName);
if (code != TCL_OK) {
/*
* The following statement guarantees that the errorInfo
* variable is set properly.
*/
Tcl_AddErrorInfo(interp, "");
TkpDisplayWarning(Tcl_GetVar(interp, "error Info",
TCL_GLOBAL_ONLY), "Error in startup script");
Tcl_DeleteInterp(interp);
Tcl_Exit(1);
}
tsdPtr->tty = 0;
} else {
/*
* Evaluate the .rc file, if one has been specified.
*/
Tcl_SourceRCFile(interp);
/*
* Establish a channel handler for stdin.
*/
inChannel = Tcl_GetStdChannel(TCL_STDIN);
if (inChannel) {
Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
(ClientData) inChannel);
}
if (tsdPtr->tty) {
Prompt(interp, 0);
}
}
Tcl_DStringFree(&argString);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
if (outChannel) {
Tcl_Flush(outChannel);
}
Tcl_DStringInit(&tsdPtr->command);
Tcl_DStringInit(&tsdPtr->line);
Tcl_ResetResult(interp);
/*
* Loop infinitely, waiting for commands to execute. When there
* are no windows left, Tk_MainLoop returns and we exit.
*/
Tk_MainLoop();
Tcl_DeleteInterp(interp);
Tcl_Exit(0);
}
void
Tk_MainEx(
int argc, /* Number of arguments. */
char **argv, /* Array of argument strings. */
Tcl_AppInitProc *appInitProc,
/* Application-specific initialization
* function to call after most initialization
* but before starting to execute commands. */
Tcl_Interp *interp)
{
Tcl_Obj *path, *argvPtr;
const char *encodingName;
int code, nullStdin = 0;
Tcl_Channel inChannel, outChannel;
ThreadSpecificData *tsdPtr;
#ifdef __WIN32__
HANDLE handle;
#endif
Tcl_DString appName;
/*
* Ensure that we are getting a compatible version of Tcl. This is really
* only an issue when Tk is loaded dynamically.
*/
if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
abort();
}
tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
Tcl_FindExecutable(argv[0]);
tsdPtr->interp = interp;
Tcl_Preserve(interp);
#if defined(__WIN32__)
Tk_InitConsoleChannels(interp);
#endif
#ifdef MAC_OSX_TK
if (Tcl_GetStartupScript(NULL) == NULL) {
TkMacOSXDefaultStartupScript();
}
#endif
#ifdef TCL_MEM_DEBUG
Tcl_InitMemory(interp);
#endif
/*
* If the application has not already set a startup script, parse the
* first few command line arguments to determine the script path and
* encoding.
*/
if (NULL == Tcl_GetStartupScript(NULL)) {
size_t length;
/*
* Check whether first 3 args (argv[1] - argv[3]) look like
* -encoding ENCODING FILENAME
* or like
* FILENAME
* or like
* -file FILENAME (ancient history support only)
*/
if ((argc > 3) && (0 == strcmp("-encoding", argv[1]))
&& ('-' != argv[3][0])) {
Tcl_SetStartupScript(Tcl_NewStringObj(argv[3], -1), argv[2]);
argc -= 3;
argv += 3;
} else if ((argc > 1) && ('-' != argv[1][0])) {
Tcl_SetStartupScript(Tcl_NewStringObj(argv[1], -1), NULL);
argc--;
argv++;
} else if ((argc > 2) && (length = strlen(argv[1]))
&& (length > 1) && (0 == strncmp("-file", argv[1], length))
&& ('-' != argv[2][0])) {
Tcl_SetStartupScript(Tcl_NewStringObj(argv[2], -1), NULL);
argc -= 2;
argv += 2;
}
}
path = Tcl_GetStartupScript(&encodingName);
if (NULL == path) {
Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName);
} else {
int numBytes;
const char *pathName = Tcl_GetStringFromObj(path, &numBytes);
Tcl_ExternalToUtfDString(NULL, pathName, numBytes, &appName);
path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1);
Tcl_SetStartupScript(path, encodingName);
}
Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY);
Tcl_DStringFree(&appName);
argc--;
argv++;
Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);
argvPtr = Tcl_NewListObj(0, NULL);
while (argc--) {
Tcl_DString ds;
Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds);
Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj(
Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
Tcl_DStringFree(&ds);
}
Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
/*
* Set the "tcl_interactive" variable.
*/
#ifdef __WIN32__
/*
* For now, under Windows, we assume we are not running as a console mode
* app, so we need to use the GUI console. In order to enable this, we
* always claim to be running on a tty. This probably isn't the right way
* to do it.
*/
handle = GetStdHandle(STD_INPUT_HANDLE);
if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)
|| (GetFileType(handle) == FILE_TYPE_UNKNOWN)) {
/*
* If it's a bad or closed handle, then it's been connected to a wish
* console window.
*/
tsdPtr->tty = 1;
} else if (GetFileType(handle) == FILE_TYPE_CHAR) {
/*
* A character file handle is a tty by definition.
*/
tsdPtr->tty = 1;
} else {
tsdPtr->tty = 0;
}
#else
tsdPtr->tty = isatty(0);
#endif
#if defined(MAC_OSX_TK)
/*
* On TkAqua, if we don't have a TTY and stdin is a special character file
* of length 0, (e.g. /dev/null, which is what Finder sets when double
* clicking Wish) then use the GUI console.
*/
if (!tsdPtr->tty) {
struct stat st;
nullStdin = fstat(0, &st) || (S_ISCHR(st.st_mode) && !st.st_blocks);
}
#endif
Tcl_SetVar(interp, "tcl_interactive",
((path == NULL) && (tsdPtr->tty || nullStdin)) ? "1" : "0",
TCL_GLOBAL_ONLY);
/*
* Invoke application-specific initialization.
*/
if (appInitProc(interp) != TCL_OK) {
TkpDisplayWarning(Tcl_GetStringResult(interp),
"Application initialization failed");
}
/*
* Invoke the script specified on the command line, if any. Must fetch it
* again, as the appInitProc might have reset it.
*/
path = Tcl_GetStartupScript(&encodingName);
if (path != NULL) {
Tcl_ResetResult(interp);
code = Tcl_FSEvalFileEx(interp, path, encodingName);
if (code != TCL_OK) {
/*
* The following statement guarantees that the errorInfo variable
* is set properly.
*/
Tcl_AddErrorInfo(interp, "");
TkpDisplayWarning(Tcl_GetVar(interp, "errorInfo",
TCL_GLOBAL_ONLY), "Error in startup script");
Tcl_DeleteInterp(interp);
Tcl_Exit(1);
}
tsdPtr->tty = 0;
} else {
/*
* Evaluate the .rc file, if one has been specified.
*/
Tcl_SourceRCFile(interp);
/*
* Establish a channel handler for stdin.
*/
inChannel = Tcl_GetStdChannel(TCL_STDIN);
if (inChannel) {
Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
inChannel);
}
if (tsdPtr->tty) {
Prompt(interp, 0);
}
}
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
if (outChannel) {
Tcl_Flush(outChannel);
}
Tcl_DStringInit(&tsdPtr->command);
Tcl_DStringInit(&tsdPtr->line);
Tcl_ResetResult(interp);
/*
* Loop infinitely, waiting for commands to execute. When there are no
* windows left, Tk_MainLoop returns and we exit.
*/
Tk_MainLoop();
Tcl_DeleteInterp(interp);
Tcl_Release(interp);
Tcl_SetStartupScript(NULL, NULL);
Tcl_Exit(0);
}
void WildCard_MainLoop() {
signal(SIGINT,cintfront);
G__init_process_cmd();
Tk_MainLoop();
}
static AP_Result tk_main_loop(AP_World *ignore)
{
Tk_MainLoop();
return AP_SUCCESS;
}
int main(int argc, char **argv) {
bool sawParadynFlag = false;
#if defined(os_windows)
// initialize our use of the WinSock library
InitSockets( __argv[0] );
#endif
for( unsigned int i = 1; i < argc; i++ )
{
if( strcmp(argv[i], "--debug" ) == 0 )
{
xsynch_flag = true;
#if !defined(i386_unknown_nt4_0)
cout << "tableVisi at sigpause...pid=" << getpid() << endl;
sigpause(0);
#endif // !defined(i386_unknown_nt4_0)
}
else if( strcmp( argv[i], "--paradyn" ) == 0 )
{
sawParadynFlag = true;
}
else
{
Tcl_Panic( "unrecognized argument seen", NULL );
}
}
if( !sawParadynFlag )
{
ShowNoSoloVisiMessage( argv[0] );
}
// Let Tcl know something about our executable (and do some filesystem-
// specific initialization).
//
// NOTE: this is obligatory with modern versions of Tcl.
Tcl_FindExecutable( argv[0] );
mainInterp = Tcl_CreateInterp();
assert(mainInterp);
#if !defined(i386_unknown_nt4_0)
if (xsynch_flag) {
cout << "xsynching..." << endl;
XSynchronize(Tk_Display(Tk_MainWindow(mainInterp)), 1);
}
#endif // !defined(i386_unknown_nt4_0)
if (TCL_OK != Tcl_Init(mainInterp))
tclpanic(mainInterp, "Could not Tcl_Init");
// Set argv0 before we do any other Tk program initialization because
// Tk takes the main window's class and instance name from argv0
// We set it to "paradyn" instead of "termwin" so that we can
// set resources for all paradyn-related windows with the same root.
Tcl_SetVar( mainInterp,
"argv0",
"paradyn",
TCL_GLOBAL_ONLY );
if (TCL_OK != Tk_Init(mainInterp))
tclpanic(mainInterp, "Could not Tk_Init");
if (TCL_OK != Dg2_Init(mainInterp))
tclpanic(mainInterp, "Could not Dg2_Init");
PDSOCKET visi_sock = visi_Init();
if (visi_sock < 0)
Tcl_Panic("failed to initialize w/ visi lib", NULL);
Tcl_SetVar(mainInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
// Install our new tcl commands here:
installTableVisiCommands(mainInterp);
if (visi_RegistrationCallback(ADDMETRICSRESOURCES,Dg2AddMetricsCallback)!=0)
Tcl_Panic("Dg2_Init() -- couldn't install ADDMETRICSRESOURCES callback",
NULL);
if (visi_RegistrationCallback(DATAVALUES, Dg2NewDataCallback) != 0)
Tcl_Panic("Dg2_Init() -- couldn't install DATAVALUES callback", NULL);
if (visi_RegistrationCallback(PARADYNEXITED, Dg2ParadynExitedCallback) != 0)
panic("Dg2_Init() -- couldn't install PARADYNEXITED callback");
// if (visi_RegistrationCallback(PHASEDATA, Dg2PhaseDataCallback) != 0)
// panic("Dg2_Init() -- couldn't install PHASEINFO callback");
// install a handler to notify us when there is data to be read
Tcl_Channel visi_chan =
Tcl_MakeTcpClientChannel((ClientData)(Address)(PDDESC)visi_sock);
Tcl_CreateChannelHandler(visi_chan,
TCL_READABLE,
(Tcl_FileProc*)visiFdReadableHandler,
0);
// Krishna's tcl2c stuff:
extern int initialize_tcl_sources(Tcl_Interp *);
if (TCL_OK != initialize_tcl_sources(mainInterp))
tclpanic(mainInterp, "tableVisi: could not initialize_tcl_sources");
//if (Tcl_EvalFile(mainInterp, "/p/paradyn/development/tamches/core/visiClients/tableVisi/tcl/tableVisi.tcl") != TCL_OK)
// tclpanic(mainInterp, "could not open tableVisi.tcl");
pdLogo::install_fixed_logo("paradynLogo", logo_bits, logo_width, logo_height);
tcl_cmd_installer createPdLogo(mainInterp, "makeLogo", pdLogo::makeLogoCommand,
(ClientData)Tk_MainWindow(mainInterp));
myTclEval(mainInterp, "initializeTableVisi");
// Create our main data structure:
theTableVisi = new tableVisi(mainInterp,
Tk_NameToWindow(mainInterp, ".body",
Tk_MainWindow(mainInterp)),
"lightBlue", // line color
"blue", // metric color
"black", // metric units color
"maroon3", // focus color
"black", // cell color
"gray", // background color
"lightGray", // highlight background color
3 // initial # sig figs
);
assert(theTableVisi);
Tk_MainLoop(); // returns when all tk windows are closed
delete theTableVisi;
theTableVisi = NULL;
return 0;
}
