Channel IvyChannelAdd(IVY_HANDLE fd, void *data, ChannelHandleDelete handle_delete, ChannelHandleRead handle_read, ChannelHandleWrite handle_write ) { Channel channel; channel = (Channel)ckalloc( sizeof (struct _channel) ); if ( !channel ) { fprintf(stderr,"NOK Memory Alloc Error\n"); exit(0); } channel->handle_delete = handle_delete; channel->handle_read = handle_read; channel->handle_write = handle_write; channel->data = data; channel->fd = fd; /*printf("Create handle fd %d\n", fd);*/ channel->tcl_channel = Tcl_MakeTcpClientChannel((void*) (long) fd); Tcl_CreateChannelHandler(channel->tcl_channel, TCL_READABLE|TCL_EXCEPTION, IvyHandleFd, (ClientData) channel); return channel; }
void PgStartNotifyEventSource(Pg_ConnectionId * connid) { /* Start the notify event source if it isn't already running */ if (!connid->notifier_running) { int pqsock = PQsocket(connid->conn); if (pqsock >= 0) { #if TCL_MAJOR_VERSION >= 8 Tcl_CreateChannelHandler(connid->notifier_channel, TCL_READABLE, Pg_Notify_FileHandler, (ClientData) connid); #else /* In Tcl 7.5 and 7.6, we need to gin up a Tcl_File. */ Tcl_File tclfile = Tcl_GetFile((ClientData) pqsock, TCL_UNIX_FD); Tcl_CreateFileHandler(tclfile, TCL_READABLE, Pg_Notify_FileHandler, (ClientData) connid); connid->notifier_socket = pqsock; #endif connid->notifier_running = 1; } } }
RtclSignalAction::RtclSignalAction(Tcl_Interp* interp) : fpInterp(interp), fFdPipeRead(-1), fFdPipeWrite(-1), fShuttleChn(), fActionSet(), fpScript(), fOldAction() { for (size_t i=0; i<32; i++) { fActionSet[i] = false; ::memset(&fOldAction[i], 0, sizeof(fOldAction[0])); } int pipefd[2]; if (::pipe(pipefd) < 0) throw Rexception("RtclSignalAction::<ctor>", "pipe() failed: ", errno); fFdPipeRead = pipefd[0]; fFdPipeWrite = pipefd[1]; fShuttleChn = Tcl_MakeFileChannel((ClientData)fFdPipeRead, TCL_READABLE); Tcl_SetChannelOption(NULL, fShuttleChn, "-buffersize", "64"); Tcl_SetChannelOption(NULL, fShuttleChn, "-encoding", "binary"); Tcl_SetChannelOption(NULL, fShuttleChn, "-translation", "binary"); Tcl_CreateChannelHandler(fShuttleChn, TCL_READABLE, (Tcl_FileProc*) ThunkTclChannelHandler, (ClientData) this); }
CAMLprim value camltk_add_file_output(value fd, value cbid) { CheckInit(); Tcl_CreateChannelHandler(tcl_channel(fd, TCL_WRITABLE), TCL_WRITABLE, FileProc, (ClientData) (Int_val(cbid))); return Val_unit; }
void TnmCreateSocketHandler(int sock, int mask, TnmSocketProc *proc, ClientData clientData) { SocketHandler *shPtr; shPtr = (SocketHandler *) ckalloc(sizeof(SocketHandler)); shPtr->sd = sock; shPtr->channel = Tcl_MakeTcpClientChannel((ClientData) sock); shPtr->proc = proc; shPtr->clientData = clientData; Tcl_RegisterChannel((Tcl_Interp *) NULL, shPtr->channel); Tcl_CreateChannelHandler(shPtr->channel, mask, proc, clientData); shPtr->nextPtr = socketHandlerList; socketHandlerList = shPtr; }
void Tcl_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, *resultPtr, *argvPtr, *appName; const char *encodingName = NULL; int code, exitCode = 0; Tcl_MainLoopProc *mainLoopProc; Tcl_Channel chan; InteractiveState is; TclpSetInitialEncodings(); TclpFindExecutable((const char *)argv[0]); Tcl_InitMemory(interp); is.interp = interp; is.prompt = PROMPT_START; is.commandPtr = Tcl_NewObj(); /* * 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)) { /* * Check whether first 3 args (argv[1] - argv[3]) look like * -encoding ENCODING FILENAME * or like * FILENAME */ if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1])) && ('-' != 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) && ('-' != argv[1][0])) { Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL); argc--; argv++; } } 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); Tcl_SetVar2Ex(interp, "tcl_interactive", NULL, Tcl_NewIntObj(!path && is.tty), TCL_GLOBAL_ONLY); /* * Invoke application-specific initialization. */ Tcl_Preserve(interp); if (appInitProc(interp) != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan) { Tcl_WriteChars(chan, "application-specific initialization failed: ", -1); Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); Tcl_WriteChars(chan, "\n", 1); } } if (Tcl_InterpDeleted(interp)) { goto done; } if (Tcl_LimitExceeded(interp)) { goto done; } if (TclFullFinalizationRequested()) { /* * Arrange for final deletion of the main interp */ /* ARGH Munchhausen effect */ Tcl_CreateExitHandler(FreeMainInterp, interp); } /* * 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) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan) { Tcl_Obj *options = Tcl_GetReturnOptions(interp, code); Tcl_Obj *keyPtr, *valuePtr; TclNewLiteralStringObj(keyPtr, "-errorinfo"); Tcl_IncrRefCount(keyPtr); Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr); Tcl_DecrRefCount(keyPtr); if (valuePtr) { Tcl_WriteObj(chan, valuePtr); } Tcl_WriteChars(chan, "\n", 1); Tcl_DecrRefCount(options); } exitCode = 1; } goto done; } /* * We're running interactively. Source a user-specific startup file if the * application specified one and if the file exists. */ Tcl_SourceRCFile(interp); if (Tcl_LimitExceeded(interp)) { goto done; } /* * 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. */ Tcl_IncrRefCount(is.commandPtr); /* * Get a new value for tty if anyone writes to ::tcl_interactive */ Tcl_LinkVar(interp, "tcl_interactive", (char *) &is.tty, TCL_LINK_BOOLEAN); is.input = Tcl_GetStdChannel(TCL_STDIN); while ((is.input != NULL) && !Tcl_InterpDeleted(interp)) { mainLoopProc = TclGetMainLoop(); if (mainLoopProc == NULL) { int length; if (is.tty) { Prompt(interp, &is); if (Tcl_InterpDeleted(interp)) { break; } if (Tcl_LimitExceeded(interp)) { break; } is.input = Tcl_GetStdChannel(TCL_STDIN); if (is.input == NULL) { break; } } if (Tcl_IsShared(is.commandPtr)) { Tcl_DecrRefCount(is.commandPtr); is.commandPtr = Tcl_DuplicateObj(is.commandPtr); Tcl_IncrRefCount(is.commandPtr); } length = Tcl_GetsObj(is.input, is.commandPtr); if (length < 0) { if (Tcl_InputBlocked(is.input)) { /* * This can only happen if stdin has been set to * non-blocking. In that case cycle back and try again. * This sets up a tight polling loop (since we have no * event loop running). If this causes bad CPU hogging, we * might try toggling the blocking on stdin instead. */ continue; } /* * Either EOF, or an error on stdin; we're done */ break; } /* * Add the newline removed by Tcl_GetsObj back to the string. Have * to add it back before testing completeness, because it can make * a difference. [Bug 1775878] */ if (Tcl_IsShared(is.commandPtr)) { Tcl_DecrRefCount(is.commandPtr); is.commandPtr = Tcl_DuplicateObj(is.commandPtr); Tcl_IncrRefCount(is.commandPtr); } Tcl_AppendToObj(is.commandPtr, "\n", 1); if (!TclObjCommandComplete(is.commandPtr)) { is.prompt = PROMPT_CONTINUE; continue; } is.prompt = PROMPT_START; /* * The final newline is syntactically redundant, and causes some * error messages troubles deeper in, so lop it back off. */ Tcl_GetStringFromObj(is.commandPtr, &length); Tcl_SetObjLength(is.commandPtr, --length); code = Tcl_RecordAndEvalObj(interp, is.commandPtr, TCL_EVAL_GLOBAL); is.input = Tcl_GetStdChannel(TCL_STDIN); Tcl_DecrRefCount(is.commandPtr); is.commandPtr = Tcl_NewObj(); Tcl_IncrRefCount(is.commandPtr); if (code != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan) { Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); Tcl_WriteChars(chan, "\n", 1); } } else if (is.tty) { resultPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultPtr); Tcl_GetStringFromObj(resultPtr, &length); chan = Tcl_GetStdChannel(TCL_STDOUT); if ((length > 0) && chan) { Tcl_WriteObj(chan, resultPtr); Tcl_WriteChars(chan, "\n", 1); } Tcl_DecrRefCount(resultPtr); } } else { /* (mainLoopProc != NULL) */ /* * If a main loop has been defined while running interactively, we * want to start a fileevent based prompt by establishing a * channel handler for stdin. */ if (is.input) { if (is.tty) { Prompt(interp, &is); } Tcl_CreateChannelHandler(is.input, TCL_READABLE, StdinProc, &is); } mainLoopProc(); Tcl_SetMainLoop(NULL); if (is.input) { Tcl_DeleteChannelHandler(is.input, StdinProc, &is); } is.input = Tcl_GetStdChannel(TCL_STDIN); } /* * This code here only for the (unsupported and deprecated) [checkmem] * command. */ #ifdef TCL_MEM_DEBUG if (tclMemDumpFileName != NULL) { Tcl_SetMainLoop(NULL); Tcl_DeleteInterp(interp); } #endif /* TCL_MEM_DEBUG */ } done: mainLoopProc = TclGetMainLoop(); if ((exitCode == 0) && mainLoopProc && !Tcl_LimitExceeded(interp)) { /* * If everything has gone OK so far, call the main loop proc, if it * exists. Packages (like Tk) can set it to start processing events at * this point. */ mainLoopProc(); Tcl_SetMainLoop(NULL); } if (is.commandPtr != NULL) { Tcl_DecrRefCount(is.commandPtr); } /* * 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_EvalObjEx call should never return. */ if (!Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) { Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode); Tcl_IncrRefCount(cmd); Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(cmd); } /* * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual is * happening. Maybe interp has been deleted; maybe [exit] was redefined, * maybe we've blown up because of an exceeded limit. We still want to * cleanup and exit. */ Tcl_Exit(exitCode); }
void Tcl_Main( 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_Obj *path, *resultPtr, *argvPtr, *commandPtr = NULL; const char *encodingName = NULL; PromptType prompt = PROMPT_START; int code, length, tty, exitCode = 0; Tcl_Channel inChannel, outChannel, errChannel; Tcl_Interp *interp; Tcl_DString appName; Tcl_FindExecutable(argv[0]); interp = Tcl_CreateInterp(); Tcl_InitMemory(interp); /* * 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)) { /* * Check whether first 3 args (argv[1] - argv[3]) look like * -encoding ENCODING FILENAME * or like * FILENAME */ 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++; } } path = Tcl_GetStartupScript(&encodingName); if (path == NULL) { Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName); } else { const char *pathName = Tcl_GetStringFromObj(path, &length); Tcl_ExternalToUtfDString(NULL, pathName, length, &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. */ tty = isatty(0); Tcl_SetVar(interp, "tcl_interactive", ((path == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY); /* * Invoke application-specific initialization. */ Tcl_Preserve(interp); if (appInitProc(interp) != TCL_OK) { errChannel = Tcl_GetStdChannel(TCL_STDERR); if (errChannel) { Tcl_WriteChars(errChannel, "application-specific initialization failed: ", -1); Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); Tcl_WriteChars(errChannel, "\n", 1); } } if (Tcl_InterpDeleted(interp)) { goto done; } if (Tcl_LimitExceeded(interp)) { goto done; } /* * If a script file was specified then just source that file and quit. * Must fetch it again, as the appInitProc might have reset it. */ path = Tcl_GetStartupScript(&encodingName); if (path != NULL) { code = Tcl_FSEvalFileEx(interp, path, encodingName); if (code != TCL_OK) { errChannel = Tcl_GetStdChannel(TCL_STDERR); if (errChannel) { Tcl_Obj *options = Tcl_GetReturnOptions(interp, code); Tcl_Obj *keyPtr, *valuePtr; TclNewLiteralStringObj(keyPtr, "-errorinfo"); Tcl_IncrRefCount(keyPtr); Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr); Tcl_DecrRefCount(keyPtr); if (valuePtr) { Tcl_WriteObj(errChannel, valuePtr); } Tcl_WriteChars(errChannel, "\n", 1); } exitCode = 1; } goto done; } /* * We're running interactively. Source a user-specific startup file if the * application specified one and if the file exists. */ Tcl_SourceRCFile(interp); if (Tcl_LimitExceeded(interp)) { goto done; } /* * 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); /* * Get a new value for tty if anyone writes to ::tcl_interactive */ Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN); inChannel = Tcl_GetStdChannel(TCL_STDIN); outChannel = Tcl_GetStdChannel(TCL_STDOUT); while ((inChannel != NULL) && !Tcl_InterpDeleted(interp)) { if (mainLoopProc == NULL) { if (tty) { Prompt(interp, &prompt); if (Tcl_InterpDeleted(interp)) { break; } if (Tcl_LimitExceeded(interp)) { break; } inChannel = Tcl_GetStdChannel(TCL_STDIN); if (inChannel == NULL) { break; } } if (Tcl_IsShared(commandPtr)) { Tcl_DecrRefCount(commandPtr); commandPtr = Tcl_DuplicateObj(commandPtr); Tcl_IncrRefCount(commandPtr); } length = Tcl_GetsObj(inChannel, commandPtr); if (length < 0) { if (Tcl_InputBlocked(inChannel)) { /* * This can only happen if stdin has been set to * non-blocking. In that case cycle back and try again. * This sets up a tight polling loop (since we have no * event loop running). If this causes bad CPU hogging, we * might try toggling the blocking on stdin instead. */ continue; } /* * Either EOF, or an error on stdin; we're done */ break; } /* * Add the newline removed by Tcl_GetsObj back to the string. Have * to add it back before testing completeness, because it can make * a difference. [Bug 1775878] */ if (Tcl_IsShared(commandPtr)) { Tcl_DecrRefCount(commandPtr); commandPtr = Tcl_DuplicateObj(commandPtr); Tcl_IncrRefCount(commandPtr); } Tcl_AppendToObj(commandPtr, "\n", 1); if (!TclObjCommandComplete(commandPtr)) { prompt = PROMPT_CONTINUE; continue; } prompt = PROMPT_START; /* * The final newline is syntactically redundant, and causes some * error messages troubles deeper in, so lop it back off. */ Tcl_GetStringFromObj(commandPtr, &length); Tcl_SetObjLength(commandPtr, --length); code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL); 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_IncrRefCount(resultPtr); Tcl_GetStringFromObj(resultPtr, &length); if ((length > 0) && outChannel) { Tcl_WriteObj(outChannel, resultPtr); Tcl_WriteChars(outChannel, "\n", 1); } Tcl_DecrRefCount(resultPtr); } } else { /* (mainLoopProc != NULL) */ /* * If a main loop has been defined while running interactively, we * want to start a fileevent based prompt by establishing a * channel handler for stdin. */ InteractiveState *isPtr = NULL; if (inChannel) { if (tty) { Prompt(interp, &prompt); } isPtr = (InteractiveState *) ckalloc(sizeof(InteractiveState)); isPtr->input = inChannel; isPtr->tty = tty; isPtr->commandPtr = commandPtr; isPtr->prompt = prompt; isPtr->interp = interp; Tcl_UnlinkVar(interp, "tcl_interactive"); Tcl_LinkVar(interp, "tcl_interactive", (char *) &(isPtr->tty), TCL_LINK_BOOLEAN); Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc, isPtr); } mainLoopProc(); mainLoopProc = NULL; if (inChannel) { tty = isPtr->tty; Tcl_UnlinkVar(interp, "tcl_interactive"); Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN); prompt = isPtr->prompt; commandPtr = isPtr->commandPtr; if (isPtr->input != NULL) { Tcl_DeleteChannelHandler(isPtr->input, StdinProc, isPtr); } ckfree((char *) isPtr); } inChannel = Tcl_GetStdChannel(TCL_STDIN); outChannel = Tcl_GetStdChannel(TCL_STDOUT); errChannel = Tcl_GetStdChannel(TCL_STDERR); } #ifdef TCL_MEM_DEBUG /* * This code here only for the (unsupported and deprecated) [checkmem] * command. */ if (tclMemDumpFileName != NULL) { mainLoopProc = NULL; Tcl_DeleteInterp(interp); } #endif } done: if ((exitCode == 0) && (mainLoopProc != NULL) && !Tcl_LimitExceeded(interp)) { /* * If everything has gone OK so far, call the main loop proc, if it * exists. Packages (like Tk) can set it to start processing events at * this point. */ mainLoopProc(); mainLoopProc = NULL; } if (commandPtr != NULL) { Tcl_DecrRefCount(commandPtr); } /* * 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_EvalObjEx call should never return. */ if (!Tcl_InterpDeleted(interp)) { if (!Tcl_LimitExceeded(interp)) { Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode); Tcl_IncrRefCount(cmd); Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(cmd); } /* * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual * is happening. Maybe interp has been deleted; maybe [exit] was * redefined, maybe we've blown up because of an exceeded limit. We * still want to cleanup and exit. */ if (!Tcl_InterpDeleted(interp)) { Tcl_DeleteInterp(interp); } } Tcl_SetStartupScript(NULL, NULL); /* * If we get here, the master interp has been deleted. Allow its * destruction with the last matching Tcl_Release. */ Tcl_Release(interp); Tcl_Exit(exitCode); }
int _ged_run_rtwizard(struct ged *gedp) { int i; FILE *fp_in; #ifndef _WIN32 int pipe_in[2]; int pipe_err[2]; #else HANDLE pipe_in[2], pipe_inDup; HANDLE pipe_err[2], pipe_errDup; STARTUPINFO si = {0}; PROCESS_INFORMATION pi = {0}; SECURITY_ATTRIBUTES sa = {0}; struct bu_vls line = BU_VLS_INIT_ZERO; #endif struct ged_run_rt *run_rtp; struct _ged_rt_client_data *drcdp; #ifndef _WIN32 int pid; int ret; ret = pipe(pipe_in); if (ret < 0) perror("pipe"); ret = pipe(pipe_err); if (ret < 0) perror("pipe"); if ((pid = fork()) == 0) { /* make this a process group leader */ setpgid(0, 0); /* Redirect stdin and stderr */ (void)close(0); ret = dup(pipe_in[0]); if (ret < 0) perror("dup"); (void)close(2); ret = dup(pipe_err[1]); if (ret < 0) perror("dup"); /* close pipes */ (void)close(pipe_in[0]); (void)close(pipe_in[1]); (void)close(pipe_err[0]); (void)close(pipe_err[1]); for (i = 3; i < 20; i++) (void)close(i); (void)execvp(gedp->ged_gdp->gd_rt_cmd[0], gedp->ged_gdp->gd_rt_cmd); perror(gedp->ged_gdp->gd_rt_cmd[0]); exit(16); } /* As parent, send view information down pipe */ (void)close(pipe_in[0]); fp_in = fdopen(pipe_in[1], "w"); (void)close(pipe_err[1]); (void)fclose(fp_in); /* must be BU_GET() to match release in _ged_rt_output_handler */ BU_GET(run_rtp, struct ged_run_rt); BU_LIST_INIT(&run_rtp->l); BU_LIST_APPEND(&gedp->ged_gdp->gd_headRunRt.l, &run_rtp->l); run_rtp->fd = pipe_err[0]; run_rtp->pid = pid; /* must be BU_GET() to match release in _ged_rt_output_handler */ BU_GET(drcdp, struct _ged_rt_client_data); drcdp->gedp = gedp; drcdp->rrtp = run_rtp; Tcl_CreateFileHandler(run_rtp->fd, TCL_READABLE, _ged_rt_output_handler, (ClientData)drcdp); return 0; #else sa.nLength = sizeof(sa); sa.bInheritHandle = TRUE; sa.lpSecurityDescriptor = NULL; /* Create a pipe for the child process's STDOUT. */ CreatePipe(&pipe_err[0], &pipe_err[1], &sa, 0); /* Create noninheritable read handle and close the inheritable read handle. */ DuplicateHandle(GetCurrentProcess(), pipe_err[0], GetCurrentProcess(), &pipe_errDup , 0, FALSE, DUPLICATE_SAME_ACCESS); CloseHandle(pipe_err[0]); /* Create a pipe for the child process's STDIN. */ CreatePipe(&pipe_in[0], &pipe_in[1], &sa, 0); /* Duplicate the write handle to the pipe so it is not inherited. */ DuplicateHandle(GetCurrentProcess(), pipe_in[1], GetCurrentProcess(), &pipe_inDup, 0, FALSE, /* not inherited */ DUPLICATE_SAME_ACCESS); CloseHandle(pipe_in[1]); si.cb = sizeof(STARTUPINFO); si.lpReserved = NULL; si.lpReserved2 = NULL; si.cbReserved2 = 0; si.lpDesktop = NULL; si.dwFlags = STARTF_USESTDHANDLES; si.hStdInput = pipe_in[0]; si.hStdOutput = pipe_err[1]; si.hStdError = pipe_err[1]; for (i = 0; i < gedp->ged_gdp->gd_rt_cmd_len; i++) { bu_vls_printf(&line, "\"%s\" ", gedp->ged_gdp->gd_rt_cmd[i]); } CreateProcess(NULL, bu_vls_addr(&line), NULL, NULL, TRUE, DETACHED_PROCESS, NULL, NULL, &si, &pi); bu_vls_free(&line); CloseHandle(pipe_in[0]); CloseHandle(pipe_err[1]); /* As parent, send view information down pipe */ fp_in = _fdopen(_open_osfhandle((intptr_t)pipe_inDup, _O_TEXT), "wb"); (void)fclose(fp_in); /* must be BU_GET() to match release in _ged_rt_output_handler */ BU_GET(run_rtp, struct ged_run_rt); BU_LIST_INIT(&run_rtp->l); BU_LIST_APPEND(&gedp->ged_gdp->gd_headRunRt.l, &run_rtp->l); run_rtp->fd = pipe_errDup; run_rtp->hProcess = pi.hProcess; run_rtp->pid = pi.dwProcessId; run_rtp->aborted=0; run_rtp->chan = Tcl_MakeFileChannel(run_rtp->fd, TCL_READABLE); /* must be BU_GET() to match release in _ged_rt_output_handler */ BU_GET(drcdp, struct _ged_rt_client_data); drcdp->gedp = gedp; drcdp->rrtp = run_rtp; Tcl_CreateChannelHandler(run_rtp->chan, TCL_READABLE, _ged_rt_output_handler, (ClientData)drcdp); return 0; #endif }
/* ARGSUSED */ static void StdinProc( ClientData clientData, /* The state of interactive cmd line */ int mask) /* Not used. */ { char *cmd; int code, count; InteractiveState *isPtr = clientData; Tcl_Channel chan = isPtr->input; Tcl_Interp *interp = isPtr->interp; count = Tcl_Gets(chan, &isPtr->line); if (count < 0 && !isPtr->gotPartial) { if (isPtr->tty) { Tcl_Exit(0); } else { Tcl_DeleteChannelHandler(chan, StdinProc, isPtr); } return; } Tcl_DStringAppend(&isPtr->command, Tcl_DStringValue(&isPtr->line), -1); cmd = Tcl_DStringAppend(&isPtr->command, "\n", -1); Tcl_DStringFree(&isPtr->line); if (!Tcl_CommandComplete(cmd)) { isPtr->gotPartial = 1; goto prompt; } isPtr->gotPartial = 0; /* * Disable the stdin channel handler while evaluating the command; * otherwise if the command re-enters the event loop we might process * commands from stdin before the current command is finished. Among other * things, this will trash the text of the command being evaluated. */ Tcl_CreateChannelHandler(chan, 0, StdinProc, isPtr); code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL); isPtr->input = Tcl_GetStdChannel(TCL_STDIN); if (isPtr->input) { Tcl_CreateChannelHandler(isPtr->input, TCL_READABLE, StdinProc, isPtr); } Tcl_DStringFree(&isPtr->command); if (Tcl_GetStringResult(interp)[0] != '\0') { if ((code != TCL_OK) || (isPtr->tty)) { chan = Tcl_GetStdChannel((code != TCL_OK) ? TCL_STDERR : TCL_STDOUT); if (chan) { Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); Tcl_WriteChars(chan, "\n", 1); } } } /* * If a tty stdin is still around, output a prompt. */ prompt: if (isPtr->tty && (isPtr->input != NULL)) { Prompt(interp, isPtr); } Tcl_ResetResult(interp); }
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); }
/* ARGSUSED */ static void StdinProc(ClientData clientData, int mask) { static int gotPartial = 0; char *cmd; int code, count; Tcl_Channel chan = (Tcl_Channel) clientData; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); Tcl_Interp *interp = tsdPtr->interp; count = Tcl_Gets(chan, &tsdPtr->line); if (count < 0) { if (!gotPartial) { if (tsdPtr->tty) { Tcl_Exit(0); } else { Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan); } return; } } (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue( &tsdPtr->line), -1); cmd = Tcl_DStringAppend(&tsdPtr->command, "\n", -1); Tcl_DStringFree(&tsdPtr->line); if (!Tcl_CommandComplete(cmd)) { gotPartial = 1; goto prompt; } gotPartial = 0; /* * Disable the stdin channel handler while evaluating the command; * otherwise if the command re-enters the event loop we might * process commands from stdin before the current command is * finished. Among other things, this will trash the text of the * command being evaluated. */ Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan); code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL); chan = Tcl_GetStdChannel(TCL_STDIN); if (chan) { Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, (ClientData) chan); } Tcl_DStringFree(&tsdPtr->command); if (Tcl_GetStringResult(interp)[0] != '\0') { if ((code != TCL_OK) || (tsdPtr->tty)) { chan = Tcl_GetStdChannel(TCL_STDOUT); if (chan) { Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); Tcl_WriteChars(chan, "\n", 1); } } } /* * Output a prompt. */ prompt: if (tsdPtr->tty) { Prompt(interp, gotPartial); } Tcl_ResetResult(interp); }
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 IvyChannelClearWritableEvent(Channel channel) { // On change juste le masque Tcl_CreateChannelHandler(channel->tcl_channel, TCL_READABLE|TCL_EXCEPTION, IvyHandleFd, (ClientData) channel); }
static void TlsWatchProc(ClientData instanceData, /* The socket state. */ int mask) /* Events of interest; an OR-ed * combination of TCL_READABLE, * TCL_WRITABLE and TCL_EXCEPTION. */ { State *statePtr = (State *) instanceData; dprintf(stderr, "TlsWatchProc(0x%x)\n", mask); /* Pretend to be dead as long as the verify callback is running. * Otherwise that callback could be invoked recursively. */ if (statePtr->flags & TLS_TCL_CALLBACK) { return; } if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { Tcl_Channel downChan; statePtr->watchMask = mask; /* No channel handlers any more. We will be notified automatically * about events on the channel below via a call to our * 'TransformNotifyProc'. But we have to pass the interest down now. * We are allowed to add additional 'interest' to the mask if we want * to. But this transformation has no such interest. It just passes * the request down, unchanged. */ downChan = Tls_GetParent(statePtr); (Tcl_GetChannelType(downChan)) ->watchProc(Tcl_GetChannelInstanceData(downChan), mask); /* * Management of the internal timer. */ if (statePtr->timer != (Tcl_TimerToken) NULL) { Tcl_DeleteTimerHandler(statePtr->timer); statePtr->timer = (Tcl_TimerToken) NULL; } if ((mask & TCL_READABLE) && Tcl_InputBuffered(statePtr->self) > 0) { /* * There is interest in readable events and we actually have * data waiting, so generate a timer to flush that. */ statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr); } } else { if (mask == statePtr->watchMask) return; if (statePtr->watchMask) { /* * Remove event handler to underlying channel, this could * be because we are closing for real, or being "unstacked". */ Tcl_DeleteChannelHandler(Tls_GetParent(statePtr), TlsChannelHandler, (ClientData) statePtr); } statePtr->watchMask = mask; if (statePtr->watchMask) { /* * Setup active monitor for events on underlying Channel. */ Tcl_CreateChannelHandler(Tls_GetParent(statePtr), statePtr->watchMask, TlsChannelHandler, (ClientData) statePtr); } } }
/* ARGSUSED */ static void StdinProc( ClientData clientData, /* The state of interactive cmd line */ int mask) /* Not used. */ { int code, length; InteractiveState *isPtr = clientData; Tcl_Channel chan = isPtr->input; Tcl_Obj *commandPtr = isPtr->commandPtr; Tcl_Interp *interp = isPtr->interp; if (Tcl_IsShared(commandPtr)) { Tcl_DecrRefCount(commandPtr); commandPtr = Tcl_DuplicateObj(commandPtr); Tcl_IncrRefCount(commandPtr); } length = Tcl_GetsObj(chan, commandPtr); if (length < 0) { if (Tcl_InputBlocked(chan)) { return; } if (isPtr->tty) { /* * Would be better to find a way to exit the mainLoop? Or perhaps * evaluate [exit]? Leaving as is for now due to compatibility * concerns. */ Tcl_Exit(0); } Tcl_DeleteChannelHandler(chan, StdinProc, isPtr); return; } if (Tcl_IsShared(commandPtr)) { Tcl_DecrRefCount(commandPtr); commandPtr = Tcl_DuplicateObj(commandPtr); Tcl_IncrRefCount(commandPtr); } Tcl_AppendToObj(commandPtr, "\n", 1); if (!TclObjCommandComplete(commandPtr)) { isPtr->prompt = PROMPT_CONTINUE; goto prompt; } isPtr->prompt = PROMPT_START; Tcl_GetStringFromObj(commandPtr, &length); Tcl_SetObjLength(commandPtr, --length); /* * Disable the stdin channel handler while evaluating the command; * otherwise if the command re-enters the event loop we might process * commands from stdin before the current command is finished. Among other * things, this will trash the text of the command being evaluated. */ Tcl_CreateChannelHandler(chan, 0, StdinProc, isPtr); code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL); isPtr->input = chan = Tcl_GetStdChannel(TCL_STDIN); Tcl_DecrRefCount(commandPtr); isPtr->commandPtr = commandPtr = Tcl_NewObj(); Tcl_IncrRefCount(commandPtr); if (chan != NULL) { Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, isPtr); } if (code != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan != NULL) { Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); Tcl_WriteChars(chan, "\n", 1); } } else if (isPtr->tty) { Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); chan = Tcl_GetStdChannel(TCL_STDOUT); Tcl_IncrRefCount(resultPtr); Tcl_GetStringFromObj(resultPtr, &length); if ((length > 0) && (chan != NULL)) { Tcl_WriteObj(chan, resultPtr); Tcl_WriteChars(chan, "\n", 1); } Tcl_DecrRefCount(resultPtr); } /* * If a tty stdin is still around, output a prompt. */ prompt: if (isPtr->tty && (isPtr->input != NULL)) { Prompt(interp, isPtr); isPtr->input = Tcl_GetStdChannel(TCL_STDIN); } }
/* *---------------------------------------------------------------------- * * 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); }
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; }