/*!
Sets the Tcl stderr and stdout channels to be the same as the C stderr and
stdout streams.
\author jfpatry
*/
void setup_tcl_std_channels()
{
/* Only need to do this under Win32 */
#if defined( NATIVE_WIN32_COMPILER )
Tcl_Channel stdout_chnl, stderr_chnl;
/* I'm not sure why the _dup is necessary under Windows.
See the Tcl_SetStdChannel manpage for more info.
*/
/* Create new stdout channel */
Tcl_SetStdChannel( NULL, TCL_STDOUT );
stdout_chnl = Tcl_MakeFileChannel(
(ClientData) _get_osfhandle( _dup( _fileno(stdout) ) ),
TCL_WRITABLE );
check_assertion( stdout_chnl, "Couldn't create new stdout channel" );
/* Create a new stderr channel */
Tcl_SetStdChannel( NULL, TCL_STDERR );
stderr_chnl = Tcl_MakeFileChannel(
(ClientData) _get_osfhandle( _dup( _fileno(stderr) ) ),
TCL_WRITABLE );
check_assertion( stderr_chnl, "Couldn't create new stderr channel" );
#endif
}
static void
TclKit_InitStdChannels(void)
{
Tcl_Channel chan;
/*
* We need to verify if we have the standard channels and create them if
* not. Otherwise internals channels may get used as standard channels
* (like for encodings) and panic.
*/
chan = Tcl_GetStdChannel(TCL_STDIN);
if (chan == NULL) {
chan = Tcl_OpenFileChannel(NULL, DEV_NULL, "r", 0);
if (chan != NULL) {
Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8");
}
Tcl_SetStdChannel(chan, TCL_STDIN);
}
chan = Tcl_GetStdChannel(TCL_STDOUT);
if (chan == NULL) {
chan = Tcl_OpenFileChannel(NULL, DEV_NULL, "w", 0);
if (chan != NULL) {
Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8");
}
Tcl_SetStdChannel(chan, TCL_STDOUT);
}
chan = Tcl_GetStdChannel(TCL_STDERR);
if (chan == NULL) {
chan = Tcl_OpenFileChannel(NULL, DEV_NULL, "w", 0);
if (chan != NULL) {
Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8");
}
Tcl_SetStdChannel(chan, TCL_STDERR);
}
}
bool ecAdminDialog::EvalTclFile(int nargc, const wxString& Argv, const wxString& msg)
{
wxProgressDialog dlgWait(msg, _("Please wait..."), 100, this);
dlgWait.Update(50);
//TRACE (_T("Evaluating ecosadmin.tcl %s\n"), pszArgv);
// set up the data structure which is passed to the Tcl thread
wxString strArgc;
strArgc.Printf (wxT("%d"), nargc);
std::string argv0 = ecUtils::UnicodeToStdStr (m_strRepository) + "/ecosadmin.tcl";
std::string argv = ecUtils::UnicodeToStdStr (Argv);
std::string argc = ecUtils::UnicodeToStdStr (strArgc);
Tcl_Interp * interp = Tcl_CreateInterp ();
#ifdef __WXMSW__
Tcl_Channel outchan = Tcl_OpenFileChannel (interp, "nul", "a+", 777);
Tcl_SetStdChannel (outchan, TCL_STDOUT); // direct standard output to NUL:
#endif
const char * pszStatus = Tcl_SetVar (interp, "argv0", (char*) argv0.c_str(), 0);
pszStatus = Tcl_SetVar (interp, "argv", (char*) argv.c_str(), 0);
pszStatus = Tcl_SetVar (interp, "argc", (char*) argc.c_str(), 0);
pszStatus = Tcl_SetVar (interp, "gui_mode", "1", 0); // return errors in result string
int nStatus = Tcl_EvalFile (interp, (char*) argv0.c_str());
const char* result = Tcl_GetStringResult (interp);
#ifdef __WXMSW__
Tcl_SetStdChannel (NULL, TCL_STDOUT);
Tcl_UnregisterChannel (interp, outchan);
#endif
Tcl_DeleteInterp (interp);
wxString strErrorMessage (result);
// report any error
if (! strErrorMessage.IsEmpty ())
{
wxString msg (_("Command execution error:\n\n") + strErrorMessage);
wxMessageBox(msg, wxGetApp().GetSettings().GetAppName(), wxICON_EXCLAMATION|wxOK);
return FALSE;
}
else if (TCL_OK != nStatus)
{
wxString msg (_("Command execution error"));
wxMessageBox(msg, wxGetApp().GetSettings().GetAppName(), wxICON_EXCLAMATION|wxOK);
return FALSE;
}
return TRUE;
}
int tclcommand_replacestdchannel(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
{
Tcl_Channel channel=NULL;
if (argc != 3){
Tcl_AppendResult(interp,"Wrong # of args! Usage: ",argv[0]," [stdout|stderr|stdin] <pipename>",(char *)NULL);
return TCL_ERROR;
}
if(access(argv[2],F_OK)<0){
Tcl_AppendResult(interp,"File ",argv[2]," does not exist!",(char *) NULL);
return TCL_ERROR;
}
if(strcmp(argv[1],"stdout")==0){
if(access(argv[2],W_OK)<0){
Tcl_AppendResult(interp,"You do not have permission to access ",argv[2],(char *) NULL);
return TCL_ERROR;
}
Tcl_UnregisterChannel(interp,Tcl_GetStdChannel(TCL_STDOUT));
channel = Tcl_OpenFileChannel(interp, argv[2], "WRONLY",0666);
Tcl_RegisterChannel(interp,channel);
Tcl_SetStdChannel(channel,TCL_STDOUT);
}
else if(strcmp(argv[1],"stderr")==0){
if(access(argv[2],W_OK)<0){
Tcl_AppendResult(interp,"You do not have permission to access ",argv[2],(char *) NULL);
return TCL_ERROR;
}
Tcl_UnregisterChannel(interp,Tcl_GetStdChannel(TCL_STDERR));
channel = Tcl_OpenFileChannel(interp, argv[2], "WRONLY",0666);
Tcl_RegisterChannel(interp,channel);
Tcl_SetStdChannel(channel,TCL_STDERR);
}
else if(strcmp(argv[1],"stdin")==0){
if(access(argv[2],R_OK)<0){
Tcl_AppendResult(interp,"You do not have permission to access ",argv[2],(char *) NULL);
return TCL_ERROR;
}
Tcl_UnregisterChannel(interp,Tcl_GetStdChannel(TCL_STDIN));
channel = Tcl_OpenFileChannel(interp, argv[2], "RDONLY",0666);
Tcl_RegisterChannel(interp,channel);
Tcl_SetStdChannel(channel,TCL_STDIN);
}
else{
Tcl_AppendResult(interp,"invalid first argument (got: ",argv[1]," )",(char *) NULL);
return TCL_ERROR;
}
if(channel == NULL)
return TCL_ERROR;
return TCL_OK;
}
void
TkConsoleCreate()
{
Tcl_Channel consoleChannel;
#ifdef HAVE_UTF
TclInitSubsystems(NULL);
#endif
consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
(ClientData)TCL_STDIN, TCL_READABLE);
if (consoleChannel != NULL) {
Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
#ifdef HAVE_UTF
Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
#endif
}
Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
(ClientData)TCL_STDOUT, TCL_WRITABLE);
if (consoleChannel != NULL) {
Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
#ifdef HAVE_UTF
Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
#endif
}
Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
(ClientData)TCL_STDERR, TCL_WRITABLE);
if (consoleChannel != NULL) {
Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
#ifdef HAVE_UTF
Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
#endif
}
Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
}
void
Tk_InitConsoleChannels(
Tcl_Interp *interp)
{
static Tcl_ThreadDataKey consoleInitKey;
int *consoleInitPtr, doIn, doOut, doErr;
ConsoleInfo *info;
Tcl_Channel consoleChannel;
/*
* 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) {
return;
}
consoleInitPtr = Tcl_GetThreadData(&consoleInitKey, (int) sizeof(int));
if (*consoleInitPtr) {
/*
* We've already initialized console channels in this thread.
*/
return;
}
*consoleInitPtr = 1;
doIn = ShouldUseConsoleChannel(TCL_STDIN);
doOut = ShouldUseConsoleChannel(TCL_STDOUT);
doErr = ShouldUseConsoleChannel(TCL_STDERR);
if (!(doIn || doOut || doErr)) {
/*
* No std channels should be tied to the console; thus, no need to
* create the console.
*/
return;
}
/*
* At least one std channel wants to be tied to the console, so create the
* interp for it to live in.
*/
info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
info->consoleInterp = NULL;
info->interp = NULL;
info->refCount = 0;
if (doIn) {
ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData));
data->info = info;
data->info->refCount++;
data->type = TCL_STDIN;
consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
data, TCL_READABLE);
if (consoleChannel != NULL) {
Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
}
Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
Tcl_RegisterChannel(NULL, consoleChannel);
}
if (doOut) {
ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData));
data->info = info;
data->info->refCount++;
data->type = TCL_STDOUT;
consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
data, TCL_WRITABLE);
if (consoleChannel != NULL) {
Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
}
Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
Tcl_RegisterChannel(NULL, consoleChannel);
}
if (doErr) {
ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData));
data->info = info;
data->info->refCount++;
data->type = TCL_STDERR;
consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
data, TCL_WRITABLE);
if (consoleChannel != NULL) {
Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
}
Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
Tcl_RegisterChannel(NULL, consoleChannel);
}
}
int
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
Tcl_Channel tempChan;
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#ifdef TCL_TEST
if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
(Tcl_PackageInitProc *) NULL);
if (TclObjTest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#endif /* TCL_TEST */
/*
* Call the init procedures for included packages. Each call should
* look like this:
*
* if (Mod_Init(interp) == TCL_ERROR) {
* return TCL_ERROR;
* }
*
* where "Mod" is the name of the module.
*/
/*
* Call Tcl_CreateCommand for application-specific commands, if
* they weren't already created by the init procedures called above.
* Each call would loo like this:
*
* Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
*/
/*
* Specify a user-specific startup script to invoke if the application
* is run interactively. On the Mac we can specifiy either a TEXT resource
* which contains the script or the more UNIX like file location
* may also used. (I highly recommend using the resource method.)
*/
Tcl_SetVar(interp, "tcl_rcRsrcName", "tclshrc", TCL_GLOBAL_ONLY);
/* Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); */
/*
* We have to support at least the quit Apple Event.
*/
TkMacInitAppleEvents(interp);
/*
* Open a file channel to put stderr, stdin, stdout...
*/
tempChan = Tcl_OpenFileChannel(interp, ":temp.in", "a+", 0);
Tcl_SetStdChannel(tempChan,TCL_STDIN);
Tcl_RegisterChannel(interp, tempChan);
Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
Tcl_SetChannelOption(NULL, tempChan, "-buffering", "line");
tempChan = Tcl_OpenFileChannel(interp, ":temp.out", "a+", 0);
Tcl_SetStdChannel(tempChan,TCL_STDOUT);
Tcl_RegisterChannel(interp, tempChan);
Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
Tcl_SetChannelOption(NULL, tempChan, "-buffering", "line");
tempChan = Tcl_OpenFileChannel(interp, ":temp.err", "a+", 0);
Tcl_SetStdChannel(tempChan,TCL_STDERR);
Tcl_RegisterChannel(interp, tempChan);
Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
Tcl_SetChannelOption(NULL, tempChan, "-buffering", "none");
return TCL_OK;
}
