Tcl Source Code

Artifact f815ee9a9fe50724cd243dced252ff6dd4fdf109:

Attachment "tout5.c" to ticket [3307281fff] added by anonymous 2011-05-25 12:14:34.

---

#include <tcl.h>

char hard_coded_script [] = "\
puts \"initializing\"\n\
\n\
proc doit_ok {} {\n\
  puts stdout \"proc doit_ok called (this will get redirected).\"\n\
}\n\
proc doit_notok {} {\n\
  puts \"proc doit_notok called (this wont get redirected).\"\n\
}\n";

int Tcl_AppInit(Tcl_Interp* interp)
{
  Tcl_Channel old_stdout = Tcl_GetStdChannel(TCL_STDOUT);
  Tcl_Eval(interp, hard_coded_script);

  Tcl_Channel ch = Tcl_OpenFileChannel(interp, "toutdemo.txt", "w", 0644);
  Tcl_RegisterChannel(interp, ch);

  Tcl_SetStdChannel(ch, TCL_STDOUT);

  // this output gets redirected.
  // this has 'stdout' listed as file handle.
  Tcl_Eval(interp, "doit_ok");
  // this output should also get redirected, but it doesn't.
  // this has puts without 'stdout' as file handle
  Tcl_Eval(interp, "doit_notok");

  Tcl_SetStdChannel(old_stdout, TCL_STDOUT);
  Tcl_Eval(interp, "puts {now exit this using ^D and cat toutdemo.txt.}");
  return TCL_OK;
}

int main(int argc, char* argv[])
{
  Tcl_Main(argc, argv, Tcl_AppInit);
  return 0;
}