예제 #1
0
/*! 
  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
}
예제 #2
0
파일: kitInit.c 프로젝트: ghoest/kitgen
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);
    }
}
예제 #3
0
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;
}
예제 #4
0
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;
}
예제 #5
0
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);
}
예제 #6
0
파일: tkConsole.c 프로젝트: lmiadowicz/tk
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);
    }
}
예제 #7
0
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;
}